\   02.12.1996    
\   Win95.

( 11.04.1996)

S" INCLUDE\FACIL.F" INCLUDED
DECIMAL

' ANSI>OEM TO ANSI><OEM
: TTT SOURCE TYPE CR ;
\ ' TTT TO <PRE>
WARNING 0!

\ --------------------------------------------------------------------------
: WITHIN ( n1|u1 n2|u2 n3|u3 -- flag ) \ 93 CORE EXT
\     n1|u1    
\ n2|u2    n3|u3,  "", 
\ (n2|u2<n3|u3  (n2|u2<=n1|u1  n1|u1<n3|u3))
\  (n2|u2>n3|u3  (n2|u2<=n1|u1  n1|u1<n3|u3)) "",
\   "".
\   ,  n1|u1, n2|u2  n3|u3
\      .
  OVER - >R - R> U<
;

CREATE  31 C, 28 C, 31 C,  30 C, 31 C, 30 C,  31 C, 31 C, 30 C,  31 C, 30 C, 31 C,

: 
  1- 0 MAX  0 SWAP 0 ?DO  I + C@ + LOOP
;
: 
  1900 - DUP 3 + 4 / SWAP 365 * +
;
: ?
  4 MOD 0=
;
: > (    --  )
  DUP ? IF 29 ELSE 28 THEN  1+ C!
  
  SWAP  + +
  1+ \    MS Access    30.12.1899
;
: 
  1+
  12 0 DO
        I + C@
       -
       DUP 0 > 0= IF  I + C@ + I 1+ UNLOOP EXIT THEN
       LOOP 0
;
: > (  --    )
  2- DUP
  100 36525 */ ( -1900 )
  1900 + DUP >R
  DUP ? IF 29 ELSE 28 THEN  1+ C!
   -
   R>
;
: >S (  -- addr u )
  > S>D <# # # # # [CHAR] . HOLD
               >R + R> # # [CHAR] . HOLD
               >R + R> # # #>
;
: >:
  BL SKIP [CHAR] . WORD ?LITERAL [CHAR] . WORD ?LITERAL BL WORD ?LITERAL
  >
;
: 
  TIME&DATE > NIP NIP NIP
;
VARIABLE  1 1 1996 >  !
VARIABLE  11 4 1996 >  !

\ --------------------------------------------------------------------------
WINAPI: SetClassLongA           USER32.DLL
WINAPI: MessageBoxA             USER32.DLL
WINAPI: DialogBoxIndirectParamA USER32.DLL
WINAPI: EndDialog               USER32.DLL
WINAPI: SetDlgItemTextA         USER32.DLL
WINAPI: GetDlgItem              USER32.DLL
WINAPI: GetDlgCtrlID            USER32.DLL
WINAPI: SendMessageA            USER32.DLL
WINAPI: SetWindowTextA          USER32.DLL
WINAPI: InitCommonControls      COMCTL32.DLL
WINAPI: LoadImageA              USER32.DLL
WINAPI: ImageList_Create        COMCTL32.DLL
WINAPI: ImageList_AddIcon       COMCTL32.DLL
WINAPI: CreateToolbarEx         COMCTL32.DLL
WINAPI: FreeConsole             KERNEL32.DLL
WINAPI: CheckDlgButton          USER32.DLL
WINAPI: IsDlgButtonChecked      USER32.DLL

 4 CONSTANT &PROP
 8 CONSTANT &LINK
16 CONSTANT &

: PROP ( -- )
\      "".
  LAST @ NAME>F DUP C@ &PROP OR SWAP C!
;
: ?PROP ( NFA -> F )
  NAME>F C@ &PROP AND
;
: LINK ( -- )
\      "".
  LAST @ NAME>F DUP C@ &LINK OR SWAP C!
;
: ?LINK ( NFA -> F )
  NAME>F C@ &LINK AND
;
:  ( NFA -- )
  DUP NAME>F DUP C@ & OR SWAP C!
  127 SWAP 1+ C!
;
: ? ( NFA -> F )
  ?DUP IF NAME>F C@ & AND ELSE FALSE THEN
;

\ -----------------------

: #define
  CREATE 0 0 BL WORD COUNT
  >NUMBER DUP IF 1- SWAP 1+ SWAP >NUMBER THEN 2DROP D>S ,
  DOES> @
;
HEX
IMAGE-BASE CONSTANT HINST  \ Instance  
       0 CONSTANT HCON     \ hwnd   

\  
  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
      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

\ messages
     111 CONSTANT WM_COMMAND
     110 CONSTANT WM_INITDIALOG
    004E CONSTANT WM_NOTIFY
      0F CONSTANT WM_PAINT
#define WM_CONTEXTMENU                  0x007B


0 CONSTANT NM_FIRST
-1 CONSTANT NM_OUTOFMEMORY          ( NM_FIRST-1)
-2 CONSTANT NM_CLICK                ( NM_FIRST-2)
-3 CONSTANT NM_DBLCLK               ( NM_FIRST-3)
-4 CONSTANT NM_RETURN               ( NM_FIRST-4)
-5 CONSTANT NM_RCLICK               ( NM_FIRST-5)
-6 CONSTANT NM_RDBLCLK              ( NM_FIRST-6)
-7 CONSTANT NM_SETFOCUS             ( NM_FIRST-7)
-8 CONSTANT NM_KILLFOCUS            ( NM_FIRST-8)

\ -----------
#define MB_ICONEXCLAMATION          0x00000030
       1 CONSTANT IDOK
       2 CONSTANT IDCANCEL
0080 CONSTANT DI_Button 
0081 CONSTANT DI_Edit 
0082 CONSTANT DI_Static 
0083 CONSTANT DI_Listbox 
0084 CONSTANT DI_Scrollbar 
0085 CONSTANT DI_Combobox

        0010 CONSTANT LR_LOADFROMFILE
#define LR_LOADTRANSPARENT  0x0020
        0080 CONSTANT LR_LOADREALSIZE

           0 CONSTANT IMAGE_BITMAP
           1 CONSTANT IMAGE_ICON
           1 CONSTANT ILC_MASK

#define DS_3DLOOK           0x0004
#define DS_FIXEDSYS         0x0008
#define DS_NOFAILCREATE     0x0010
#define DS_CONTROL          0x0400
#define DS_CENTER           0x0800
#define DS_CENTERMOUSE      0x1000
#define DS_CONTEXTHELP      0x2000
#define WS_MINIMIZEBOX      0x00020000
#define WS_MAXIMIZEBOX      0x00010000

1000 CONSTANT LVM_FIRST
1100 CONSTANT TV_FIRST

        0001 CONSTANT TVS_HASBUTTONS
        0004 CONSTANT TVS_LINESATROOT
        0002 CONSTANT TVS_HASLINES
#define LVS_ICON                0x0000
#define LVS_REPORT              0x0001
#define LVS_SMALLICON           0x0002
#define LVS_LIST                0x0003
#define LVS_TYPEMASK            0x0003
#define LVS_SINGLESEL           0x0004
#define LVS_SHOWSELALWAYS       0x0008
#define LVS_SORTASCENDING       0x0010
#define LVS_SORTDESCENDING      0x0020
#define LVS_SHAREIMAGELISTS     0x0040
#define LVS_NOLABELWRAP         0x0080
#define LVS_AUTOARRANGE         0x0100
#define LVS_EDITLABELS          0x0200
#define LVS_NOSCROLL            0x2000

#define LVCF_FMT                0x0001
#define LVCF_WIDTH              0x0002
#define LVCF_TEXT               0x0004
#define LVCF_SUBITEM            0x0008

#define LVCFMT_LEFT             0x0000
#define LVCFMT_RIGHT            0x0001
#define LVCFMT_CENTER           0x0002
#define LVCFMT_JUSTIFYMASK      0x0003

#define LVIF_TEXT               0x0001
#define LVIF_IMAGE              0x0002
#define LVIF_PARAM              0x0004
#define LVIF_STATE              0x0008

#define LVSIL_NORMAL            0
#define LVSIL_SMALL             1
#define LVSIL_STATE             2

