\     RichEdit
\   win.txt


\   
DECIMAL
WINAPI: RegisterClassA   USER32.DLL
WINAPI: CreateWindowExA  USER32.DLL
WINAPI: SetWindowTextA   USER32.DLL
WINAPI: UpdateWindow     USER32.DLL
WINAPI: BeginPaint       USER32.DLL
WINAPI: EndPaint         USER32.DLL
WINAPI: GetClassNameA    USER32.DLL
WINAPI: TextOutA         GDI32.DLL
WINAPI: DefWindowProcA   USER32.DLL
WINAPI: LoadIconA        USER32.DLL
WINAPI: DrawIcon         USER32.DLL
WINAPI: ShowWindow       USER32.DLL
WINAPI: GetMessageA      USER32.DLL
WINAPI: DispatchMessageA USER32.DLL
WINAPI: TranslateMessage USER32.DLL


\ ----------------------------------------------------------------- 
HEX
IMAGE-BASE CONSTANT HINST  \ Instance  
       0 CONSTANT HCON   \ hwnd   
       4 CONSTANT CELL
       2 CONSTANT CS_HREDRAW
       1 CONSTANT CS_VREDRAW
       8 CONSTANT CS_DBLCLKS
      20 CONSTANT CS_OWNDC
 8000000 CONSTANT CW_USEDEFAULT
  CF0000 CONSTANT WS_OVERLAPPEDWINDOW
10000000 CONSTANT WS_VISIBLE
80000000 CONSTANT WS_POPUP
  800000 CONSTANT WS_BORDER
40000000 CONSTANT WS_CHILD
00C00000 CONSTANT WS_CAPTION
00080000 CONSTANT WS_SYSMENU
00010000 CONSTANT WS_TABSTOP
00020000 CONSTANT WS_GROUP
00040000 CONSTANT WS_SIZEBOX
00100000 CONSTANT WS_HSCROLL
00200000 CONSTANT WS_VSCROLL
00040000 CONSTANT WS_THICKFRAME
00400000 CONSTANT WS_DLGFRAME
      80 CONSTANT DS_MODALFRAME
      40 CONSTANT DS_SETFONT
      80 CONSTANT ES_AUTOHSCROLL
      40 CONSTANT ES_AUTOVSCROLL
    0001 CONSTANT ES_CENTER
    0000 CONSTANT ES_LEFT
    0004 CONSTANT ES_MULTILINE
    0800 CONSTANT ES_READONLY
    0002 CONSTANT ES_RIGHT
    1000 CONSTANT ES_WANTRETURN
    6004 CONSTANT WS_95
    7F00 CONSTANT IDI_APPLICATION
    7F04 CONSTANT IDI_ASTERISK
    7F03 CONSTANT IDI_EXCLAMATION
    7F01 CONSTANT IDI_HAND
    7F02 CONSTANT IDI_QUESTION
      0F CONSTANT WM_PAINT
       5 CONSTANT COLOR_WINDOW
DECIMAL

\ ----------------------------------------------------------------- 
0
CELL -- MSG.hwnd
CELL -- MSG.message
CELL -- MSG.wParam
CELL -- MSG.lParam
CELL -- MSG.time
CELL -- MSG.pt
CONSTANT /MSG

\ win-     - WNDCLASS
0
CELL -- WNDCLASS.style
CELL -- WNDCLASS.lpfnWndProc
CELL -- WNDCLASS.cbClsExtra
CELL -- WNDCLASS.cbWndExtra
CELL -- WNDCLASS.hInstance
CELL -- WNDCLASS.hIcon
CELL -- WNDCLASS.hCursor
CELL -- WNDCLASS.hbrBackground
CELL -- WNDCLASS.lpszMenuName
CELL -- WNDCLASS.lpszClassName
CONSTANT /WNDCLASS

\    - - FORTH.WNDCLASS
/WNDCLASS     (  FORTH.WNDCLASS   WNDCLASS )
CELL -- FORTH.WNDCLASS.link
CELL -- FORTH.WNDCLASS.wordlist
CONSTANT /FORTH.WNDCLASS

\ ------------------------------------------------------------- 
WORDLIST CONSTANT CLASS-WORDLIST \  ()   
ALSO CLASS-WORDLIST CONTEXT !

VARIABLE CURR-SAVE               \      
                                 \   
VARIABLE CURRENT-CLASS           \    

: MESSAGES ( CLASS-ID -- )       \   CURRENT-CLASS
  FORTH.WNDCLASS.wordlist @ CURRENT-CLASS !
;
: SearchMsgPat
  S" 00000000MSG"   \ -   - 
;
: CreateMsgPat      \ -   - 
  S" : 00000000MSG"
;
: :MSG   ( "__" -- )
  \   ":"     
  CURRENT @ CURR-SAVE !
  CURRENT-CLASS @ CURRENT !
  BL WORD FIND 0= IF TRUE ABORT"   !" THEN
  EXECUTE ( _ )
  BASE @ >R HEX                         \     xxxMSG
  0 <# # # # # # # # # #>               \  xxx - hex- 
  R> BASE !                             \     
  CreateMsgPat DROP 2 CHARS + SWAP MOVE
  CreateMsgPat EVALUATE
;
: ;MSG   \   - 
  POSTPONE ; CURR-SAVE @ CURRENT !
; IMMEDIATE

VARIABLE ERR-MESSAGES

