\    File: applWin.f
\  Author: Jeff Kelm
\ Created: 16-Oct-1998
\ Updated: 19-May-1999
\ Generic Application Window Class

Comment:  Revision History (most recent first)
19990519
 - Changes to eliminate absolute storage (use 'stack frames'
   instead).
19981216
 - Corrected Restore: to work when window is maximized.
19981208
 - Removed SetTitle: method, now handled by SetText: in
   BasicWin.f
19981120
 - Changed Redraw: method so it seems to work now
19981117
 - Changed to call BasicWin.f
 - Added methods to ApplicationWindow (GetWindowProc:)
 - Renamed SetWndProd: to SetWindowProc:
Comment;



NEEDS BasicWin.f
CR .( Loading Application Window class...)



\ Define the default window procedure
4 callback EmptyWndProc DefaultWindowProc



: APPLICATION_CLASS   Z" AppClass"  rel>abs ;

Comment:  ------------------------------------------------------
\ Application Window Class structure
CREATE wcApplication   \ WNDCLASS structure
   NULL ,                                       \ style
   EmptyWndProc rel>abs ,                       \ lpfnWndProc
   0 ,                                          \ cbClsExtra
   0 ,                                          \ cbWndExtra
   appInst ,                                    \ hInstance
   IDI_WINLOGO NULL      Call LoadIcon ,        \ hIcon
   IDC_ARROW NULL        Call LoadCursor ,      \ hCursor
   WHITE_BRUSH           Call GetStockObject ,  \ hbrBackground
   NULL ,                                       \ lpszMenuName
   APPLICATION_CLASS ,                          \ lpszClassName

: Register-Class
   wcApplication rel>abs Call RegisterClass ?WinError ;

: Unregister-Class
   appInst APPLICATION_CLASS Call UnregisterClass ?WinError ;

Register-Class
------------------------------------------------------  Comment;



: Register-Class
   \ create WNDCLASS structure on stack
   sp@ >R ( save the stack pointer)
   APPLICATION_CLASS                            \ lpszClassName
   NULL                                         \ lpszMenuName
   WHITE_BRUSH           Call GetStockObject    \ hbrBackground
   IDC_ARROW NULL        Call LoadCursor        \ hCursor
   IDI_WINLOGO NULL      Call LoadIcon          \ hIcon
   appInst                                      \ hInstance
   0                                            \ cbWndExtra
   0                                            \ cbClsExtra
   EmptyWndProc rel>abs                         \ lpfnWndProc
   NULL                                         \ style
   \ return address of WNDCLASS structure on stack
   sp@ rel>abs
   Call RegisterClass ?WinError
   R> sp! ( retrieve the stack pointer) ;

: Unregister-Class
   appInst APPLICATION_CLASS Call UnregisterClass ?WinError ;



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\  Application window class
\
:Class ApplicationWindow  <Super BaseWindow

   :M Create: ( -- )   \ register a class and create an empty
                       \ application window
      Register-Class
      NULL                         \ creation parameters
      AppInst                      \ instance handle
      NULL                         \ menu handle
      NULL                         \ parent window
      CW_USEDEFAULT CW_USEDEFAULT  \ window size ( h w)
      CW_USEDEFAULT CW_USEDEFAULT  \ window position ( y x )
      WS_OVERLAPPEDWINDOW          \ window style
      NULL                         \ window title
      APPLICATION_CLASS            \ class name
      0                            \ extended window style
      Call CreateWindowEx  DUP PutHandle: self  ?WinError
      ;M

   :M Destroy: ( -- )   \ destroy the window and unregister
                        \ the class
      Destroy: super
      Unregister-Class
      ;M

   :M Redraw: ( -- )
      TRUE NULL GetHandle: self  Call InvalidateRect  ?WinError
      GetHandle: self  Call UpdateWindow  ?WinError
      ;M

   :M GetMenu: ( -- hMenu)   \ retrieve handle of current menu
      GetHandle: self  Call GetMenu
      ;M

   :M DestroyMenu: ( -- )
      GetMenu: self  Call DestroyMenu  ?WinError
      ;M

   :M SetMenu: ( hMenu)   \ assign a new menu to window
      GetMenu: self  IF  DestroyMenu: self  THEN
      GetHandle: self  Call SetMenu  ?WinError
      ;M

   :M Restore:   \ restores a minimized/maximized window
      SW_RESTORE GetHandle: self  Call ShowWindow  DROP
      ;M

   :M Minimize:   \ minimize window
      GetHandle: self  Call CloseWindow  ?WinError
      ;M

   :M Maximize:   \ maximizes a window
      SW_MAXIMIZE GetHandle: self  Call ShowWindow  DROP
      ;M

   :M GetWindowProc: ( -- wndProc)   \ retrieve the current
                                     \ window procedure
      GWL_WNDPROC GetWindowLong: self
      ;M

   :M SetWindowProc: ( lpWndProc)   \ sets the application
                                    \ window procedure
      GWL_WNDPROC SetWindowLong: Self
      ;M

;Class