#define TVIS_EXPANDEDONCE       0x0040

#define EM_GETSEL               0x00B0
#define EM_SETSEL               0x00B1
#define EM_GETRECT              0x00B2
#define EM_SETRECT              0x00B3
#define EM_SETRECTNP            0x00B4
#define EM_SCROLL               0x00B5
#define EM_LINESCROLL           0x00B6
#define EM_SCROLLCARET          0x00B7
#define EM_GETMODIFY            0x00B8
#define EM_SETMODIFY            0x00B9
#define EM_GETLINECOUNT         0x00BA
#define EM_LINEINDEX            0x00BB
#define EM_SETHANDLE            0x00BC
#define EM_GETHANDLE            0x00BD
#define EM_GETTHUMB             0x00BE
#define EM_LINELENGTH           0x00C1
#define EM_REPLACESEL           0x00C2
#define EM_GETLINE              0x00C4
#define EM_LIMITTEXT            0x00C5
#define EM_CANUNDO              0x00C6
#define EM_UNDO                 0x00C7
#define EM_FMTLINES             0x00C8
#define EM_LINEFROMCHAR         0x00C9
#define EM_SETTABSTOPS          0x00CB
#define EM_SETPASSWORDCHAR      0x00CC
#define EM_EMPTYUNDOBUFFER      0x00CD
#define EM_GETFIRSTVISIBLELINE  0x00CE
#define EM_SETREADONLY          0x00CF
#define EM_SETWORDBREAKPROC     0x00D0
#define EM_GETWORDBREAKPROC     0x00D1
#define EM_GETPASSWORDCHAR      0x00D2
#define EM_SETMARGINS           0x00D3
#define EM_GETMARGINS           0x00D4
#define EM_SETLIMITTEXT         0x00C5
#define EM_GETLIMITTEXT         0x00D5
#define EM_POSFROMCHAR          0x00D6
#define EM_CHARFROMPOS          0x00D7

#define TBSTATE_CHECKED         0x01
#define TBSTATE_PRESSED         0x02
#define TBSTATE_ENABLED         0x04
#define TBSTATE_HIDDEN          0x08
#define TBSTATE_INDETERMINATE   0x10
#define TBSTATE_WRAP            0x20

#define TBSTYLE_BUTTON          0x00
#define TBSTYLE_SEP             0x01
#define TBSTYLE_CHECK           0x02
#define TBSTYLE_GROUP           0x04

#define TBSTYLE_TOOLTIPS        0x0100
#define TBSTYLE_WRAPABLE        0x0200
#define TBSTYLE_ALTDRAG         0x0400

#define TVGN_CARET              0x0009

#define TVE_COLLAPSE            0x0001
#define TVE_EXPAND              0x0002
#define TVE_TOGGLE              0x0003
#define TVE_COLLAPSERESET       0x8000

#define BS_AUTOCHECKBOX     0x00000003L

FFFF0000 CONSTANT TVI_ROOT
FFFF0001 CONSTANT TVI_FIRST
FFFF0002 CONSTANT TVI_LAST
FFFF0003 CONSTANT TVI_SORT
        0001 CONSTANT TVIF_TEXT
        0002 CONSTANT TVIF_IMAGE
        0004 CONSTANT TVIF_PARAM
        0008 CONSTANT TVIF_STATE
        0010 CONSTANT TVIF_HANDLE
        0020 CONSTANT TVIF_SELECTEDIMAGE
        0040 CONSTANT TVIF_CHILDREN

\ --------------------------------------------------------
\ *******       
0
4 -- DLGTEMPLATE.style
4 -- DLGTEMPLATE.dwExtendedStyle
2 -- DLGTEMPLATE.cdit
2 -- DLGTEMPLATE.x
2 -- DLGTEMPLATE.y
2 -- DLGTEMPLATE.cx
2 -- DLGTEMPLATE.cy
CONSTANT /DLGTEMPLATE

0
4 -- DLGITEMTEMPLATE.style
4 -- DLGITEMTEMPLATE.dwExtendedStyle
2 -- DLGITEMTEMPLATE.x
2 -- DLGITEMTEMPLATE.y
2 -- DLGITEMTEMPLATE.cx
2 -- DLGITEMTEMPLATE.cy
2 -- DLGITEMTEMPLATE.id
CONSTANT /DLGITEMTEMPLATE

: DIALOG: ( x y cx cy cdit style "name" -- )
  CREATE HERE 0 ,
  HERE 7 + 8 / 8 * HERE - ALLOT
  HERE SWAP !
  HERE DUP >R /DLGTEMPLATE DUP ALLOT ERASE
  R@ DLGTEMPLATE.style !
  R@ DLGTEMPLATE.cdit W!
  R@ DLGTEMPLATE.cy W!
  R@ DLGTEMPLATE.cx W!
  R@ DLGTEMPLATE.y W!
  R> DLGTEMPLATE.x W!
  0 W, \ menu  (no menu)
  0 W, \ class (def)
  0 W, \ title (no title)
  8 W,
;

: L" ( "ccc" -- ) \ *******    UNICODE
  [CHAR] " PARSE
  0 ?DO DUP I + C@ W, LOOP DROP 0 W,
;
: DIALOGITEM ( x y cx cy id style class -- ) \ *******  
  >R
  HERE DUP >R /DLGITEMTEMPLATE DUP ALLOT ERASE
  R@ DLGITEMTEMPLATE.style !
  R@ DLGITEMTEMPLATE.id W!
  R@ DLGITEMTEMPLATE.cy W!
  R@ DLGITEMTEMPLATE.cx W!
  R@ DLGITEMTEMPLATE.y W!
  R> DLGITEMTEMPLATE.x W!
  -1 W, R> W, \ class
  0 W,             \ title (initial text)
  0 ,             \ creation data
;
\ -----------------    ------------------------------
DECIMAL
0
1 + DUP 200 + CONSTANT 
1 + DUP 200 + CONSTANT 
1 + DUP CONSTANT 
1 + DUP CONSTANT 
1 + DUP CONSTANT 
1 + DUP CONSTANT 0
1 + DUP CONSTANT 0
1 + DUP CONSTANT 
1 + DUP CONSTANT 
1 + DUP CONSTANT 
1 + DUP CONSTANT 
CONSTANT 

0 0 407 255 
DS_MODALFRAME  WS_POPUP OR  WS_VISIBLE OR  WS_CAPTION OR  WS_SYSMENU OR
DS_SETFONT OR DS_CENTER OR
WS_MINIMIZEBOX OR
DIALOG: DLG
L" MS Sans Serif" 0 W,  (  204 W,)

350 240 50 14 
WS_VISIBLE WS_CHILD OR WS_TABSTOP OR
DI_Button DIALOGITEM

295 240 50 14 
WS_VISIBLE WS_CHILD OR WS_TABSTOP OR
DI_Button DIALOGITEM

0 18 164 221 
WS_VISIBLE WS_CHILD OR  WS_BORDER OR  TVS_HASBUTTONS OR
TVS_LINESATROOT OR  TVS_HASLINES OR  WS_TABSTOP OR
DI_Static DIALOGITEM
-10 ALLOT
L" SysTreeView32"
0 W, 0 ,

165 17 242 92 
WS_VISIBLE WS_CHILD OR  WS_BORDER OR  LVS_REPORT OR LVS_SORTASCENDING OR
WS_TABSTOP OR
DI_Static DIALOGITEM
-10 ALLOT
L" SysListView32"
0 W, 0 ,

165 111 242 87 
WS_VISIBLE WS_CHILD OR  WS_BORDER OR  LVS_REPORT OR
WS_TABSTOP OR
DI_Static DIALOGITEM
-10 ALLOT
L" SysListView32"
0 W, 0 ,

165 199 50 14 0
WS_VISIBLE WS_CHILD OR WS_BORDER OR
DI_Static DIALOGITEM

215 199 192 14 0
ES_MULTILINE ES_AUTOVSCROLL OR  ES_WANTRETURN OR
WS_VSCROLL OR
WS_VISIBLE OR  WS_CHILD OR WS_BORDER OR WS_TABSTOP OR
DI_Edit DIALOGITEM

