[Win32forth-cvs] win32forth/apps/Win32ForthIDE JoinStr.f, NONE, 1.1 POINT.F, NONE, 1.1 RECT.F, NONE, 1.1 Splitter1.f, NONE, 1.1 Splitter2.f, NONE, 1.1 Splitter3.f, NONE, 1.1 Splitter4.f, NONE, 1.1 Splitter5.f, NONE, 1.1 Splitter6.f, NONE, 1.1 quiksort.f, NONE, 1.1

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE
In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv15446/apps/Win32ForthIDE

Added Files:
	JoinStr.f POINT.F RECT.F Splitter1.f Splitter2.f Splitter3.f 
	Splitter4.f Splitter5.f Splitter6.f quiksort.f 
Log Message:
IDE Enhancements. Bug Fixes. Doc Updates.

--- NEW FILE: RECT.F ---
\ Rect.f
\ Define general purpose object for drawing and erasing rectangles (boxes).

comment:
These routines to draw and erase a rectangle makes use of the Xor function.
The results look better on hi-color systems. An array could be used to store
the pixels for the drawing and erasing, which would work good on any color
system. But...

September 9th, 2003 - 22:18- Why didn't somebody tell me about the WinAPI
SetROP2 function? That function makes drawing rectangles on an image sooo
simple.

Comment;

anew -rect.f

:Class Rect             <Super Rectangle

int linewidth
int thedc
int drawmode
int drawcolor
ColorObject DotColor


:M ClassInit:   ( -- )
                ClassInit: super
                0 to thedc
                BLACK to drawcolor
                R2_NOT to drawmode      \ inverse drawing by default
                Color: BLACK NewColor: DotColor
                PS_DOT Put: DotColor.PenStyle
                InitColor: DotColor
                ;M

:M SetDrawColor: ( color -- )
                 to drawcolor ;M

:M GetDrawColor: ( -- color )
                 drawcolor ;M

:M SetDrawMode:  ( mode -- )
                to drawmode ;M

:M GetDrawMode: ( -- mode )
                drawmode ;M

:M SetDC:       ( dc -- )
                to thedc
                drawmode SetRop2: TheDC drop  \ set inverse line mode
                ;M

: drawrectangle ( -- )
                left top     Moveto: thedc
                right top    Lineto: thedc
                right bottom Lineto: thedc
                left bottom  Lineto: thedc
                left top     Lineto: thedc ;

:M DrawNormal:       ( -- )
               thedc
               if      drawcolor LineColor: thedc
                       drawrectangle
               then    ;M
               
:M DrawDotted: ( -- )
               drawcolor drawmode   2>r
               R2_COPYPEN  	( R2_NOTCOPYPEN	) SetRop2: thedc drop
               Addr: DotColor to drawcolor
               DrawNormal: self
               2r> to drawmode to drawcolor
               ;M

:M Sunken:      { color1 color2 -- }
                thedc
                if      R2_COPYPEN SetROP2: TheDC to drawmode
                        color1       LineColor: thedc
                        Left Bottom    MoveTo: thedc       \ dc must be valid
                        Left Top       LineTo: thedc
                        Right Top      LineTo: thedc
                        color2      LineColor: thedc
                        Right Bottom   LineTo: thedc
                        Left Bottom    LineTo: thedc
                        drawmode SetROP2: TheDC drop    \ restore
                then    ;M

:M PushButton:  ( -- )
                WHITE BLACK Sunken: self
                Left 1+ Top 1+ Right 1- Bottom 1- LTGRAY FillArea: thedc
                ;M

:M DrawFilled:  { fillcolor -- }
                Left Top Right Bottom fillcolor FillArea: thedc
                DrawNormal: self
                ;M

:M NoBorderFilled:      { fillcolor -- }
                        drawcolor       \ save
                        fillcolor to drawcolor
                        fillcolor DrawFilled: self
                        to drawcolor    \ restore
                        ;M
;Class
\ Rect Box        \ create instance

\s

--- NEW FILE: Splitter5.f ---
\ ForthForm generated splitter-window template
\ Modify according to your needs


:Object TopPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Top Pane" Textout: dc ;M

;Object


:Object BottomLeftPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Bottom Left Pane" Textout: dc
        ;M

;Object


:Object BottomRightPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Bottom Right Pane" Textout: dc ;M

;Object


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

COLOR_BTNFACE Call GetSysColor new-color BTNFACE

:Class SplitterBar   <Super child-window

