[Win32forth-cvs] win32forth/src CALLBACK.f,1.6,1.7

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30263/src

Modified Files:
	CALLBACK.f 
Log Message:
A little documentation for callbacks added.

Index: CALLBACK.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CALLBACK.f,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** CALLBACK.f	13 Feb 2006 14:06:08 -0000	1.6
--- CALLBACK.f	25 May 2006 09:20:41 -0000	1.7
***************
*** 5,18 ****
  \ arm 15/08/2005 20:01:54 n callback -- n is now max of 19 args

! cr .( Loading Windows Callback...)

! in-application

! \ -------------------- Callback Support -------------------------------------

  \ CALLBACK-RETURN and CALLBACK-BEGIN restore and save regs, set up EBP and ESP
  \ BUILD-CALLBACK uses ECX as parm count, ret count on stack -- __CDECL sets to zero

! NCODE CALLBACK-RETURN                           \ general return code, restores all but ecx!
                  code-here cell+ code-,          \ make an ITC
                  mov     eax, ebx                \ return value
--- 5,23 ----
  \ arm 15/08/2005 20:01:54 n callback -- n is now max of 19 args

! \ *D doc
! \ *! p-callback
! \ *T Windows Callback support

! \ *S Glossary

! cr .( Loading Windows Callback...)
! 
! IN-APPLICATION

  \ CALLBACK-RETURN and CALLBACK-BEGIN restore and save regs, set up EBP and ESP
  \ BUILD-CALLBACK uses ECX as parm count, ret count on stack -- __CDECL sets to zero

! NCODE CALLBACK-RETURN                           \ w32f intern
! \ General return code, restores all but ecx!
                  code-here cell+ code-,          \ make an ITC
                  mov     eax, ebx                \ return value
***************
*** 50,54 ****
                  c;

! CFA-CODE CALLBACK-BEGIN                         \ general start code, don't disturb EAX!
                  push    ebp                     \ save regs, return count is already on the stack
                  push    ebx
--- 55,60 ----
                  c;

! CFA-CODE CALLBACK-BEGIN                         \ w32f intern
! \ General start code, don't disturb EAX!
                  push    ebp                     \ save regs, return count is already on the stack
                  push    ebx
***************
*** 95,106 ****
                  exec    c;                      \ go for it

! in-system

  variable __CDECLV 0 __CDECLV !                  \ for __cdecl type callbacks
- : __STDCALL ; IMMEDIATE                         \ does nothing, callback is stdcall
- : __CDECL __CDECLV ON ;                         \ turn on __cdecl type callback

! : BUILD-CALLBACK ( n1 -- a1 a2 )                \ define a callback procedure
!                 dup 20 0 within abort" arg value too large for callback"
                  >r                              \ generated via macro[ ]macro
                  code-here                       \ func address (a1)
--- 101,119 ----
                  exec    c;                      \ go for it

! IN-SYSTEM

  variable __CDECLV 0 __CDECLV !                  \ for __cdecl type callbacks

! : __STDCALL     ( -- )                          \ w32f sys
! \ *G Turn on stdcall type callback (the default).
!                 ; IMMEDIATE
! 
! : __CDECL       ( -- )                          \ w32f sys
! \ *G Turn on __cdecl type callback.
!                 __CDECLV ON ;
! 
! : BUILD-CALLBACK ( n1 -- a1 a2 )                \ w32f sys
! \ Define a callback procedure.
!                 dup 20 0 within abort" Argument value too large for callback."
                  >r                              \ generated via macro[ ]macro
                  code-here                       \ func address (a1)
***************
*** 118,129 ****
                  ;

! : CALLBACK      ( n1 -<name function>- )        \ define a callback with "name" that has n1 args
!                 ( -- a1 )                       \ runtime, returns address of callback
!                 BUILD-CALLBACK >R CONSTANT ' R> !
!                 ;

! : CALLBACK:     ( args -<name>- )               \ makes a headerless callback function, only
!                 ( -- a1 )                       \ the callback structure has a header
!                 BUILD-CALLBACK >R
                  MAXSTRING _LOCALALLOC >R        \ use a dynamic string buffer
                  S" CONSTANT &"      R@  PLACE