165 215 50 24 
WS_VISIBLE WS_CHILD OR WS_BORDER OR
DI_Static DIALOGITEM

215 215 192 24 
ES_MULTILINE ES_AUTOVSCROLL OR  ES_WANTRETURN OR
WS_VSCROLL OR
WS_VISIBLE OR  WS_CHILD OR WS_BORDER OR WS_TABSTOP OR
DI_Edit DIALOGITEM

0 240 215 14 
WS_VISIBLE WS_CHILD OR WS_BORDER OR
DI_Static DIALOGITEM

225 240 65 14 
WS_VISIBLE WS_CHILD OR WS_TABSTOP OR BS_AUTOCHECKBOX OR
DI_Button DIALOGITEM

\ ---------------------------  
0 VALUE 
0 VALUE 

:  ( id -- hwnd )
   GetDlgItem 
;
: ID ( hwnd -- id )
  GetDlgCtrlID
;
:  ( lparam wparam msg id -- lresult )
   SendMessageA
;
\ ----------  Notification Messages ------
0
4 -- NMHDR.hwndFrom
4 -- NMHDR.idFrom
4 -- NMHDR.code
CONSTANT /NMHDR

0
4 -- POINT.x
4 -- POINT.y
CONSTANT /POINT

0
/NMHDR -- LV_KEYDOWN.hdr
     2 -- LV_KEYDOWN.wVKey
     4 -- LV_KEYDOWN.flags
CONSTANT /LV_KEYDOWN

\ ----------------------  ----------------
DECIMAL
LVM_FIRST  3 + CONSTANT LVM_SETIMAGELIST
LVM_FIRST  5 + CONSTANT LVM_GETITEM
LVM_FIRST  8 + CONSTANT LVM_DELETEITEM
LVM_FIRST  7 + CONSTANT LVM_INSERTITEM
LVM_FIRST 27 + CONSTANT LVM_INSERTCOLUMN
LVM_FIRST 28 + CONSTANT LVM_DELETECOLUMN
LVM_FIRST 45 + CONSTANT LVM_GETITEMTEXT
LVM_FIRST 46 + CONSTANT LVM_SETITEMTEXT
LVM_FIRST  9 + CONSTANT LVM_DELETEALLITEMS
-100 CONSTANT LVN_FIRST               ( 0U-100U)       \ listview
LVN_FIRST   0 - CONSTANT LVN_ITEMCHANGING        ( LVN_FIRST-0)
LVN_FIRST   1 - CONSTANT LVN_ITEMCHANGED         ( LVN_FIRST-1)
LVN_FIRST   2 - CONSTANT LVN_INSERTITEM          ( LVN_FIRST-2)
LVN_FIRST   3 - CONSTANT LVN_DELETEITEM          ( LVN_FIRST-3)
LVN_FIRST   4 - CONSTANT LVN_DELETEALLITEMS      ( LVN_FIRST-4)
LVN_FIRST   5 - CONSTANT LVN_BEGINLABELEDIT      ( LVN_FIRST-5)
LVN_FIRST   6 - CONSTANT LVN_ENDLABELEDIT        ( LVN_FIRST-6)
LVN_FIRST   8 - CONSTANT LVN_COLUMNCLICK         ( LVN_FIRST-8)
LVN_FIRST   9 - CONSTANT LVN_BEGINDRAG           ( LVN_FIRST-9)
LVN_FIRST  11 - CONSTANT LVN_BEGINRDRAG          ( LVN_FIRST-11)
LVN_FIRST  55 - CONSTANT LVN_KEYDOWN

0 
4 -- LV_COLUMN.mask
4 -- LV_COLUMN.fmt
4 -- LV_COLUMN.cx
4 -- LV_COLUMN.pszText
4 -- LV_COLUMN.cchTextMax
4 -- LV_COLUMN.iSubItem
CONSTANT /LV_COLUMN

0
4 -- LV_ITEM.mask
4 -- LV_ITEM.iItem
4 -- LV_ITEM.iSubItem
4 -- LV_ITEM.state
4 -- LV_ITEM.stateMask
4 -- LV_ITEM.pszText
4 -- LV_ITEM.cchTextMax
4 -- LV_ITEM.iImage       \ index of the list view item's icon 
4 -- LV_ITEM.lParam       \ 32-bit value to associate with item 
CONSTANT /LV_ITEM

0
/NMHDR -- NM_LISTVIEW.hdr
     4 -- NM_LISTVIEW.iItem
     4 -- NM_LISTVIEW.iSubItem
     4 -- NM_LISTVIEW.uNewState
     4 -- NM_LISTVIEW.uOldState
     4 -- NM_LISTVIEW.uChanged
/POINT -- NM_LISTVIEW.ptAction
     4 -- NM_LISTVIEW.lParam
CONSTANT /NM_LISTVIEW


\ *******      ListViewColumn
\ HERE 7 + 8 / 8 * HERE - ALLOT
HERE DUP /LV_COLUMN DUP ALLOT ERASE
CONSTANT L.C
LVCF_TEXT LVCF_SUBITEM OR LVCF_WIDTH OR LVCF_FMT OR L.C LV_COLUMN.mask !
100 L.C LV_COLUMN.cx !

\ *******      ListViewItem
\ HERE 7 + 8 / 8 * HERE - ALLOT
HERE DUP /LV_ITEM DUP ALLOT ERASE
CONSTANT L.I
LVIF_TEXT LVIF_IMAGE OR LVIF_PARAM OR L.I LV_ITEM.mask !

:  ( c-addr u  -- )
  >R
  HERE OVER + 0!  HERE SWAP MOVE
  HERE  L.C LV_COLUMN.pszText !
  L.C 1000 LVM_INSERTCOLUMN R>  DROP
;
:  ( cx -- )
  L.C LV_COLUMN.cx !
;
:  ( c-addr u -- )
   
;
:  ( fmt c-addr u -- )
  ROT L.C LV_COLUMN.fmt !
   
;

:  ( index  -- )
  >R
  0 SWAP LVM_DELETECOLUMN R>  DROP
;
:  ( index -- )
   
;
:  ( index -- )
   
;

: 
  >R
  0 0 LVM_DELETEALLITEMS R>  DROP
;
: 
   
;
: 
   
;
\ -------------------------     

VARIABLE  ( item=nfa )
VARIABLE 
VARIABLE 
\ -----------------------   FORTH   ---
VOCABULARY CLS1
VOCABULARY 
ALSO  DEFINITIONS

CREATE  ALSO CLS1 CONTEXT @ , PREVIOUS
CREATE  ALSO CLS1 CONTEXT @ , PREVIOUS

PREVIOUS

ALSO CLS1 DEFINITIONS
: @@  @ 0 <# #S #> ;
: @@>> S" " ;
PREVIOUS

FORTH-WORDLIST SET-CURRENT
\ --------------------------------------------------------

VARIABLE    TRUE  !

:  ( item  -- )
  >R
  DUP  !
  DUP L.I LV_ITEM.lParam !
  DUP ?VOC IF DUP ?LINK IF 3 ELSE 0 THEN
           ELSE 2 THEN  L.I LV_ITEM.iImage !
  COUNT
  HERE OVER + 0!  HERE SWAP MOVE
  HERE L.I LV_ITEM.pszText !
  1000000 L.I LV_ITEM.iItem !
  0 L.I LV_ITEM.iSubItem !
  L.I 0 LVM_INSERTITEM R@ 
  DUP  !
  10 MOD 0=  @ AND
  IF 0 0 WM_PAINT R>  DROP
  ELSE R> DROP THEN
;
:  ( item -- )
   
;
:  ( item -- )
   
;
:  ( item -- )
  DUP ?VOC
  IF 
  ELSE  THEN
;

:  ( c-addr u  -- )
  >R
   @ L.I LV_ITEM.iItem !
   @ L.I LV_ITEM.iSubItem !
  HERE OVER + 0!  HERE SWAP MOVE
  HERE L.I LV_ITEM.pszText !
  L.I   @  LVM_SETITEMTEXT
  R>  DROP
