\    File: BasicWin.f
\  Author: Jeff Kelm
\ Created: 17-Nov-1998
\ Updated: 18-Feb-1999
\ Defines some basic window classes



NEEDS WinBase.f
CR  .( Loading Base Window classes...)



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\ A basic window class with some primative methods
\
:Class BaseWindow  <Super Object

   INT hWnd   \ the window handle

   :M GetHandle: ( -- hWnd)   \ return the window handle
      hWnd
      ;M

   :M PutHandle: ( hWnd)   \ set the window handle
      DUP  Call IsWindow  0= ABORT" Nonexistent window"
      TO hWnd
      ;M

   :M SendMessage: ( lparam wparam msg -- result)
      hWnd  Call SendMessage
      ;M

   :M Show: ( -- )   \ show the window
      SW_SHOW  hWnd  Call ShowWindow DROP
      ;M

   :M Hide: ( -- )   \ hide the window
      SW_HIDE  hWnd  Call ShowWindow DROP
      ;M

   :M GetWindowLong: ( offset -- n)   \ get window memory contents at offset
      hWnd  Call GetWindowLong   ( allows returning NULL values)
      ;M

   :M SetWindowLong: ( n offset)   \ set window memory contents at offset
      hWnd  Call SetWindowLong  DROP  ( allows setting values that used to be NULL)
      ;M

   :M GetWindowRect: ( -- b r t l)   \ get window bounding rectangle
      HERE rel>abs hWnd  Call GetWindowRect  ?WinError
      HERE 3 CELLS + @  HERE 2 CELLS + @  HERE CELL+ @  HERE @
      ;M

   :M GetSize: ( -- cx cy)   \ returns dimension of window rectangle
      HERE rel>abs hWnd  Call GetWindowRect ?WinError
      HERE 2 CELLS + @  HERE @ -
      HERE 3 CELLS + @  HERE CELL+ @ -
      ;M

   :M SetSize: ( cx cy)   \ set window dimensions of window rectangle
      SWAP 2>R  SWP_NOOWNERZORDER SWP_NOMOVE OR
      2R> 0 0 NULL
      hWnd Call SetWindowPos ?WinError
      ;M

   :M GetClientSize: ( -- cx cy)   \ returns dimension of window's client area
      HERE rel>abs hWnd  Call GetClientRect ?WinError
      HERE 3 CELLS + @  HERE CELL+ @ -
      HERE 2 CELLS + @  HERE @ -
      ;M

   :M GetPosition: ( -- x y)   \ returns position of upper-left corner
      HERE rel>abs hWnd  Call GetWindowRect ?WinError
      HERE 2@ SWAP
      ;M

   :M SetPosition: ( x y)  \ set position of upper-left corner
      SWAP 2>R  SWP_NOOWNERZORDER SWP_NOSIZE OR
      0 0 2R> NULL
      hWnd Call SetWindowPos ?WinError
      ;M

   :M Destroy: ( -- )   \ destroy the window
      hWnd Call DestroyWindow  DUP
      IF  0 TO hWnd  THEN  ?WinError
      ;M

   :M GetID: ( -- id)   \ retrieve window identifier
      GWL_ID GetWindowLong: self
      ;M

   :M SetID: ( id)   \ set the window identifier
      GWL_ID SetWindowLong: self
      ;M

   :M GetStyle: ( -- style)   \ retrieve basic window style
      GWL_STYLE GetWindowLong: self
      ;M

   :M SetStyle: ( style)   \ set the basic window style
      GWL_STYLE SetWindowLong: self
      ;M

   :M +Style: ( style)   \ add to the basic window style
      GetStyle: self OR  SetStyle: self
      ;M

   :M -Style: ( style)   \ remove from the basic window style
      INVERT  GetStyle: self AND  SetStyle: self
      ;M

   :M GetExStyle: ( -- exStyle)   \ retrieve extended window style
      GWL_EXSTYLE GetWindowLong: self
      ;M

   :M SetExStyle: ( exStyle)   \ set the extended window style
      GWL_EXSTYLE SetWindowLong: self
      ;M

   :M +ExStyle: ( exStyle)   \ add to the extended window style
      GetExStyle: self OR  SetExStyle: self
      ;M

   :M -ExStyle: ( exStyle)   \ add to the extended window style
      INVERT  GetExStyle: self AND  SetExStyle: self
      ;M

   :M GetParent: ( -- hParent)   \ get handle of the window's parent window
      hWnd Call GetParent
      ;M

   :M SetParent: ( hWnd)   \ changes the parent window of the window
      hWnd Call SetParent  ?WinError
      ;M

   :M Enable: ( -- )   \ enables mouse and keyboard input to the window or control
      TRUE hWnd Call EnableWindow  DROP
      ;M

   :M Disable: ( -- )   \ disables mouse and keyboard input to the window or control
      FALSE hWnd Call EnableWindow  DROP
      ;M

   :M SetFocus: ( -- )   \ sets the keyboard focus to this window
      hWnd Call SetFocus  DROP
      ;M

   :M IsVisible: ( -- f)   \ ff=window not visible
      hWnd Call IsWindowVisible
      ;M

   :M SetText: ( szText)   \ send text to window/control
      rel>abs hWnd Call SetWindowText  ?WinError
      ;M

   :M GetText: ( -- a n)   \ get window/control text
      MAXSTRING HERE rel>abs hWnd Call GetWindowText  DUP ?WinError
      HERE SWAP
      ;M 

;Class



:Class ChildWindow  <Super BaseWindow

   :M DefStyle: ( -- style)   \ default control style
      WS_VISIBLE WS_CHILD OR
      ;M

   :M DefExStyle: ( -- exStyle)   \ default extended style
      NULL
      ;M

   :M DefClassName: ( -- ClassName)   \ default class name
      Z" STATIC"
      ;M

   :M DefSize: ( -- cx cy)   \ default window size
      CW_USEDEFAULT CW_USEDEFAULT
      ;M

   :M DefPosition: ( -- x y)   \ default window position
      CW_USEDEFAULT CW_USEDEFAULT
      ;M

   :M Create: ( hParent -- )   \ create an empty child of parent window
      >R
      NULL                              \ creation parameters
      AppInst                           \ instance handle
      CreateNewID                       \ menu handle/control ID
      R>                                \ parent window
      DefSize: [ self ]  SWAP           \ window size ( h w)
      DefPosition: [ self ]  SWAP       \ window position ( y x )
      DefStyle: [ self ]                \ window style
      NULL                              \ window title
      DefClassName: [ self ]  rel>abs   \ class name
      DefExStyle: [ self ]              \ extended window style
      Call CreateWindowEx  DUP TO hWnd  ?WinError
      ;M

;Class