:M WindowStyle: ( -- style )   \ return the window style
        WindowStyle: super
        [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M

:M On_Paint: ( -- )            \ screen redraw method
        0 0 Width Height BTNFACE FillArea: dc ;M

:M On_Init:     ( -- )
        \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of
        \ class Child-Window to prevent flicker in window on sizing.
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop ;M

;Class

SplitterBar SplitterH
SplitterBar SplitterV


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

0 value ToolBarHeight    \ set to height of toolbar if any
0 value StatusBarHeight  \ set to height of status bar if any
200 value TopHeight
150 value LeftWidth
5 value ThicknessH
5 value ThicknessV


:Object SplitterWindow   <Super Window

int dragging
int mousedown

: RightXpos       ( -- n )   LeftWidth ThicknessV + ;
: RightWidth      ( -- n )   Width RightXpos - ;
: SplitterYpos    ( -- n )   ToolBarHeight TopHeight + ;
: BottomYpos      ( -- n )   SplitterYpos ThicknessH + ;
: StatusBarYpos   ( -- n )   height StatusbarHeight - ;
: BottomHeight    ( -- n )   StatusBarYpos BottomYpos - ;
: TotalHeight     ( -- n )   StatusBarYpos ToolBarHeight - ;
: LeftWidthMin    ( -- n )   LeftWidth width min ;
: TopHeightMin    ( -- n )   TopHeight TotalHeight min ;

: position-windows ( -- )
        0          ToolBarHeight  Width         TopHeightMin  Move: TopPane
        0          BottomYpos     LeftWidthMin  BottomHeight  Move: BottomLeftPane
        RightXpos  BottomYpos     RightWidth    BottomHeight  Move: BottomRightPane
        LeftWidth  BottomYpos     ThicknessV    BottomHeight  Move: SplitterV
        0          SplitterYpos   Width         ThicknessH    Move: SplitterH
        ;

: Splitter ( -- n )   \ the splitter window the cursor is on
        hWnd get-mouse-xy
        dup ToolBarHeight StatusBarYpos within
        IF
            2dup BottomYpos height within  swap  LeftWidth RightXpos within  and
            IF  2drop  1
            ELSE  SplitterYpos BottomYpos within  swap  0 width within  and IF  2  ELSE  0  THEN
            THEN
        ELSE 2drop 0
        THEN ;

: On_Tracking ( -- )   \ set min and max values of LeftWidth and TopHeight here
        mousedown dragging or 0= ?EXIT
        dragging
        Case
            1 of  mousex  0max  width min  thicknessV 2/ -  to LeftWidth  endof
            2 of  mousey ToolBarHeight -  0max  TotalHeight min   thicknessH 2/ -  to TopHeight  endof
        EndCase
        position-windows
        WINPAUSE ;

: On_Clicked ( -- )
        mousedown not IF  hWnd Call SetCapture drop  THEN
        true to mousedown
        Splitter to dragging
        On_Tracking ;

: On_Unclicked ( -- )
        mousedown IF  Call ReleaseCapture drop  THEN
        false to mousedown
        false to dragging ;

: On_DblClick ( -- )
        false to mousedown
        Splitter 1 = 
        IF
            LeftWidth 8 >
            IF    0 thicknessV 2/ - to LeftWidth
            ELSE  Width thicknessV - 2/  to LeftWidth
            THEN
        position-windows
        THEN ;

:M WM_SETCURSOR ( h m w l -- )
        Splitter
        Case
            0  of  DefWindowProc: self  endof
            1  of  SIZEWE-CURSOR    1   endof
            2  of  SIZENS-CURSOR    1   endof
        EndCase
        ;M

:M Classinit: ( -- )
        ClassInit: super   \ init super class
        ['] On_Clicked     SetClickFunc: self
        ['] On_Unclicked   SetUnClickFunc: self
        ['] On_Tracking    SetTrackFunc: self
        ['] On_DblClick    SetDblClickFunc: self
        ;M

\ :M WindowHasMenu: ( -- f )   true ;M

:M WindowStyle: ( -- style )
        WindowStyle: Super WS_CLIPCHILDREN or ;M

:M On_Size: ( -- )
        position-windows ;M

:M On_Init: ( -- )
        \ prevent flicker in window on sizing
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop

        self Start: TopPane
        self Start: BottomLeftPane
        self Start: BottomRightPane
        self Start: SplitterH
        self Start: SplitterV
        ;M

;Object

\ start: SplitterWindow

--- NEW FILE: Splitter4.f ---
\ ForthForm generated splitter-window template
\ Modify according to your needs


:Object TopLeftPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Top Left Pane" Textout: dc ;M

;Object


:Object TopRightPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Top Right Pane" Textout: dc ;M

;Object


:Object BottomLeftPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Bottom Left Pane" Textout: dc
        ;M

;Object


:Object BottomRightPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Bottom Right Pane" Textout: dc ;M

;Object


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

COLOR_BTNFACE Call GetSysColor new-color BTNFACE

:Class SplitterBar   <Super child-window

:M WindowStyle: ( -- style )   \ return the window style
        WindowStyle: super
        [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M

:M On_Paint: ( -- )            \ screen redraw method
        0 0 Width Height BTNFACE FillArea: dc ;M

:M On_Init:     ( -- )
        \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of
        \ class Child-Window to prevent flicker in window on sizing.
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop ;M

;Class

SplitterBar SplitterH
SplitterBar SplitterV


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

0 value ToolBarHeight    \ set to height of toolbar if any
0 value StatusBarHeight  \ set to height of status bar if any
200 value TopHeight
150 value LeftWidth
5 value ThicknessH
5 value ThicknessV


:Object SplitterWindow   <Super Window

int dragging
int mousedown

: RightXpos       ( -- n )   LeftWidth ThicknessV + ;
: RightWidth      ( -- n )   Width RightXpos - ;
: SplitterYpos    ( -- n )   ToolBarHeight TopHeight + ;
: BottomYpos      ( -- n )   SplitterYpos ThicknessH + ;
: StatusBarYpos   ( -- n )   height StatusbarHeight - ;
: BottomHeight    ( -- n )   StatusBarYpos BottomYpos - ;
: TotalHeight     ( -- n )   StatusBarYpos ToolBarHeight - ;
: LeftWidthMin    ( -- n )   LeftWidth width min ;
: TopHeightMin    ( -- n )   TopHeight TotalHeight min ;

: position-windows ( -- )
        0          ToolBarHeight  LeftWidthMin  TopHeightMin  Move: TopLeftPane
        RightXpos  ToolBarHeight  RightWidth    TopHeightMin  Move: TopRightPane
        0          BottomYpos     LeftWidthMin  BottomHeight  Move: BottomLeftPane
        RightXpos  BottomYpos     RightWidth    BottomHeight  Move: BottomRightPane
        LeftWidth  ToolBarHeight  ThicknessV    TotalHeight   Move: SplitterV
        0          SplitterYpos   Width         ThicknessH    Move: SplitterH
        ;

: Splitter ( -- n )   \ the splitter window the cursor is on
        hWnd get-mouse-xy
        dup ToolBarHeight StatusBarYpos within
        IF
            2dup SplitterYpos BottomYpos within  swap  0 width within  and
            IF  2drop  2
            ELSE  ToolBarHeight StatusBarYpos within  swap  LeftWidth RightXpos within  and IF  1  ELSE  0  THEN
            THEN
        ELSE 2drop 0
        THEN ;

: On_Tracking ( -- )   \ set min and max values of LeftWidth and TopHeight here
        mousedown dragging or 0= ?EXIT
        dragging
        Case
            1 of  mousex  0max  width min  thicknessV 2/ -  to LeftWidth  endof
            2 of  mousey ToolBarHeight -  0max  TotalHeight min   thicknessH 2/ -  to TopHeight  endof
        EndCase
        position-windows
        WINPAUSE ;

: On_Clicked ( -- )
        mousedown not IF  hWnd Call SetCapture drop  THEN
        true to mousedown
        Splitter to dragging
        On_Tracking ;

: On_Unclicked ( -- )
        mousedown IF  Call ReleaseCapture drop  THEN
        false to mousedown
        false to dragging ;

: On_DblClick ( -- )
        false to mousedown
        Splitter 1 = 
        IF
            LeftWidth 8 >
            IF    0 thicknessV 2/ - to LeftWidth
            ELSE  Width thicknessV - 2/  to LeftWidth
            THEN
        position-windows
        THEN ;

:M WM_SETCURSOR ( h m w l -- )
        Splitter
        Case
            0  of  DefWindowProc: self  endof
            1  of  SIZEWE-CURSOR    1   endof
            2  of  SIZENS-CURSOR    1   endof
        EndCase
        ;M

:M Classinit: ( -- )
        ClassInit: super   \ init super class
        ['] On_Clicked     SetClickFunc: self
        ['] On_Unclicked   SetUnClickFunc: self
        ['] On_Tracking    SetTrackFunc: self
        ['] On_DblClick    SetDblClickFunc: self
        ;M

\ :M WindowHasMenu: ( -- f )   true ;M

:M WindowStyle: ( -- style )
        WindowStyle: Super WS_CLIPCHILDREN or ;M

:M On_Size: ( -- )
        position-windows ;M

:M On_Init: ( -- )
        \ prevent flicker in window on sizing
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop

        self Start: TopLeftPane
        self Start: TopRightPane
        self Start: BottomLeftPane
        self Start: BottomRightPane
        self Start: SplitterH
        self Start: SplitterV
        ;M

;Object

\ start: SplitterWindow

--- NEW FILE: quiksort.f ---
anew wilsort
\ ----------------------------------------------------------
\ Wil Baden's sorter
\  Set PRECEDES for different datatypes or sort order.
DEFER PRECEDES  ' < IS PRECEDES

\  For sorting character strings in increasing order:
: SPRECEDES         ( addr addr -- flag )  >R COUNT R> COUNT COMPARE 0< ;
: IPRECEDES         ( addr addr -- flag )  < ;
  ' SPRECEDES IS PRECEDES
internal
: EXCHANGE          ( addr_1 addr_2 -- )
    DUP @ >R  OVER @ SWAP !  R> SWAP ! ;
\ : -CELL ( -- n )  -1 CELLS ;
\ : CELL-  ( addr -- addr' )  1 CELLS - ;

: PARTITION         ( lo hi -- lo_1 hi_1 lo_2 hi_2 )
    2DUP OVER - 2/  -CELL AND +  @ >R  ( R: median)
    2DUP BEGIN      ( lo_1 hi_2 lo_2 hi_1)
         SWAP BEGIN  DUP @ R@   PRECEDES WHILE  CELL+  REPEAT
         SWAP BEGIN  R@ OVER @  PRECEDES WHILE  CELL-  REPEAT
         2DUP > NOT IF  2DUP EXCHANGE  >R CELL+ R> CELL-  THEN
    2DUP > UNTIL    ( lo_1 hi_2 lo_2 hi_1)
    R>DROP SWAP ROT ( lo_1 hi_1 lo_2 hi_2)
    ;

: QSORT             ( lo hi -- )
    PARTITION                ( lo_1 hi_1 lo_2 hi_2)
    2OVER 2OVER  - +         ( . . . . lo_1 hi_1+lo_2-hi_2)
        < IF  2SWAP  THEN    ( lo_1 hi_1 lo_2 hi_2)
    2DUP < IF  RECURSE  ELSE  2DROP  THEN
    2DUP < IF  RECURSE  ELSE  2DROP  THEN ;
external
: SORT              ( addr n -- )
    DUP 2 < IF  2DROP  EXIT THEN
    1- CELLS OVER + ( addr addr+{n-1}cells) QSORT ( ) ;
module
\ ----------------------------------------------------------
\s
\ quickie tests:

here ," nine"  here ," fout" here ," three" here ," seven" here ," zero"
here ," eight" here ," two"  here ," six"   here ," one"   here ," five"
create str-table , , , , , , , , , , \ table of counted strings

: str_dump 10 0 do i cells STR-TABLE + @ count type space loop ;
cr str_dump .( -> ) ' SPRECEDES IS PRECEDES STR-TABLE 10 sort cr str_dump

CREATE INT-TABLE
9 , 4 , 3 , 7 , 0 , 8 , 2 , 6 , 1 , 5 ,

: int_dump 10 0 do i cells INT-TABLE + @ . loop ;
cr int_dump .( -> ) ' IPRECEDES IS PRECEDES INT-TABLE 10 sort int_dump



--- NEW FILE: Splitter3.f ---
\ ForthForm generated splitter-window template
\ Modify according to your needs


:Object LeftPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Left Pane" Textout: dc ;M

;Object


:Object TopRightPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Top Right Pane" Textout: dc ;M

;Object


:Object BottomRightPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Bottom Right Pane" Textout: dc ;M

;Object


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

COLOR_BTNFACE Call GetSysColor new-color BTNFACE

:Class SplitterBar   <Super child-window

:M WindowStyle: ( -- style )   \ return the window style
        WindowStyle: super
        [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M

:M On_Paint: ( -- )            \ screen redraw method
        0 0 Width Height BTNFACE FillArea: dc ;M

:M On_Init:     ( -- )
        \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of
        \ class Child-Window to prevent flicker in window on sizing.
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop ;M

;Class

SplitterBar SplitterH
SplitterBar SplitterV


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

0 value ToolBarHeight    \ set to height of toolbar if any
0 value StatusBarHeight  \ set to height of status bar if any
200 value TopHeight
150 value LeftWidth
5 value ThicknessH
5 value ThicknessV


:Object SplitterWindow   <Super Window

int dragging
int mousedown

: RightXpos       ( -- n )   LeftWidth ThicknessV + ;
: RightWidth      ( -- n )   Width RightXpos - ;
: SplitterYpos    ( -- n )   ToolBarHeight TopHeight + ;
: BottomYpos      ( -- n )   SplitterYpos ThicknessH + ;
: StatusBarYpos   ( -- n )   height StatusbarHeight - ;
: BottomHeight    ( -- n )   StatusBarYpos BottomYpos - ;
: TotalHeight     ( -- n )   StatusBarYpos ToolBarHeight - ;
: LeftWidthMin    ( -- n )   LeftWidth width min ;
: TopHeightMin    ( -- n )   TopHeight TotalHeight min ;

: position-windows ( -- )
        0          ToolBarHeight  LeftWidthMin  TotalHeight   Move: LeftPane
        RightXpos  ToolBarHeight  RightWidth    TopHeightMin  Move: TopRightPane
        RightXpos  BottomYpos     RightWidth    BottomHeight  Move: BottomRightPane
        LeftWidth  ToolBarHeight  ThicknessV    TotalHeight   Move: SplitterV
        RightXpos  SplitterYpos   RightWidth    ThicknessH    Move: SplitterH
        ;

: Splitter ( -- n )   \ the splitter window the cursor is on
        hWnd get-mouse-xy
        dup ToolBarHeight StatusBarYpos within
        IF
            2dup ToolBarHeight StatusBarYpos within  swap  LeftWidth RightXpos within  and
            IF  2drop  1
            ELSE  SplitterYpos BottomYpos within  swap  0 width within  and IF  2  ELSE  0  THEN
            THEN
        ELSE 2drop 0
        THEN ;

: On_Tracking ( -- )   \ set min and max values of LeftWidth and TopHeight here
        mousedown dragging or 0= ?EXIT
        dragging
        Case
            1 of  mousex  0max  width min  thicknessV 2/ -  to LeftWidth  endof
            2 of  mousey ToolBarHeight -  0max  TotalHeight min   thicknessH 2/ -  to TopHeight  endof
        EndCase
        position-windows
        WINPAUSE ;

: On_Clicked ( -- )
        mousedown not IF  hWnd Call SetCapture drop  THEN
        true to mousedown
        Splitter to dragging
        On_Tracking ;

: On_Unclicked ( -- )
        mousedown IF  Call ReleaseCapture drop  THEN
        false to mousedown
        false to dragging ;

: On_DblClick ( -- )
        false to mousedown
        Splitter 1 = 
        IF
            LeftWidth 8 >
            IF    0 thicknessV 2/ - to LeftWidth
            ELSE  Width thicknessV - 2/  to LeftWidth
            THEN
        position-windows
        THEN ;

:M WM_SETCURSOR ( h m w l -- )
        Splitter
        Case
            0  of  DefWindowProc: self  endof
            1  of  SIZEWE-CURSOR    1   endof
            2  of  SIZENS-CURSOR    1   endof
        EndCase
        ;M

:M Classinit: ( -- )
        ClassInit: super   \ init super class
        ['] On_Clicked     SetClickFunc: self
        ['] On_Unclicked   SetUnClickFunc: self
        ['] On_Tracking    SetTrackFunc: self
        ['] On_DblClick    SetDblClickFunc: self
        ;M

\ :M WindowHasMenu: ( -- f )   true ;M

:M WindowStyle: ( -- style )
        WindowStyle: Super WS_CLIPCHILDREN or ;M

:M On_Size: ( -- )
        position-windows ;M

:M On_Init: ( -- )
        \ prevent flicker in window on sizing
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop

        self Start: LeftPane
        self Start: TopRightPane
        self Start: BottomRightPane
        self Start: SplitterH
        self Start: SplitterV
        ;M

;Object

\ start: SplitterWindow

--- NEW FILE: Splitter2.f ---
\ ForthForm generated splitter-window template
\ Modify according to your needs


:Object TopPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Top Pane" Textout: dc ;M

;Object


:Object BottomPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Bottom Pane" Textout: dc
        ;M

;Object


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

COLOR_BTNFACE Call GetSysColor new-color BTNFACE

:Class SplitterBar   <Super child-window

:M WindowStyle: ( -- style )   \ return the window style
        WindowStyle: super
        [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M

:M On_Paint: ( -- )            \ screen redraw method
        0 0 Width Height BTNFACE FillArea: dc ;M

:M On_Init:     ( -- )
        \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of
        \ class Child-Window to prevent flicker in window on sizing.
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop ;M

;Class

SplitterBar SplitterH


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

0 value ToolBarHeight    \ set to height of toolbar if any
0 value StatusBarHeight  \ set to height of status bar if any
200 value TopHeight
5 value ThicknessH


:Object SplitterWindow   <Super Window

int dragging
int mousedown

: SplitterYpos    ( -- n )   ToolBarHeight TopHeight + ;
: BottomYpos      ( -- n )   SplitterYpos ThicknessH + ;
: StatusBarYpos   ( -- n )   height StatusbarHeight - ;
: BottomHeight    ( -- n )   StatusBarYpos BottomYpos - ;
: TotalHeight     ( -- n )   StatusBarYpos ToolBarHeight - ;
: TopHeightMin    ( -- n )   TopHeight TotalHeight min ;

: position-windows ( -- )
        0  ToolBarHeight  Width  TopHeightMin  Move: TopPane
        0  BottomYpos     Width  BottomHeight  Move: BottomPane
        0  SplitterYpos   Width  ThicknessH    Move: SplitterH
        ;

: Splitter ( -- n )   \ the splitter window the cursor is on
        hWnd get-mouse-xy
        dup ToolBarHeight StatusBarYpos within
        IF  SplitterYpos BottomYpos within  swap  0 width within  and  IF  1  ELSE  0  THEN
        ELSE  2drop 0  THEN ;

: On_Tracking ( -- )   \ set min and max values of TopHeight here
        mousedown dragging or 0= ?EXIT
        dragging
        IF  mousey ToolBarHeight -  0max  TotalHeight min   thicknessH 2/ -  to TopHeight  THEN
        position-windows
        WINPAUSE ;

: On_Clicked ( -- )
        mousedown not IF  hWnd Call SetCapture drop  THEN
        true to mousedown
        Splitter to dragging
        On_Tracking ;

: On_Unclicked ( -- )
        mousedown IF  Call ReleaseCapture drop  THEN
        false to mousedown
        false to dragging ;

: On_DblClick ( -- )
        false to mousedown
        Splitter 1 = 
        IF
            TopHeight 8 >
            IF    0 thicknessH 2/ - to TopHeight
            ELSE  TopHeight BottomHeight + thicknessH - 2/ to TopHeight
            THEN
        position-windows
        THEN ;

:M WM_SETCURSOR ( h m w l -- )
        Splitter
        Case
            0  of  DefWindowProc: self  endof
            1  of  SIZENS-CURSOR    1   endof
        EndCase
        ;M

:M Classinit: ( -- )
        ClassInit: super   \ init super class
        ['] On_Clicked     SetClickFunc: self
        ['] On_Unclicked   SetUnClickFunc: self
        ['] On_Tracking    SetTrackFunc: self
        ['] On_DblClick    SetDblClickFunc: self
        ;M

\ :M WindowHasMenu: ( -- f )   true ;M

:M WindowStyle: ( -- style )
        WindowStyle: Super WS_CLIPCHILDREN or ;M

:M On_Size: ( -- )
        position-windows ;M

:M On_Init: ( -- )
        \ prevent flicker in window on sizing
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop

        self Start: TopPane
        self Start: BottomPane
        self Start: SplitterH
        ;M

;Object

\ start: SplitterWindow

--- NEW FILE: Splitter6.f ---
\ ForthForm generated splitter-window template
\ Modify according to your needs


:Object TopLeftPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Top Left Pane" Textout: dc ;M

;Object


:Object TopRightPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Top Right Pane" Textout: dc ;M

;Object


:Object BottomPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Bottom Pane" Textout: dc
        ;M

;Object


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

COLOR_BTNFACE Call GetSysColor new-color BTNFACE

:Class SplitterBar   <Super child-window

:M WindowStyle: ( -- style )   \ return the window style
        WindowStyle: super
        [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M

:M On_Paint: ( -- )            \ screen redraw method
        0 0 Width Height BTNFACE FillArea: dc ;M

:M On_Init:     ( -- )
        \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of
        \ class Child-Window to prevent flicker in window on sizing.
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop ;M

;Class

SplitterBar SplitterH
SplitterBar SplitterV


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

0 value ToolBarHeight    \ set to height of toolbar if any
0 value StatusBarHeight  \ set to height of status bar if any
200 value TopHeight
150 value LeftWidth
5 value ThicknessH
5 value ThicknessV


:Object SplitterWindow   <Super Window

int dragging
int mousedown

: RightXpos       ( -- n )   LeftWidth ThicknessV + ;
: RightWidth      ( -- n )   Width RightXpos - ;
: SplitterYpos    ( -- n )   ToolBarHeight TopHeight + ;
: BottomYpos      ( -- n )   SplitterYpos ThicknessH + ;
: StatusBarYpos   ( -- n )   height StatusbarHeight - ;
: BottomHeight    ( -- n )   StatusBarYpos BottomYpos - ;
: TotalHeight     ( -- n )   StatusBarYpos ToolBarHeight - ;
: LeftWidthMin    ( -- n )   LeftWidth width min ;
: TopHeightMin    ( -- n )   TopHeight TotalHeight min ;

: position-windows ( -- )
        0          ToolBarHeight  LeftWidthMin  TopHeightMin  Move: TopLeftPane
        RightXpos  ToolBarHeight  RightWidth    TopHeightMin  Move: TopRightPane
        0          BottomYpos     Width         BottomHeight  Move: BottomPane
        LeftWidth  ToolBarHeight  ThicknessV    TopHeight     Move: SplitterV
        0          SplitterYpos   Width         ThicknessH    Move: SplitterH
        ;

: Splitter ( -- n )   \ the splitter window the cursor is on
        hWnd get-mouse-xy
        dup ToolBarHeight StatusBarYpos within
        IF
            2dup ToolBarHeight SplitterYpos within  swap  LeftWidth RightXpos within  and
            IF  2drop  1
            ELSE  SplitterYpos BottomYpos within  swap  0 width within  and IF  2  ELSE  0  THEN
            THEN
        ELSE 2drop 0
        THEN ;

: On_Tracking ( -- )   \ set min and max values of LeftWidth and TopHeight here
        mousedown dragging or 0= ?EXIT
        dragging
        Case
            1 of  mousex  0max  width min  thicknessV 2/ -  to LeftWidth  endof
            2 of  mousey ToolBarHeight -  0max  TotalHeight min   thicknessH 2/ -  to TopHeight  endof
        EndCase
        position-windows
        WINPAUSE ;

: On_Clicked ( -- )
        mousedown not IF  hWnd Call SetCapture drop  THEN
        true to mousedown
        Splitter to dragging
        On_Tracking ;

: On_Unclicked ( -- )
        mousedown IF  Call ReleaseCapture drop  THEN
        false to mousedown
        false to dragging ;

: On_DblClick ( -- )
        false to mousedown
        Splitter 1 = 
        IF
            LeftWidth 8 >
            IF      0 thicknessV 2/ - to LeftWidth
            ELSE    Width thicknessV - 2/  to LeftWidth
            THEN
        position-windows
        THEN ;

:M WM_SETCURSOR ( h m w l -- )
        Splitter
        Case
            0  of  DefWindowProc: self  endof
            1  of  SIZEWE-CURSOR    1   endof
            2  of  SIZENS-CURSOR    1   endof
        EndCase
        ;M

:M Classinit: ( -- )
        ClassInit: super   \ init super class
        ['] On_Clicked     SetClickFunc: self
        ['] On_Unclicked   SetUnClickFunc: self
        ['] On_Tracking    SetTrackFunc: self
        ['] On_DblClick    SetDblClickFunc: self
        ;M

\ :M WindowHasMenu: ( -- f )   true ;M

:M WindowStyle: ( -- style )
        WindowStyle: Super WS_CLIPCHILDREN or ;M

:M On_Size: ( -- )
        position-windows ;M

:M On_Init: ( -- )
        \ prevent flicker in window on sizing
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop

        self Start: TopLeftPane
        self Start: TopRightPane
        self Start: BottomPane
        self Start: SplitterH
        self Start: SplitterV
        ;M

;Object

\ start: SplitterWindow

--- NEW FILE: POINT.F ---
\ Point.f

anew -point.f

\ define point class
:Class ffPoint    <Super Object

Record: xy
        int x
        int y
;Record

:M Erase:       ( -- )
                0 to x
                0 to y
                ;M

:M ClassInit:   ( -- )
                ClassInit: super
                Erase: self
                ;M

:M SetPoint:    ( x y -- )
                to y to x
                ;M

:M GetPoint:    ( -- x y )
                x y
                ;M

:M AddrOf:      ( -- xy )
                xy ;M

;Class
\s

--- NEW FILE: JoinStr.f ---
\ Joinstr.f       Joins any number of counted strings in fwd order
\ Based on Rainbow Sally's Code

anew -joinstr.f

Internal

variable join$base

External

: join$(
    join$base @ sp@ join$base !
    // links and saves old sp
    ;

: )join$    { \ tmp$ alo ahi -- }
    sp@ to alo join$base @ to ahi
        ahi alo - 7 and     \ must be multiples of 8
        abort" Join$ requires counted strings"
    new$ dup off to tmp$

    alo ahi -2 cells+
    do
        i cell+ @ i @
        ( addr len ) dup 0 255 between not abort" Bad String Len in JOIN$()"
        ( addr len ) tmp$ +place
    -2 cells +loop
    join$base @ sp!  // reset old stack pointer
    join$base !      // restore old join$base
    tmp$ dup +null ;
Module
\s
--- NEW FILE: Splitter1.f ---
\ ForthForm generated splitter-window template
\ Modify according to your needs


:Object LeftPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Left Pane" Textout: dc ;M

;Object


:Object RightPane   <Super Child-Window

:M ExWindowStyle: ( -- style )
        ExWindowStyle: Super 
        WS_EX_CLIENTEDGE or ;M

:M On_Paint: ( -- )
        0 0 Width Height white FillArea: dc
        0 0 s" Right Pane" Textout: dc ;M

;Object


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

COLOR_BTNFACE Call GetSysColor new-color BTNFACE

:Class SplitterBar   <Super child-window

:M WindowStyle: ( -- style )   \ return the window style
        WindowStyle: super
        [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M

:M On_Paint: ( -- )            \ screen redraw method
        0 0 Width Height BTNFACE FillArea: dc ;M

:M On_Init:     ( -- )
        \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of
        \ class Child-Window to prevent flicker in window on sizing.
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop ;M

;Class

SplitterBar SplitterV


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

0 value ToolBarHeight    \ set to height of toolbar if any
0 value StatusBarHeight  \ set to height of status bar if any
150 value LeftWidth
5 value ThicknessV


:Object SplitterWindow   <Super Window

int dragging
int mousedown

: RightXpos       ( -- n )   LeftWidth ThicknessV + ;
: RightWidth      ( -- n )   Width RightXpos - ;
: LeftWidthMin    ( -- n )   LeftWidth width min ;
: StatusBarYpos   ( -- n )   height StatusbarHeight - ;
: TotalHeight     ( -- n )   Height ToolBarHeight - StatusBarHeight - ;

: position-windows ( -- )
        0          ToolBarHeight   LeftWidthMin  TotalHeight  Move: LeftPane
        RightXpos  ToolBarHeight   RightWidth    TotalHeight  Move: RightPane
        LeftWidth  ToolBarHeight   ThicknessV    TotalHeight  Move: SplitterV
        ;

: Splitter ( -- n )   \ the splitter window the cursor is on
        hWnd get-mouse-xy
        ToolBarHeight StatusBarYpos within  swap  LeftWidth RightXpos within  and
        IF  1  ELSE  0  THEN ;

: On_Tracking ( -- )   \ set min and max values of LeftWidth here
        mousedown dragging or 0= ?EXIT
        dragging
        IF  mousex  0max  width min  thicknessV 2/ -  to LeftWidth  THEN
        position-windows
        WINPAUSE ;

: On_Clicked ( -- )
        mousedown not IF  hWnd Call SetCapture drop  THEN
        true to mousedown
        Splitter to dragging
        On_Tracking ;

: On_Unclicked ( -- )
        mousedown IF  Call ReleaseCapture drop  THEN
        false to mousedown
        false to dragging ;

: On_DblClick ( -- )
        false to mousedown
        Splitter 1 = 
        IF
            LeftWidth 8 >
            IF    0 thicknessV 2/ - to LeftWidth
            ELSE  Width thicknessV - 2/  to LeftWidth
            THEN
        position-windows
        THEN ;

:M WM_SETCURSOR ( h m w l -- )
        Splitter
        Case
            0  of  DefWindowProc: self  endof
            1  of  SIZEWE-CURSOR    1   endof
        EndCase
        ;M

:M Classinit: ( -- )
        ClassInit: super   \ init super class
        ['] On_Clicked     SetClickFunc: self
        ['] On_Unclicked   SetUnClickFunc: self
        ['] On_Tracking    SetTrackFunc: self
        ['] On_DblClick    SetDblClickFunc: self
        ;M

\ :M WindowHasMenu: ( -- f )   true ;M

:M WindowStyle: ( -- style )
        WindowStyle: Super WS_CLIPCHILDREN or ;M

:M On_Size: ( -- )
        position-windows ;M

:M On_Init: ( -- )
        \ prevent flicker in window on sizing
        CS_DBLCLKS GCL_STYLE hWnd  Call SetClassLong  drop

        self Start: LeftPane
        self Start: RightPane
        self Start: SplitterV
        ;M

;Object

\ start: SplitterWindow