;
:  ( c-addr u -- )
   
;
:  ( c-addr u -- )
   
;

:  ( h -- )
  DUP
  LVSIL_SMALL LVM_SETIMAGELIST       DROP
  LVSIL_SMALL LVM_SETIMAGELIST   DROP
;

\ ---------------------  ---------------------
-4
4 -- W-LINK
4 -- W-LAST \      
4 -- W-NAME \      
4 -- W-PAR  \ wid -
4 -- W-CLS  \   = wid ,   
CONSTANT /WORDLIST

0
4 -- TV_ITEM.mask
4 -- TV_ITEM.hItem
4 -- TV_ITEM.state
4 -- TV_ITEM.stateMask
4 -- TV_ITEM.pszText
4 -- TV_ITEM.cchTextMax
4 -- TV_ITEM.iImage
4 -- TV_ITEM.iSelectedImage
4 -- TV_ITEM.cChildren
4 -- TV_ITEM.lParam
CONSTANT /TV_ITEM

       0
       4 -- TV_INSERTSTRUCT.hParent
       4 -- TV_INSERTSTRUCT.hInsertAfter
/TV_ITEM -- TV_INSERTSTRUCT.item
CONSTANT /TV_INSERTSTRUCT

       0
  /NMHDR -- NM_TREEVIEW.hdr
       4 -- NM_TREEVIEW.action
/TV_ITEM -- NM_TREEVIEW.itemOld
/TV_ITEM -- NM_TREEVIEW.itemNew
  /POINT -- NM_TREEVIEW.ptDrag
CONSTANT /NM_TREEVIEW


TV_FIRST 0 + CONSTANT TVM_INSERTITEM
TV_FIRST 1 + CONSTANT TVM_DELETEITEM
TV_FIRST 2 + CONSTANT TVM_EXPAND
TV_FIRST 9 + CONSTANT TVM_SETIMAGELIST
TV_FIRST 10 + CONSTANT TVM_GETNEXTITEM
TV_FIRST 13 + CONSTANT TVM_SETITEM
TV_FIRST 19 + CONSTANT TVM_SORTCHILDREN

          -400 CONSTANT TVN_FIRST               ( 0U-400U)
          -499 CONSTANT TVN_LAST                ( 0U-499U)
TVN_FIRST  1 - CONSTANT TVN_SELCHANGING         ( TVN_FIRST-1)
TVN_FIRST  2 - CONSTANT TVN_SELCHANGED          ( TVN_FIRST-2)
TVN_FIRST  5 - CONSTANT TVN_ITEMEXPANDING       ( TVN_FIRST-5)
TVN_FIRST  6 - CONSTANT TVN_ITEMEXPANDED        ( TVN_FIRST-6)
TVN_FIRST  7 - CONSTANT TVN_BEGINDRAG           ( TVN_FIRST-7)
TVN_FIRST  8 - CONSTANT TVN_BEGINRDRAG          ( TVN_FIRST-8)
TVN_FIRST  9 - CONSTANT TVN_DELETEITEM          ( TVN_FIRST-9)
TVN_FIRST 10 - CONSTANT TVN_BEGINLABELEDIT      ( TVN_FIRST-10)
TVN_FIRST 11 - CONSTANT TVN_ENDLABELEDIT        ( TVN_FIRST-11)
TVN_FIRST 12 - CONSTANT TVN_KEYDOWN             ( TVN_FIRST-12)

\ *******      TreeViewItem
\ HERE 7 + 8 / 8 * HERE - ALLOT
HERE DUP /TV_INSERTSTRUCT DUP ALLOT ERASE
CONSTANT I.S  
TVI_FIRST I.S TV_INSERTSTRUCT.hInsertAfter !
TVIF_TEXT TVIF_IMAGE OR TVIF_HANDLE OR TVIF_SELECTEDIMAGE OR TVIF_PARAM OR
TVIF_CHILDREN OR
I.S TV_INSERTSTRUCT.item TV_ITEM.mask !
1 I.S TV_INSERTSTRUCT.item TV_ITEM.hItem !

VARIABLE 
VARIABLE 

:  ( WID -- )
  DUP I.S TV_INSERTSTRUCT.item TV_ITEM.lParam !
  W-NAME @ COUNT
  HERE OVER + 0!  HERE SWAP MOVE
  HERE I.S TV_INSERTSTRUCT.item TV_ITEM.pszText !
   @ I.S TV_INSERTSTRUCT.hParent !
  I.S 0 TVM_INSERTITEM  
   !
;
:  ( lparam -- wid )
  \    ""    wid 
  NM_TREEVIEW.itemOld TV_ITEM.lParam @
;
:  ( lparam -- hitem )
  NM_TREEVIEW.itemNew TV_ITEM.hItem @
;
:  ( lparam -- wid )
  \        wid 
  NM_TREEVIEW.itemNew TV_ITEM.lParam @
;
:  ( -- hitem )
  0 TVGN_CARET TVM_GETNEXTITEM  
;
: 
   0 TVM_SORTCHILDREN   DROP
;
: 
  TVI_ROOT 0 TVM_DELETEITEM   DROP
;
\ ------------------  ----------------
: LOAD-ICON16 ( c-addr u -- hicon ) \      *.ico
  DROP >R
  LR_LOADFROMFILE 16 16 IMAGE_ICON R> 0 LoadImageA
;
:  ( -- h )
  0 3 ILC_MASK 16 16 ImageList_Create
;
:  ( h c-addr u -- index )
  LOAD-ICON16 SWAP ImageList_AddIcon
;
:  ( index -- )
  I.S TV_INSERTSTRUCT.item TV_ITEM.iSelectedImage !
;
:  ( index -- )
  I.S TV_INSERTSTRUCT.item TV_ITEM.iImage !
;
:  ( index -- )
  L.I LV_ITEM.iImage !
;

\ ---------------------------------------------------------------------------
0
4 -- TBBUTTON.iBitmap
4 -- TBBUTTON.idCommand
1 -- TBBUTTON.fsState
1 -- TBBUTTON.fsStyle
1 -- TBBUTTON.bReserved1
1 -- TBBUTTON.bReserved2
4 -- TBBUTTON.dwData
4 -- TBBUTTON.iString
CONSTANT /TBBUTTON

: TB-BUTTON ( idCommand iBitmap -- )
  HERE DUP >R /TBBUTTON DUP ALLOT ERASE
  R@ TBBUTTON.iBitmap !
  R@ TBBUTTON.idCommand !
  TBSTYLE_BUTTON R@ TBBUTTON.fsStyle C!
  TBSTATE_ENABLED R@ TBBUTTON.fsState C!
  R> DROP
;
: 
  HERE DUP >R /TBBUTTON DUP ALLOT ERASE
  TBSTYLE_SEP R> TBBUTTON.fsStyle C!
;
100 CONSTANT 
101 CONSTANT 
102 CONSTANT 
103 CONSTANT 
104 CONSTANT 
105 CONSTANT 
106 CONSTANT 
107 CONSTANT 
108 CONSTANT 
109 CONSTANT 

CREATE TBBUTTONS
                0 TB-BUTTON
              1 TB-BUTTON
            2 TB-BUTTON

               3 TB-BUTTON
 4 TB-BUTTON
             5 TB-BUTTON

             6 TB-BUTTON
           7 TB-BUTTON
             8 TB-BUTTON
          9 TB-BUTTON

: Toolbar
  /TBBUTTON 16 16 16 16 12 TBBUTTONS
  LR_LOADFROMFILE \ LR_LOADTRANSPARENT OR
  16 160 IMAGE_BITMAP S" ICO\1.BMP" DROP 0 LoadImageA
  0 10 100 WS_CHILD WS_VISIBLE OR  CreateToolbarEx
;
\ ---------------------------------------------------------------------------

HEX
#define OFN_NOCHANGEDIR              0x00000008
#define OFN_CREATEPROMPT             0x00002000
#define OFN_EXPLORER                 0x00080000
DECIMAL