--- 131,148 ----
                  ;

! : CALLBACK      ( n1 -<name function>- )        \ w32f sys
! \ *G Define a callback with "name" that has n1 arguments.
! \ ** "name" will return the address of the callback at runtime.
! \ *P Note that a maximum of 19 arguments is supported by Win32Forth.
!                 BUILD-CALLBACK >R CONSTANT ' R> ! ;

! : CALLBACK:     ( args -<name>- )               \ w32f sys
! \ *G Define a callback function that has n1 arguments.
! \ *P CALLBACK: creates TWO definitions! The first has the name you specify,
! \ ** and the second has the same name, prefixed with a '&' meaning 'address of'
! \ ** This second definition is the one which returns the address of the callback,
! \ ** and must be passed to Windows.
! \ *P Note that a maximum of 19 arguments is supported by Win32Forth.
!                 BUILD-CALLBACK >R               \ the callback structure has a header
                  MAXSTRING _LOCALALLOC >R        \ use a dynamic string buffer
                  S" CONSTANT &"      R@  PLACE
***************
*** 139,249 ****

  \ *************************************************************************
! \ **************** allow Forth to handle windows messages *****************
  \ *************************************************************************

! ((
!   The following windows message definition for WM_WIN32FORTH, provides a
!   way for multiple Win32Forth applications to interact between themselves
!   wile running.
! ))
! 
!   -1 value WM_WIN32FORTH
! 
! ((
!   Each instance of forth running under windows is able through the method
!   WM32Forth: and a unique set of application specific constants
!   (WM_BEEPME in this example) to detect a message being set to itself,
!   and subsequently perform some specific operation as ordered.

!   :M Win32Forth:  ( h m w l -- )  \ The REAL version of this is at the
!                                   \ end of this file
!                   over WM_BEEPME =
!                   if      beep
!                   then
!                   ;M

!   WM_WIN32FOR-INIT following obtains a unique windows message value from
!   Windows then Win32Forth starts up, so this instance of forth will be
!   able to talk to other instances of forth.
! ))

! \ changed Sonntag, August 22 2004 dbu
! 1 proc RegisterWindowMessage
! : wm_win32for-init ( -- )
!                 \ create a unique message name; we do this to make shure
!                 \ that the console only talk to WinEd/SciEdit with the
!                 \ build with the Win32Forth Version.

!                 \ using PAD is ok here; because this is called before any
!                 \ application code is executed
!                 s" WM_WIN32FORTH_" pad place version# 0 (d.) pad +place pad +null
!                 pad 1+ Call RegisterWindowMessage ?dup
!                 if   to WM_WIN32FORTH
!                 then ;

! initialization-chain chain-add wm_win32for-init \ initialize the message

! ((
!   WIN32FORTH-MESSAGE allows a unique message to be broadcast to all
!   currently running instances of Win32Forth.  The 'w' parameter is the
!   application specific sub-message that each instance can use to
!   determine if it should handle the message.  The 'l' parameter is
!   available to pass specific information between instances of Win32Forth.
! ))

! \ changed September 6th, 2003 - 17:30 dbu
! 7 proc SendMessageTimeout
! : _win32forth-message ( lParam wParam -- )
!                 2>R 0 SP@ 2 ( ms ) SMTO_ABORTIFHUNG 2R>
!                 WM_WIN32FORTH HWND_BROADCAST Call SendMessageTimeout 2drop
!                 ;

! ' _win32forth-message is win32forth-message      \ link to deferred word

  1 PROC TranslateMessage
  1 PROC DispatchMessage
  : HandleMessages { pMsg -- 0 }
!                 pMsg TRUE msg-chain do-chain nip

!                 if   pMsg Call TranslateMessage drop
!                      pMsg Call DispatchMessage  drop
!                 then 0 ;

! : HandleWindowsMessages { hwnd msg wParam lParam -- flag }
!                 msg WM_WIN32FORTH =
!                 if      hwnd msg wParam lParam
!                         forth-msg-chain do-chain     \ perform the handlers
!                         4drop
!                         0
!                 else    hwnd msg wParam lParam
!                         DefaultWindowProc       \ use default handler
!                 then    ;

