{ ============================================================================
   Simply Line Drawing Example

   Changes:
   Created 6/18/2008 by Mike Ghan

=========================================================================== }

Function: CreatePen ( style width|0 rgbColor -- hPen )
Function: MoveToEx   ( hDC X Y point -- res )
Function: LineTo     ( hDC X Y  -- res )
Function: SetROP2    ( hDC ROP2 -- res )
Function: Rectangle  ( hdc nLeftRect nTopRect nRightRect nBottomRect -- res )


\ ********************************************************************
\  Colors
\ ********************************************************************

: >RGB  ( red green blue --- rgb )   \  rgb = 00bbggrr
   16 LSHIFT  SWAP 8 LSHIFT OR  OR ;

: RGB-COLOR  ( red green blue -- )
   >RGB ( ColorRGB ) CONSTANT ;

\ Some Common Colors
\ Red Grn Blu RGB-COLOR name
  255   0   0 RGB-COLOR RED-COLOR
    0 255   0 RGB-COLOR GREEN-COLOR
    0   0 255 RGB-COLOR BLUE-COLOR
  255 128   0 RGB-COLOR ORANGE-COLOR
  255 255   0 RGB-COLOR YELLOW-COLOR
  255   0 255 RGB-COLOR MAGENTA-COLOR
    0   0   0 RGB-COLOR BLACK-COLOR
  128 128 128 RGB-COLOR GRAY-COLOR


\ ********************************************************************
\  DC Tools
\ ********************************************************************

[UNDEFINED] CURRENT-DC [IF]
\ User Vars
 #USER
   CELL +USER CURRENT-DC  \ Device Context
 TO #USER

: MY-DC  ( -- hDC )     CURRENT-DC @ ;
: IS-MY-DC  ( hDC -- )  CURRENT-DC ! ;  \ Set at BeginPaint etc
: GET-MY-DC  ( -- )     HWND GetDC IS-MY-DC ;
: RELEASE-MY-DC ( -- )  HWND MY-DC ReleaseDC DROP ;
[THEN]


\ ********************************************************************
\  Draw Lines
\ ********************************************************************

: DRAW-LINE  ( x1 y1 x2 y2 -- )
   2>R MY-DC -ROT 0 MoveToEx DROP  MY-DC 2R> LineTo DROP ;

: MOVE-TO  ( x y -- )
   MY-DC -ROT NULL MoveToEx DROP ;

: +LINE  ( x y -- )  \ Append to Previous
   MY-DC -ROT LineTo DROP ;


\ ********************************************************************
\  Simple Testbed
\ ********************************************************************

: DRAW-TEST  ( -- )  \ Draw lines on SF Console
   GET-MY-DC ( get DC of our window )
   PS_SOLID 5 ( width ) RED-COLOR CreatePen ( hPen )
   MY-DC SWAP ( hPen ) SelectObject ( hPrevPen ) >R ( Stash )
   25 100 ( x1y1 )  125 200 ( x2y2 ) DRAW-LINE
   225 200 +LINE   25 100 +LINE
   \ Next we'll restore the previous pen and delete the pen we created.
   MY-DC R> ( hPrevPen ) SelectObject ( hPen ) DeleteObject DROP
   RELEASE-MY-DC ;


\ ****************************************************************************
\  Fancy Lines
\ ****************************************************************************

CLASS LOGBRUSH
   VARIABLE Style \ BS_DIBPATTERN BS_DIBPATTERNPT BS_HATCHED BS_HOLLOW BS_NULL BS_PATTERN BS_SOLID
   VARIABLE Color
   VARIABLE Hatch \ HS_BDIAGONAL HS_CROSS HS_DIAGCROSS HS_FDIAGONAL HS_HORIZONTAL HS_VERTICAL
END-CLASS

LOGBRUSH BUILDS OUR-LB


Function: ExtCreatePen ( style width pBrush StyleCnt pStyleBits -- hPen )

: DRAW-TEST2  ( -- )  \ Draw Ext lines on SF Console
   GET-MY-DC ( get DC of our window )
   BS_SOLID OUR-LB Style !
 \ BS_HATCHED OUR-LB Style !
   BLUE-COLOR OUR-LB Color !
   NULL OUR-LB Hatch !
 \ HS_DIAGCROSS OUR-LB Hatch !
   PS_GEOMETRIC PS_SOLID OR PS_ENDCAP_FLAT OR  10 ( width )  OUR-LB ADDR 0 0 ExtCreatePen ( hPen )
   MY-DC SWAP ( hPen ) SelectObject ( hPrevPen ) >R ( Stash )
   25 100 ( x1y1 )  125 200 ( x2y2 ) DRAW-LINE
   225 200 +LINE   25 100 +LINE
   \ Next we'll restore the previous pen and delete the pen we created.
   MY-DC R> ( hPrevPen ) SelectObject ( hPen ) DeleteObject DROP
   RELEASE-MY-DC ;