0
4 -- OF.lStructSize
4 -- OF.hwndOwner
4 -- OF.hInstance
4 -- OF.lpstrFilter
4 -- OF.lpstrCustomFilter
4 -- OF.nMaxCustFilter
4 -- OF.nFilterIndex
4 -- OF.lpstrFile
4 -- OF.nMaxFile
4 -- OF.lpstrFileTitle
4 -- OF.nMaxFileTitle
4 -- OF.lpstrInitialDir
4 -- OF.lpstrTitle
4 -- OF.Flags
2 -- OF.nFileOffset
2 -- OF.nFileExtension
4 -- OF.lpstrDefExt
4 -- OF.lCustData
4 -- OF.lpfnHook
4 -- OF.lpTemplateName
CONSTANT /OPENFILENAME
 
: S, ( addr u -- )
  HERE SWAP DUP ALLOT MOVE
;
CREATE O.F HERE /OPENFILENAME DUP ALLOT ERASE
/OPENFILENAME O.F OF.lStructSize !
HERE O.F OF.lpstrFilter !
S"   (*.*)" S, 0 C, S" *.*" S, 0 W,
1 O.F OF.nFilterIndex !
OFN_CREATEPROMPT OFN_EXPLORER OR OFN_NOCHANGEDIR OR O.F OF.Flags !

WINAPI: GetOpenFileNameA COMDLG32.DLL
:  ( -- flag )
  HERE O.F OF.lpstrFile ! HERE 0!
  500 O.F OF.nMaxFile ! O.F GetOpenFileNameA
;
\ ---------------------------------------------------------------------------
:  ( addr u id -- )
  \           
  >R
  DROP 1 EM_REPLACESEL R>  DROP
;
:  ( id -- )
  >R 0 1 EM_SETREADONLY R>  DROP
;
:  ( id -- )
  >R 0 0 EM_SETREADONLY R>  DROP
;
\ ---------------------------------------------------------------------------

\ item=NFA , prop=NFA 

:  ( item1 -- item2 )
  BEGIN
    CDR DUP ?
  WHILE
    CDR
  REPEAT
;
:  ( wid -- item )
  W-LAST @
  BEGIN
    DUP ?
  WHILE
    
  REPEAT
;
\ ---------------------------------------------------------------------------
\  
WINAPI: CreatePopupMenu USER32.DLL
WINAPI: AppendMenuA     USER32.DLL
WINAPI: TrackPopupMenu  USER32.DLL
WINAPI: DestroyMenu     USER32.DLL

0 CONSTANT MF_STRING
0 CONSTANT TPM_LEFTBUTTON
0 CONSTANT TPM_LEFTALIGN

VARIABLE 

:  ( x y wid -- )
  CreatePopupMenu >R
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC 0= IF
    DUP DUP COUNT HERE OVER + 0!
    HERE SWAP MOVE HERE SWAP
    MF_STRING R@ AppendMenuA DROP THEN
    
  REPEAT DROP 2>R
  0  0  2R> SWAP TPM_LEFTBUTTON TPM_LEFTALIGN OR R@ TrackPopupMenu DROP
  R>  !
;
\ ---------------------------------------------
:  ( xt -- )
  >R
  GET-CURRENT 
  BEGIN
    DUP 0<>
  WHILE
    DUP R@ EXECUTE
    
  REPEAT DROP
  R> DROP
;
: CLASS@
  CLASS@ ?DUP IF EXIT THEN
  ALSO  CONTEXT @ PREVIOUS
;
VARIABLE 

:  ( xt -- )
  >R
   0!
  GET-CURRENT CLASS@
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC IF ELSE
    DUP  !
    DUP R@ EXECUTE
     1+!
             THEN
    
  REPEAT DROP
  R> DROP
;
\  ( -- c-addr u ) \   - 
\  ( c-addr u -- )

:  ( prop -- c-addr u )
  NAME> >BODY @ ( wid  )
   @ ?VOC
  IF S" @@>>" \     
  ELSE DUP  @ NAME> >BODY @ =
       IF S" @@" \    
       ELSE DROP S" (. )" EXIT THEN
  THEN
  ROT SEARCH-WORDLIST
  IF EXECUTE ELSE S" ( )" THEN
;
:  ( prop -- )
   @ 0=
  IF DROP EXIT (     ) THEN
   ( c-addr u )
  