! 1 callback &HandleMessages  HandleMessages        \ callback for DoForthFunc
! 4 callback &WindowsMessages HandleWindowsMessages
! 0 callback &bye             bye                   \ callback to terminate forth

! : HandleMessages-init ( -- )
!                 &HandleMessages  &CB-MSG    !
!                 &WindowsMessages &CB-WINMSG !
!                 &bye             &CB-BYE    ! ;

! initialization-chain chain-add HandleMessages-init
! HandleMessages-init

! 5 proc PeekMessage

! :Noname ( -- )
!         { \ hwnd mess wparm lparm time pt.x pt.y -- }
!         BEGIN  PM_REMOVE 0 0 0 &of hwnd Call PeekMessage
!         WHILE  &of hwnd HandleMessages drop
!         REPEAT ; is winpause

! \ A Win32Forth-message example:

  31415 constant WM_BEEPME    \ a command code to beep

  \ Send the message "WM_BEEPME" to all running instances of Win32Forth
- 
  : beepme        ( -- )
                  0 WM_BEEPME win32forth-message ;
--- 158,316 ----

  \ *************************************************************************
! \ *S An example of how to use a callback
  \ *************************************************************************

! \ *P The "EnumFonts" windows call requires an application callback that will be
! \ ** called repeatedly to process each font in the system. We are just
! \ ** displaying the fonts, so we just look at the "dwType" to decide how to
! \ ** display each font.

! 4 PROC EnumFonts \ must be in-application for WinEd !!!

! IN-SYSTEM

! \ *+

! 4 CallBack: FontFunc { lplf lptm dwType lpData -- int }
! \ The callback function for EnumFonts() used by .FONTS to dump
! \ all installed fonts to the console window.
! \ This callback as specified by "EnumFonts" passes four (4) parameters to
! \ the callback procedure, so we must say "4 CallBack: FontFunc" to define
! \ a callback that accepts four parameters.
!                 cr
!                 dwType
!                 dup TRUETYPE_FONTTYPE and
!                 IF      ."     "
!                 ELSE    ." Non-"
!                 THEN    ." TrueType "
!                 dup RASTER_FONTTYPE and
!                 IF      ." Raster "
!                 ELSE    ." Vector "
!                 THEN
!                 DEVICE_FONTTYPE and
!                 IF      ." Device "
!                 ELSE    ." GDI    "
!                 THEN
!                 lplf 28 + LF_FACESIZE 2dup 0 scan nip - type
!                 cr 5 spaces
!                 lplf dup @ 4 .r                 \ height
!                 4 + dup @ 4 .r                  \ width
!                 4 + dup @ 6 .r.1                \ escapement angle
!                 4 + dup @ 6 .r.1                \ orientation angle
!                 4 + dup @ 4 .r                  \ weight
!                 4 + dup c@ 1 and 2 .r           \ italics
!                 1 + dup c@ 1 and 2 .r           \ underline
!                 1 + dup c@ 1 and 2 .r           \ strike-out
!                 1 + dup c@ 4 .r                 \ character set
!                 1 + dup c@ 2 .r                 \ output precision
!                 1 + dup c@ 4 .r                 \ clip precision
!                 1 + dup c@ 2 .r                 \ output quality
!                 1 +     c@ 4 h.r                \ family and pitch
!                 1 ;  \ return "1=success" flag to windows

! : .fonts        ( -- )          \ w32f sys
! \ *G Dump all installed Fonts to the console window.
! \ The callback name is passed to windows as shown.
!                 cr 5 spaces
!                 ."   ht wide  esc  ornt wt  I U S set p  cp q  fp"
!                 0
!                 &FontFunc \ here it goes...
!                 0 conDC Call EnumFonts drop ;

! \ *-

! IN-APPLICATION

! \ *************************************************************************
! \ *S The window message handler for Win32Forth.
! \ *************************************************************************

  1 PROC TranslateMessage
  1 PROC DispatchMessage
  : HandleMessages { pMsg -- 0 }
! \ *G This is the callback which handles the messages send by windows to our
! \ ** Application. The chain MSG-CHAIN receives all messages.
! \ *P This callback is called by the console window and by WINPAUSE.
!         pMsg TRUE msg-chain do-chain nip
!         if   pMsg Call TranslateMessage drop
!              pMsg Call DispatchMessage  drop
!         then 0 ;