: FindMsgProc ( msg hwnd -- 0 | xt flag )
  >R
  BASE @ >R HEX
  0 <# # # # # # # # # #>
  R> BASE !
  SearchMsgPat DROP SWAP MOVE
  SearchMsgPat
  256 HERE R> GetClassNameA
  ?DUP IF HERE SWAP
          CLASS-WORDLIST SEARCH-WORDLIST
          IF EXECUTE FORTH.WNDCLASS.wordlist @ ELSE ERR-MESSAGES @ THEN
       ELSE ERR-MESSAGES @ THEN
  SEARCH-WORDLIST
;

: (MyWndProc)     ( lparam wparam uint hwnd )
  ." WNDPRC: " OVER U. DUP U.
  2SWAP OVER U. DUP U. CR 2SWAP

  2DUP \ SP@ . RP@ . CR KEY DROP
  FindMsgProc IF EXECUTE
              ELSE DefWindowProcA THEN
;
\  

' (MyWndProc) WNDPROC: MyWndProc


\ ---------------------------     --------------
VARIABLE CLASS-LINK

: Class: ( -- )
  WORDLIST
  CURRENT @ CLASS-WORDLIST CURRENT !
  >IN @  CREATE  >IN !     CURRENT !

  HERE >R  \        Windows
  CLASS-LINK @               R@ FORTH.WNDCLASS.link !
  R@ FORTH.WNDCLASS.link CLASS-LINK !
  ( WORDLIST)                R@ FORTH.WNDCLASS.wordlist !

  /FORTH.WNDCLASS ALLOT
  CS_HREDRAW CS_VREDRAW OR  CS_DBLCLKS OR \ CS_OWNDC OR
                             R@ WNDCLASS.style         !
  ['] MyWndProc              R@ WNDCLASS.lpfnWndProc   !
  0                          R@ WNDCLASS.cbClsExtra    !
  0                          R@ WNDCLASS.cbWndExtra    !
  HINST                      R@ WNDCLASS.hInstance     !
  0 0 LoadIconA              R@ WNDCLASS.hIcon         !
  0                          R@ WNDCLASS.hCursor       !
  COLOR_WINDOW 1+            R@ WNDCLASS.hbrBackground !
  0                          R@ WNDCLASS.lpszMenuName  !
  HERE                       R> WNDCLASS.lpszClassName !
  BL WORD COUNT HERE SWAP DUP ALLOT MOVE 0 C,
;
: RegisterClass- ( class-id -- )
  RegisterClassA 0= IF TRUE ABORT"   !" THEN
;
: CreateWindow- ( class-id -- hwnd )
  >R
  0                   \ address of window create data
  HINST               \ handle of application instance
  0                   \ handle of menu, or child-window identifier	
  HCON                \ handle of parent or owner window
  300 \ CW_USEDEFAULT       \ window height	
  200 \ CW_USEDEFAULT       \ window width	
  100 \ CW_USEDEFAULT       \ vertical position of window
  100 \ CW_USEDEFAULT       \ horizontal position of window
  WS_OVERLAPPEDWINDOW WS_VISIBLE OR WS_POPUP OR WS_CAPTION OR
  DS_MODALFRAME OR WS_SYSMENU OR \ window style
  WS_BORDER OR WS_VSCROLL OR WS_HSCROLL OR
  WS_95 OR WS_THICKFRAME OR
  
  R> ( class-id ) WNDCLASS.lpszClassName @  \ DUP \ address of window name
                                   S" RICHEDIT" DROP             \ address of registered class name
  0       \ extended window style

  CreateWindowExA DUP 0= ABORT"   !"
;
: SetWindowText- ( addr u hwnd -- )
  ROT ROT OVER + ( hwnd addr addrend )
  >R R@ @ 0 R@ ! >R
  SWAP SetWindowTextA DROP
  R> R> !
;
: DrawIcon- ( x y iconid DC -- )
  >R
  0 LoadIconA
  ROT ROT SWAP
  R> DrawIcon DROP
;
: TextOut- ( addr u x y DC -- )
  >R SWAP 2>R SWAP 2R> R> TextOutA DROP
;
\ ---------------------------   ---------------------

Class: MSGWORDLIST
MSGWORDLIST FORTH.WNDCLASS.wordlist @ ERR-MESSAGES !

Class: FORTH-TEST

MSGWORDLIST MESSAGES
:MSG WM_PAINT
     >R 2DROP DROP
     HERE R@ BeginPaint >R
     S"   !" SWAP 10 10 R> TextOutA DROP
     HERE R> EndPaint DROP 0
;MSG

FORTH-TEST MESSAGES
:MSG WM_PAINT
     >R 2DROP DROP
     HERE R@ BeginPaint >R
     S"   Forth-test." 50 20 R@ TextOut-
     10  10 IDI_APPLICATION R@ DrawIcon-
     10  50 IDI_ASTERISK    R@ DrawIcon-
     10  90 IDI_EXCLAMATION R@ DrawIcon-
     10 130 IDI_HAND        R@ DrawIcon-
     10 170 IDI_QUESTION    R> DrawIcon-
     HERE R> EndPaint DROP 0
;MSG
\ ---------------------------------------------------------------------

CREATE MSG1 /MSG ALLOT

: MessageLoop
  BEGIN
    0 0 0 MSG1 GetMessageA
  WHILE
    MSG1 TranslateMessage DROP
    MSG1 DispatchMessageA DROP
  REPEAT
;
: TEST
  S" RICHED32.DLL" DROP LoadLibraryA DROP
  FORTH-TEST RegisterClass-
  FORTH-TEST CreateWindow- >R
\  S" SETWINDOWTEXT TEST" R@ SetWindowText-
  R@ UpdateWindow DROP
  5 R> ShowWindow DROP MessageLoop
;

TEST