;
:  ( item -- )
  DUP 
  ?VOC
  IF   IsDlgButtonChecked
     IF [']   THEN
  ELSE 
       1  !
        @ DUP ?PROP
       IF
          S" @@" ROT NAME> >BODY @
          SEARCH-WORDLIST
          IF EXECUTE ELSE S" ( .)" THEN
       ELSE 0 <# #S #> THEN
       
       2  !
        @ ?PROP
       IF
           @ NAME> >BODY @
          W-NAME @ ?DUP
          IF COUNT ELSE S" ()" THEN
       ELSE S" " THEN
       
  THEN
;
:  ( prop -- )
  DUP NAME> >BODY @ S" " ROT
  SEARCH-WORDLIST IF EXECUTE ELSE LVCFMT_LEFT THEN
  SWAP COUNT 
;
:  ( -- )
  [']  
  [']     
;
: 
  DROP 0 
;
: 
  
  
  [']  
\  0 
\  0 
\  0 
;
\ --------------------------------------------------------
: NAME>WID
  NAME> ALSO EXECUTE
  CONTEXT @ PREVIOUS
;
:  ( wid xt -- )
  >R
  DUP R@ EXECUTE
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC
    IF DUP NAME>WID R@
        @ >R
       RECURSE
       R>  !
    THEN
    
  REPEAT DROP
  R> DROP
;
:  ( -- )
   0!
  GET-CURRENT [']  
;
: ?
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC
    IF 1 I.S TV_INSERTSTRUCT.item TV_ITEM.cChildren !
       DROP EXIT
    THEN
    
  REPEAT DROP
  0 I.S TV_INSERTSTRUCT.item TV_ITEM.cChildren !
;
:  ( wid xt -- )
  >R
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC
    IF 
       @ OVER NAME>WID
      DUP ?
      R@ EXECUTE
       !
    THEN
    
  REPEAT DROP
  R> DROP
;
:  ( hitem wid -- )
  SWAP  !
  [']  
;
:  ( h -- )
  0 TVM_SETIMAGELIST   DROP
;
\ --------------------------------------------------------

:  ( c-addr u id -- )
  NIP  SetDlgItemTextA DROP
;
:  ( c-addr u id -- )
  >R
  R/O OPEN-FILE THROW >R
  HERE 10000 R@ READ-FILE THROW HERE + 0!
  R> CLOSE-FILE THROW
  HERE 10000 R> 
;
: 
  DROP  SetWindowTextA DROP
;

\ --------------------------------------------------------
: 
  0 0 EM_GETLINECOUNT  
  0 ?DO
    C/L TIB !
    TIB I EM_GETLINE  
    TIB SWAP EVALUATE
  LOOP
;
VARIABLE 
VARIABLE 

: 
  0 0 EM_GETSEL  
  65536 /MOD 2DUP   !  !
  = IF 
    ELSE 0  @  EM_LINEFROMCHAR   1+
         0  @ EM_LINEFROMCHAR  
         DO
           I 0  @ EM_LINEFROMCHAR   =
           IF  @
              0 I EM_LINEINDEX   -
           ELSE 0 THEN >IN !
           C/L TIB !
           TIB I EM_GETLINE   #TIB !
           I 0  @ EM_LINEFROMCHAR   =
           IF  @
              0 I EM_LINEINDEX   -
              #TIB !
           THEN
           INTERPRET
         LOOP
    THEN
;
\ -------------------------------------
VARIABLE 
VECT 

: WID ( widn .. wid1 n -- widn+1 .. wid1 n+1 )
  DUP PAR@ 0= IF 1 EXIT
              ELSE DUP >R PAR@ RECURSE R> SWAP 1+ THEN
;
: 
  GET-CURRENT WID SET-ORDER
\  CR ORDER CR
;
\ ---------------------------------------------------------------------------------
\    Windows    CASE-

VOCABULARY Windows

: M: ( "WM_..." -- )
  \   
  BASE @ >R HEX
  ' EXECUTE 0 <# [CHAR] m HOLD # # # #  # # # # BL HOLD [CHAR] : HOLD #>
  EVALUATE
  R> BASE !
;
: C:
  BASE @ >R HEX
  ' EXECUTE 0 <# #S [CHAR] c HOLD BL HOLD [CHAR] : HOLD #>
  EVALUATE
  R> BASE !
;
:  ( lparam wparam uint=msg hwnd wid -- TRUE | -"- FALSE )
  \     
  >R
  BASE @ >R HEX
  OVER 0 <# [CHAR] m HOLD # # # #  # # # # #>
  R> BASE !
  R> SEARCH-WORDLIST
  IF EXECUTE  ELSE FALSE THEN
;
VARIABLE 
: 
  DROP
  MB_ICONEXCLAMATION S" " DROP
  ROT  MessageBoxA DROP
;
:  ( ERRNO -- )
  >R S"         "
  OVER 24 + DUP 4 BL FILL
  R> 0
  BASE @ >R HEX <# # # # # #> R> BASE !
  ROT SWAP MOVE
  
;
:  ( lparam -- )
   NMHDR.idFrom @ DUP  = SWAP  = OR
   IF S" "   S" " 0 
      0 
\      S"  " 
   ELSE
   L.I LV_ITEM.iSubItem 0!
   HERE L.I LV_ITEM.pszText !
   30000 L.I LV_ITEM.cchTextMax !
   L.I  @ LVM_GETITEMTEXT  
   HERE OVER 0  0 
   1 L.I LV_ITEM.iSubItem !
   HERE L.I LV_ITEM.pszText !
   30000 L.I LV_ITEM.cchTextMax !
   L.I  @ LVM_GETITEMTEXT  
   HERE OVER  
   THEN
;
: 
   @ L.I LV_ITEM.iItem !
  L.I LV_ITEM.iSubItem 0!
  L.I 0 LVM_GETITEM  
  IF L.I LV_ITEM.lParam @ 
     0  @ LVM_DELETEITEM  
  ELSE S"    "  THEN
;
: 
  S"    " 
;
\ ----------------------------------------------------------------------------------
\   

ALSO Windows DEFINITIONS
\ 0 GET-CURRENT CLASS!

C: IDCANCEL
    EndDialog ( true ) DROP
;
C: 
    @ IF  ELSE  THEN
;
C: 
   
;
C: 
   
   IF  
      HERE ASCIIZ> INCLUDED
      
      0 GET-CURRENT 
      
   THEN
;

M: WM_CONTEXTMENU ( lparam wparam uint=msg hwnd -- TRUE )
   2DROP DROP [ HEX ] 10000 /MOD [ DECIMAL ]
   GET-CURRENT CLASS@  TRUE
;

M: WM_COMMAND ( lparam wparam uint=msg hwnd -- TRUE )
   BASE @ >R HEX 2>R
\   ." WM_COMMAND: WPARAM: " DUP 0 <# # # # # [CHAR] . HOLD # # # # #> TYPE CR
   DUP 0 <# #S [CHAR] c HOLD #> ALSO Windows CONTEXT @ PREVIOUS
   SEARCH-WORDLIST
   IF >R 2DROP R> 2R> 2DROP R> BASE ! EXECUTE TRUE
   ELSE 2R> R> BASE ! FALSE THEN
;

M: WM_NOTIFY ( lparam wparam uint=msg hwnd -- TRUE )
   >R 2>R DUP
   DUP NMHDR.idFrom @ TO 
       NMHDR.code @ 
       BASE @ >R HEX
       0 <# [CHAR] m HOLD # # # #  # # # # #>
       R> BASE !
       ALSO Windows CONTEXT @ PREVIOUS
       SEARCH-WORDLIST
       IF 2R> 2DROP ( DROP msg&wparam)
          R> DROP ( DROP hwnd )
         ( lparam xt ) EXECUTE 1
       ELSE 2R> R> FALSE THEN
;
M: TVN_SELCHANGED ( lparam -- )
   DUP   !
\    DUP  

   
    SET-CURRENT
   
   
;
M: TVN_ITEMEXPANDING
   DUP NM_TREEVIEW.action @ TVE_EXPAND =
   IF
      NM_TREEVIEW.itemNew DUP
      TV_ITEM.hItem @
      SWAP TV_ITEM.lParam @
      
   ELSE NM_TREEVIEW.itemNew
      TV_ITEM.hItem @ TVE_COLLAPSE TVE_COLLAPSERESET OR
      TVM_EXPAND   DROP
   THEN
;
M: LVN_KEYDOWN ( lparam -- )
   >R
\   R@ LV_KEYDOWN.wVKey W@ ." KEYDOWN=" . ." FROM="
\    .
     =
   R@ LV_KEYDOWN.wVKey W@ 46 = AND
   IF  THEN
   R> DROP
;
M: TVN_KEYDOWN ( lparam -- )
\   LV_KEYDOWN.wVKey W@ ." KEYDOWN=" . ." FROM="
\    .
     =
   R@ LV_KEYDOWN.wVKey W@ 46 = AND
   IF  THEN
   R> DROP
;
M: LVN_ITEMCHANGED ( lparam -- )
   NM_LISTVIEW.iItem @  !
;
M: NM_DBLCLK ( lparam -- )
   
;
\ M: NM_RCLICK
\    DROP ." RCLICK" CR
\ ;
\ M: NM_RETURN
\    DROP ." RETURN" CR
\ ;

M: WM_INITDIALOG ( lparam wparam uint=msg hwnd -- TRUE )
   TO  DROP 2DROP

\  S" README!.TXT"                  
   S" "                           
   S" "                   
   S" "               0      
   S" "                      
   S"  "             
   S" ICO\BOOKS04.ICO" LOAD-ICON16 -14  SetClassLongA DROP
   1   CheckDlgButton DROP
   S"    XX.XX.XXXX  XX.XX.XXXX"
   OVER 17 +  @ >S ROT SWAP MOVE
   OVER 31 +   @ >S ROT SWAP MOVE
    
   Toolbar

   
   DUP S" ICO\FOLDER03.ICO"   DROP \ 
   DUP S" ICO\FOLDER04.ICO"   
   DUP S" ICO\RTFDOC.ICO"     DROP \ 
   DUP S" ICO\WORDPAD.ICO"    DROP \   
   DUP 
       

\   
   0 GET-CURRENT 
   S" " 
   190 
   S" " 
   53 
   S" " 
   100 
   

   S"  v0.9 (alpha 11.04.96) for Windows 95/NT" 
   TRUE
;

PREVIOUS DEFINITIONS
\ ---------------------------------------------------------------------

: (DlgWndProc)     ( lparam wparam uint hwnd -- flag )
  \   

  DUP TO 
  S0 @ >R SP@ 4 CELLS + S0 !

  ALSO Windows CONTEXT @ PREVIOUS
  [']  CATCH ?DUP

  IF 
     DROP 2DROP 2DROP 0
  ELSE IF 1 ELSE 2DROP 2DROP 0 THEN THEN
  R> S0 !
;

' (DlgWndProc) WNDPROC: DlgWndProc

VARIABLE 

\ ---------------------------------------------------------------------
VECT 
: 
  1 TO BL
  >IN @ BL WORD COUNT GET-CURRENT SEARCH-WORDLIST
  IF ALSO EXECUTE DEFINITIONS DROP ( IN)
     \ ." : " SOURCE TYPE ."   (: " GET-CURRENT PAR@ W-NAME @ ID. ." )" CR
  ELSE >IN !
       VOCABULARY ALSO
       
       LATEST NAME> EXECUTE DEFINITIONS
       GET-CURRENT CLASS!
  THEN
  32 TO BL
;
: O  ;
: <<
   >IN @  @ > 0=
   IF  @ >IN @ - 3 +
      3 / 0 ?DO PREVIOUS DEFINITIONS LOOP
   THEN
   >IN @  @ 3 + MIN  !
;
: 1
  WORDLIST
; ' 1 TO 

: >> ( "" -- )
  << \ BL SKIP
    1 TO BL
  >IN @ BL WORD COUNT GET-CURRENT SEARCH-WORDLIST
  IF ALSO EXECUTE DEFINITIONS DROP ( IN)
     \ ." : " SOURCE TYPE ."   (: " GET-CURRENT PAR@ W-NAME @ ID. ." )" CR
  ELSE >IN !
       VOCABULARY ALSO
       
       LATEST NAME> EXECUTE DEFINITIONS
       GET-CURRENT CLASS!
  THEN
  32 TO BL
;
: >^
  <<
  >IN @ >R
  ' DUP
  R> >IN ! CREATE , LINK VOC
  ALSO EXECUTE DEFINITIONS
  DOES> @ EXECUTE
;
:  ( -- )
  LATEST CDR 0= IF EXIT THEN
  LATEST DUP CDR DUP CURRENT @ !
  BEGIN
    DUP CDR 0<>
  WHILE
    CDR
  REPEAT NAME>L !
  LAST @ NAME>L 0!
;
:   @ NAME> >BODY CELL+ ;

:  ( wid -- item true | false )
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC
    IF DUP NAME>WID
       RECURSE IF NIP TRUE EXIT THEN
    ELSE
       DUP COUNT
        @ COUNT COMPARE 0=
       OVER COUNT  @ COUNT 1- COMPARE 0= OR ( ^)
       IF NAME> >BODY CELL+ TRUE EXIT THEN
    THEN
    
  REPEAT DROP FALSE
;
: 
   @ NAME>WID
  
;

:  ( SUM1 wid -- SUM2 )
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC
    IF DUP NAME>WID
       ROT SWAP RECURSE SWAP
    ELSE
       DUP COUNT
        @ COUNT COMPARE 0=
       IF DUP NAME> >BODY CELL+ @ ROT + SWAP THEN
    THEN
    
  REPEAT DROP
;
:  ( -- SUM )
  0
   @ NAME>WID
  
;
:  ( wid1 wid2 -- )
\   wid2     wid1 (  )
  GET-CURRENT >R TIB >R #TIB @ >R >IN @ >R
  SET-CURRENT >IN 0! DUP W-NAME @ COUNT #TIB ! TO TIB
  CREATE , VOC LINK R> >IN ! R> #TIB ! R> TO TIB R> SET-CURRENT
  DOES> @ CONTEXT !
;

: == POSTPONE \ ;
: ## POSTPONE \ ;

\ ---------------------------------------------------------------------
\  

VOCABULARY 
ALSO  DEFINITIONS

>> 
<<
: T
  InitCommonControls DROP
  0 ['] DlgWndProc 0 DLG @ HINST DialogBoxIndirectParamA DROP
  BYE
;

: WID ( wid -- )
  DUP PAR@ ALSO  CONTEXT @ PREVIOUS
            = IF DROP S" \\" S, EXIT
              ELSE DUP >R PAR@ RECURSE R> W-NAME @ COUNT S, S" \" S, THEN
;
:  ( WID -- addr u )
  HERE DUP ROT
  WID
  HERE OVER - 0 , ROT DP !
;
: 1
   0! S" "  
  GET-CURRENT   
; ' 1 TO 

>> 
   >> 
   >> 
   >> 
>> 
<<
>> 
<<
: : \       
      \        
  GET-CURRENT >R
  GET-CURRENT CLASS@
  SET-CURRENT
  >IN @ >R
  ALSO  '
  PREVIOUS >BODY @
  R> >IN !
  CREATE , POSTPONE \
  
  R> SET-CURRENT
;
: >WID
  [ ALSO  ]
  ALSO 
  [ PREVIOUS ]
  BL SKIP [CHAR] \ TO BL
  1 PARSE EVALUATE
  32 TO BL CONTEXT @ PREVIOUS
;
: >WID
  [ ALSO  ]
  ALSO 
  [ PREVIOUS ]
  BL SKIP [CHAR] \ TO BL
  1 PARSE EVALUATE
  32 TO BL CONTEXT @ PREVIOUS
;
0
4 -- 
4 -- 
4 -- 
4 -- 
4 -- 
4 -- 
CONSTANT /

: + (  -- )
  HERE / -  +!
;
: + (  -- )
  HERE / -  +!
;
: 
  HERE / - >R
  R@  @  R@  @ -
  DUP 0< IF R@  DUP @ ROT - SWAP !
         ELSE R@  DUP @ ROT + SWAP ! THEN
  R> DROP
;
:  ( .. wid -- flag )
  
  BEGIN
    DUP 0<>
  WHILE
    DUP COUNT S" " COMPARE 0=
    IF DUP NAME> >BODY CELL+ >R
        @ NAME> >BODY CELL+ @ R@ @ =
       IF OVER R@ CELL+ CELL+ @ EXECUTE
          +
       THEN
        @ NAME> >BODY CELL+ @ R@ CELL+ @ =
       IF OVER R@ CELL+ CELL+ @ EXECUTE
          +
       THEN
       R> DROP
    THEN
    DUP COUNT S" " COMPARE 0=
    IF DUP NAME> >BODY CELL+ @
        @  @ 1+ WITHIN 0=
       IF 2DROP TRUE EXIT THEN
    THEN
    
  REPEAT 2DROP FALSE
;
:  ( .. wid -- )
  >R
  BEGIN
    DUP R@  IF R> 2DROP EXIT THEN
    R@ PAR@
    [ ALSO  ]
    ALSO  CONTEXT @ PREVIOUS
    [ PREVIOUS ] =
    R@ PAR@ 0= OR
    R> PAR@ >R
  UNTIL
  DROP R> DROP
;
: -
  CELL+ @
;
: 
  @
;
:  ( WID -- )
  DUP >R
  
  BEGIN
    DUP 0<>
  WHILE
    DUP ?VOC
    IF HERE / DUP ALLOT ERASE
       DUP NAME>WID
       RECURSE
       HERE / -  @ HERE / 2* -  +!
       HERE / -  @ HERE / 2* -  +!
       HERE / -  @ HERE / 2* -  +!
       HERE / -  @ HERE / 2* -  +!
       / NEGATE ALLOT
    ELSE
       DUP COUNT S" .." COMPARE 0=
       IF DUP NAME> >BODY CELL+
          R@ 
       THEN
    THEN
    
  REPEAT DROP
  R> DROP
;
: 
  DUP  @ SWAP  @ -
;
: 
  DUP  @ SWAP  @ -
;
: 
   @
;
: 
   @
;
: 
   @
;
: 
   @
;
: 
   @
;
: 
   @
;
: #SS
  DUP >R DABS #S R> SIGN
;

>> 
   >> 
      : @@  COUNT ;
      : @@>> 
             IF COUNT
             ELSE S" (???)" THEN
      ;
   >> 
      : @@  @ S>D <# #SS #> ;
      : @@>>  S>D <# #SS #> ;
      : !! BL WORD ?LITERAL , ;
      :  LVCFMT_RIGHT ;
   >> 
      :  LVCFMT_RIGHT ;
      : @@  >R
           0 0 <# 
                  R@ CELL+ @ 0 D+ #SS
                  BL HOLD BL HOLD BL HOLD
                  R@ @ R> CELL+ @ ?DUP IF / ELSE DROP 0 THEN 0 D+ #SS
                #> ;
      : @@>>  S>D <# #SS #> ;
      : !! BL WORD ?LITERAL BL WORD ?LITERAL SWAP OVER * , , ;
   >> 
      :  LVCFMT_RIGHT ;
      : @@  @ S>D <# #SS #> ;
      : @@>> 
             IF @ S>D <# #SS #>
             ELSE S" (???)" THEN
      ;
      : !! BL WORD ?LITERAL , ;
   >> 
      : @@  @ >S
      ;
      : @@>> 
                  IF @ >S
                  ELSE S" (???)" THEN
      ;
      : !! >: , ;
   >> ^
      : @@>>  @ >R
             R@ NAME>WID PAR@ W-NAME @  !
             
                  IF @ >S
                  ELSE S" (???)" THEN
             R>  !
      ;
   >> ^
      : @@>>  @ NAME>WID PAR@ W-NAME @ COUNT ;
   >> 
      :  LVCFMT_RIGHT ;
      : !! POSTPONE \ ;
      : @@ S" (     )" ;
      : ::: BL WORD FIND IF , ELSE DROP [']  , THEN ;
      : @@>> HERE / DUP ALLOT ERASE
         @ NAME>WID 
        
        HERE / -  @ NAME> >BODY CELL+ CELL+ @ EXECUTE
        S>D <# #SS #>
        / NEGATE ALLOT R> DROP
      ;
   >> 
      : !! >WID DUP , GET-CURRENT SWAP  ;
      : @@  @  ;
      : @@>> 
             IF @ W-NAME @ COUNT
             ELSE S" (???)" THEN ;
   >> ^
      : @@>>  @ >R
             R@ NAME>WID PAR@ W-NAME @  !
             
             IF @ 
             ELSE S" (???)" THEN
             R>  !
      ;
   >> 
      : !! >WID DUP , GET-CURRENT SWAP  ;
      : @@  @  ;
      : @@>> 
             IF @ W-NAME @ COUNT
             ELSE S" (???)" THEN ;
   >> ^
      : @@>>  @ >R
             R@ NAME>WID PAR@ W-NAME @  !
             
             IF @ 
             ELSE S" (???)" THEN
             R>  !
      ;
   >> 
      : !! >WID DUP , GET-CURRENT ( PAR@) SWAP  ;
      : @@  @  ;
      : @@>> 
             IF @ W-NAME @ COUNT
             ELSE S" (???)" THEN ;
   >> 
      :  LVCFMT_RIGHT ;
      : !! HERE  0 , :NONAME SWAP ! ;
      : @@  @ EXECUTE S>D <# #SS #> ;
   >> 
      : !! >IN @ >R
        ALSO  ' ' PREVIOUS
        SWAP , , HERE 0 ,
        >IN @ R> >IN ! 1 WORD ", >IN !
        :NONAME SWAP !
      ;
      : @@  CELL+ CELL+ CELL+ COUNT ;
<<
: : 
  ALSO  '
  PREVIOUS ALSO EXECUTE
  CONTEXT @ PREVIOUS
  CREATE DUP ,
  S" " ROT SEARCH-WORDLIST
  IF EXECUTE ELSE POSTPONE \ THEN
  
;
>> 
   :     

   :     
   :     
   :     
   :     
   :      
   :      
   :      
   :     
   :     
   :      70.  ".   "
   :      71.  ".  . "

   :     
   :     
   :     
   :     

   :     
   :     
   :     
   :     
   :     
   :     
   :     -
   :     
   :     -
   :     
   :     
   :     
   :     
   :     /
   :     /
   :     
   :     0
   :     
   :     
   :     
   :     -
   :     

   :     
   :     2
   :     3
   :     
   :     
   :     -

   :      45.  " "
   :      46.  " "
   :      60.  ".  .  ."
   :      60.3 " "
   :      61.  ".   "
   :      61.1 ".   
   :      61.2 ".  "
   :      61.3 " "
   :      62.  ".  .  ."
   :      63.  "  "
   :      64.  ".   ."
   :      75.  "  "
   :      76.  ".  . .  ."
   :      
   :      
   :      
   :      
   :      51.
   :      41.
   :      
   :      62.
   :      60.

   :     
   :     
   :     
   :      
   :      
   :     
   :     
   :     
   :     

   :     

   :   
   :   
   : ^ ^
   : ^ ^
   : ^ ^
   : ^    ^
   :   
   :     
   :     
   :   
   :   
   :  ..

   :  
<<
>> 
   : 
<<
>> 
   : 
<<
: == \    
     \  
  >IN @ BL WORD DROP BL WORD C@ 0= IF DROP POSTPONE \ EXIT THEN
  >IN !
  >IN @ CREATE >IN ! PROP
  
  ALSO  '
  PREVIOUS >BODY @
  DUP , S" !!" ROT SEARCH-WORDLIST
  BL SKIP
  IF EXECUTE ELSE 1 WORD ", THEN
;
: 
  >IN @ BL WORD DROP BL WORD C@ 0= IF DROP POSTPONE \ EXIT THEN
  >IN !
  >IN @ CREATE >IN ! PROP
  ALSO  '
  PREVIOUS >BODY @
  DUP , S" !!" ROT SEARCH-WORDLIST
  BL SKIP
  IF EXECUTE ELSE 1 WORD ", THEN
;
: C    ;

: :: \     
  >IN @ >R
  ALSO  ' DUP
  PREVIOUS >BODY @ DUP
  R> >IN !  >R
  CREATE , , \    xt - 
  S" :::" R> SEARCH-WORDLIST
  IF EXECUTE ELSE POSTPONE \ THEN
  
;
\ : : ( "    " -- )
\   S" CREATE " EVALUATE
\   ALSO  ' ' PREVIOUS
\   SWAP , , HERE 0 , :NONAME SWAP !
\ ;

>> 
   >> 
      :: 
      :: 62.
\      :: 62. 
\      :: 
\      :: 
\      :: 60.
      :: 
      >> 
         :: 
\         :: 
         :: ..
         :: 62.
         >> 
            :: 
            :: 
            :: ..
            :: 62.
\            :: 
   >> 
      :: 
      >> 
         :: 
         :: 
         :: 70.
         :: 71.
   >> 
      :: 
      :: ..
      >> 
         :: 
         :: 
         :: ..
         >> 
            :: 
            :: 
            :: ..
   >> 
      :: 
\      :: 
      :: 41. 
      :: 41. 
      >> 
         :: 
         :: 
         ::  
         :: 41. 
\         :: -
\         :: 
         :: 
         >> 
            :: 
            :: ^
            :: ^
            :: ^
            :: ..
            :: ^
   >> 
      :: 
      :: 
      :: 
      >> 
         :: 
         :: ..
   >> 
      :: 
      :: 41. 
      :: 41. 
      :: 41. 
      >> 
         :: 
         :: ..
<<
: 2
  GET-CURRENT CLASS@
  
  DUP 0<>
  IF DUP ?VOC
     IF NAME>WID
     ELSE DROP 1 THEN
  ELSE DROP 1 THEN
; ' 2 TO 

: :
  ALSO  ' PREVIOUS
  ALSO EXECUTE CONTEXT @ PREVIOUS
  GET-CURRENT CLASS!
;
>> 
   >> 
      >> 
         : 
         ==     
         >> 
            : 
            >> 
               >> 
                  ==  
                  ==  
                  ==  01.01.1970
            >> 
               >>  ..
                  ==  
                  ==  
                  ==  31.12.1970
                  ==  31.12.1975
               >>  ..
                  ==  
                  ==  
                  ==  5 5 * ;
            >> 
               : 
         >> 
            : 
            >> 
            >> 
            >> 
      >> 
         : 
   >> 
      >> 
      >> 
      >> 
         : 
   >> 
      >> 
         : 
         >> 
         >> 
         >> 
         >> 
         >> 
            ==  51. 62.  ;
            ==     - ;
            ==     ;
      >> 
         : 
         >> 
         >> 
         >> 
      >> 
         >> 
            : 
            >> 
            >> 
            >> 
            >> 
               ==  41. 60.  ;
               ==   60. - ;
         >> 
            : 
            >> 
            >> 
         >> 
            : 
            >> 
               ==     ;
            >> 
               ==     ;
            >> 
               ==  62. 41.  ;
               ==     - ;
               ==  62.  - ;
      >> 
         : 
         >> 
         >> 
      >> 
      >> 
      >> 
<<
\ S" \.TXT" INCLUDED

TRUE TO ?GUI FALSE TO ?CONSOLE ' T DUP MAINX ! TO <MAIN> S" 0496.exe" SAVE