! \ *************************************************************************
! \ *S Allow Forth to send messages to itself.
! \ *************************************************************************

! \ *P Each instance of forth running under windows is able through the method
! \ ** WM32Forth: and a unique set of application specific constants
! \ ** (WM_BEEPME in this example) to detect a message being set to itself,
! \ ** and subsequently perform some specific operation as ordered.

! \ *E :M Win32Forth:  ( h m w l -- )
! \ **            over WM_BEEPME =
! \ **            if   beep
! \ **            then ;M

! \ *P \b Note: \d This Win32Forth feature is \b deprecated \d, and may be
! \ ** removed in a future release.

! -1 value WM_WIN32FORTH                          \ w32f
! \ *G This windows message definition for WM_WIN32FORTH, provides a way for
! \ ** multiple Win32Forth applications to interact between themselves
! \ ** wile running.

! \ changed Sonntag, August 22 2004 dbu
! 1 proc RegisterWindowMessage
! : WM_WIN32FOR-INIT ( -- )                       \ w32f internal
! \ *G WM_WIN32FOR-INIT obtains a unique windows message value from Windows
! \ ** then Win32Forth starts up, so this instance of forth will be
! \ ** able to talk to other instances of forth.
!         \ Create a unique message name; we do this to make shure
!         \ that the console only talk to WinEd/SciEdit with the
!         \ build with the Win32Forth Version.

!         \ using PAD is ok here; because this is called before any
!         \ application code is executed
!         s" WM_WIN32FORTH_" pad place version# 0 (d.) pad +place pad +null
!         pad 1+ Call RegisterWindowMessage ?dup
!         if   to WM_WIN32FORTH
!         then ;

! initialization-chain chain-add wm_win32for-init \ initialize the message
! 
! \ changed September 6th, 2003 - 17:30 dbu
! 7 proc SendMessageTimeout
! : _win32forth-message ( lParam wParam -- )      \ w32f intern
!         2>R 0 SP@ 2 ( ms ) SMTO_ABORTIFHUNG 2R>
!         WM_WIN32FORTH HWND_BROADCAST Call SendMessageTimeout 2drop ;
! 
! ' _win32forth-message is win32forth-message ( lParam wParam -- ) \ w32f
! \ *G WIN32FORTH-MESSAGE allows a unique message to be broadcast to all
! \ ** currently running instances of Win32Forth.
! \ *P 'wParam' is the application specific sub-message that each instance can
! \ *P ** use to determine if it should handle the message.
! \ ** 'lParam' is available to pass specific information between instances
! \ ** of Win32Forth.
! \ *P Note: The message is not only broadcast to to all currently running
! \ ** instances of Win32Forth. It is brodcast to ALL windows in the system.
! \ ** So it may be rather slow...
! 
! : HandleWindowsMessages { hwnd msg wParam lParam -- flag }
! \ *G This is the callback which handles the messages send by win32forth-message.
! \ ** It is called in the windows procedure of the console window of win32forth.
!         msg WM_WIN32FORTH =
!         if   hwnd msg wParam lParam
!              forth-msg-chain do-chain \ perform the handlers
!              4drop 0
!         else hwnd msg wParam lParam
!              DefaultWindowProc        \ use default handler
!         then ;
! 
! \ *S A Win32Forth-message example:
! 
! \ *+

  31415 constant WM_BEEPME    \ a command code to beep

  \ Send the message "WM_BEEPME" to all running instances of Win32Forth
  : beepme        ( -- )
                  0 WM_BEEPME win32forth-message ;
***************
*** 253,332 ****
  \ WM_BEEPME, and if it matches, then it beeps the console. Any sub-message that
  \ is not recognized by any instance of a Win32Forth program must be ignored.
- 
  : forth-msg-beep ( wParam lParam -- wParam lParam )
                   over WM_BEEPME =
!                  if     beep
!                  then   ;

! forth-msg-chain chain-add forth-msg-beep \ default first entry to forth messages

! in-system

  \ *************************************************************************
! \ ***************** An example of how to use a callback *******************
  \ *************************************************************************

