Re: Callback in a Class

From: Mike Ghan <mikeghan_at_logix-controls.com>
Date: Fri, 30 Mar 2001 17:54:02 -0800

> Can you show me the simplest full example of what is required? One
> that I can run and test against?

The following won't compile - stack underflow. To compile, I commented
out the line with CB: as well as ABORTPROC in SET-ABORT-PROC

-----------------------------------------------------------

Function: SetAbortProc ( hDCprt abortProc -- res )

CLASS PRT-FOO

   PRINTDIALOG BUILDS prtdlg

   VARIABLE ABORT-PRINT?

   \ Classic Printer Abort Procedure
   : AbrtProc ( hDCprt error -- flag ) \ True = Continue
      2DROP ( hDC error )
      BEGIN WINMSG 0 0 0 PM_REMOVE :: PeekMessage
      WHILE DISPATCHER
      REPEAT ABORT-PRINT? @ NOT ;

   ['] AbrtProc 2 CB: ABORTPROC

   : SET-ABORT-PROC
      prtdlg DC @ ABORTPROC :: SetAbortProc DROP ;

   : DEFAULT-PRINTER ( -- )
      0 prtdlg DevMode ! 0 prtdlg DevNames !
      PD_RETURNDC PD_RETURNDEFAULT OR prtdlg Flags !
      PRINTDIALOG SIZEOF prtdlg StructSize !
      prtdlg ADDR :: PrintDlg 0= IOR_PRT_NODEFPRINTER ?THROW ;

   : CONSTRUCT ( -- )
     DEFAULT-PRINTER
     SET-ABORT-PROC
     ( Actual Printing )
     ;

END-CLASS

----------------------------------------------------------------

Mike

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe sftalk" to listar_at_forth.com
For help with listar commands, send subject "help" to listar_at_forth.com
Archives are located at http://www.forth.com/sftalk -- check them out!
Received on Fri Mar 30 2001 - 17:56:00 PST


Subscribe to our e-mail list service. It's free for all SwiftForth and SwiftX users!

This archive was generated 08-Feb-2012. Archive updated nightly.