! \ The "EnumFonts" windows call requires an application callback that will be
! \ called repeatedly to process each font in the system. We are just
! \ displaying the fonts, so we just look at the "dwType" to decide how to
! \ display each font.
! 
! \ NOTE!: CallBack: creates TWO definitions!  The first has the name you specify,
! \       and the second has the same name, prefixed with a '&' meaning 'address of'
! \       This second definition is the one which returns the address of the
! \       callback, and must be passed to Windows.
! 
! 4 CallBack: FontFunc { lplf lptm dwType lpData -- int }
!                 cr                                      \ rls - many additions
!                 dwType
!                 dup TRUETYPE_FONTTYPE and
!                 IF      ."     "
!                 ELSE    ." Non-"
!                 THEN    ." TrueType "
!                 dup RASTER_FONTTYPE and
!                 IF      ." Raster "
!                 ELSE    ." Vector "
!                 THEN
!                 DEVICE_FONTTYPE and
!                 IF      ." Device "
!                 ELSE    ." GDI    "
!                 THEN
!                 lplf 28 + LF_FACESIZE 2dup 0 scan nip - type
!                 cr 5 spaces
!                 lplf dup @ 4 .r                 \ height
!                 4 + dup @ 4 .r                  \ width
!                 4 + dup @ 6 .r.1                \ escapement angle
!                 4 + dup @ 6 .r.1                \ orientation angle
!                 4 + dup @ 4 .r                  \ weight
!                 4 + dup c@ 1 and 2 .r           \ italics
!                 1 + dup c@ 1 and 2 .r           \ underline
!                 1 + dup c@ 1 and 2 .r           \ strike-out
!                 1 + dup c@ 4 .r                 \ character set
!                 1 + dup c@ 2 .r                 \ output precision
!                 1 + dup c@ 4 .r                 \ clip precision
!                 1 + dup c@ 2 .r                 \ output quality
!                 1 +     c@ 4 h.r                \ family and pitch
!                 1 ;             \ return "1=success" flag to windows
! 
! \ this callback as specified by "EnumFonts" passes four (4) parameters to
! \ the callback procedure, so we must say "4 CallBack: FontFunc" to define
! \ a callback that accepts four parameters.
! 
! \ the callback name is passed to windows as shown, after converting the
! \ callback address to an absolute address for windows.

! in-application
! 4 PROC EnumFonts \ must be in-application for WinEd !!!
! in-system

! : .fonts        ( -- )
!                 cr 5 spaces
!                 ."   ht wide  esc  ornt wt  I U S set p  cp q  fp"
!                 0
!                 &FontFunc
!                 0
!                 conDC                   \ the Device Context of the DC
!                 Call EnumFonts drop ;

! in-application

--- 320,358 ----
  \ WM_BEEPME, and if it matches, then it beeps the console. Any sub-message that
  \ is not recognized by any instance of a Win32Forth program must be ignored.
  : forth-msg-beep ( wParam lParam -- wParam lParam )
                   over WM_BEEPME =
!                  if   beep
!                  then ;

! forth-msg-chain chain-add forth-msg-beep

! \ *-

  \ *************************************************************************
! \ A definition of WINPAUSE that doesn't need the console window.
  \ *************************************************************************
+ 5 proc PeekMessage
+ :Noname ( -- )
+         { \ hwnd mess wparm lparm time pt.x pt.y -- }
+         BEGIN  PM_REMOVE 0 0 0 &of hwnd Call PeekMessage
+         WHILE  &of hwnd HandleMessages drop
+         REPEAT ; is WINPAUSE

! \ *************************************************************************
! \ Init the system callbacks.
! \ These callbacks are needed by the console window.
! \ *************************************************************************
! 1 callback &HandleMessages  HandleMessages        \ callback for HandleMessages
! 4 callback &WindowsMessages HandleWindowsMessages \ callback for HandleWindowsMessages
! 0 callback &bye             bye                   \ callback to terminate forth

! : HandleMessages-init ( -- )
!         &HandleMessages  &CB-MSG    !
!         &WindowsMessages &CB-WINMSG !
!         &bye             &CB-BYE    ! ;

! initialization-chain chain-add HandleMessages-init
! HandleMessages-init

! \ *Z