Multi-Window Stick Around DA

By Jörge Langowski, MacTutor Editorial Board, Grenoble, France

“Multi-window, multi-menu, permanent desk accessory”

As mentioned in a previous column, we are going to learn some more about creating desk accessories in Forth (Mach2) this time. The simple desk accessory from V3#2 was useful to show the principle of implementing such a thing in Forth, but in real life DA writing there are a number of things that one might have to add to that example. Therefore, I am going to write this time about the implementation of a desk accessory that supports multiple windows and menus; also it will automatically reinstall itself after it has been closed involuntarily (e.g. when calling an application from the Finder).

This article is by no means comprehensive; there have been several articles in our journal on desk accessories implemented in assembler or C (V2#3,4,6), and I’m making use of some of the ideas described therein. So go back to those old issues (if you don’t have them, order them through us) for any further references.

Making a DA permanent

As you’ll certainly have noticed, there are several occasions when desk accessories will be closed automatically by the system. Whenever you start up a new application from the Finder, or quit an application to go back to the Finder, the application heap will be reinitialized and all desk accessories closed. The two other occasions on which your DA will be closed are copying a file under the Finder and ejecting the startup disk.

Sometimes one would like to have a desk accessory (like a clock) stay active permanently, unless one closes it voluntarily. I’ll tell you further down below how that can be accomplished; however notice that in such a case one would always have to check whether the close box has really been clicked when the DA’s Close routine is called. This is not so easy... since the system handles part of the mouse-down events for a DA automatically before we could even intercept them. Particularly, a mouse-down in the drag region will let the window be dragged around and a click in the Close box will generally cause the Close routine to be called.

So our first problem would be to distinguish a voluntary close from an involuntary one. One easy way to do this is to create the window without a close box and let the user click a button inside it, or select some menu option, to notify the DA that we don’t want it any more. The control - or menu - handling routine would then by itself call CloseDeskAcc but set a flag that indicates to the close routine that we really want to close the window. The close routine then had a way to distinguish voluntary from involuntary close through the flag.

Fig. 1 DA sticks around between applications

There is, however, a more elegant way to go. As was already pointed out by David Dunham in V2#6, there is a system global (undocumented in IM) called CloseOrnHook ($A88). If this location contains a non-NIL pointer, the system assumes that it is the address of a routine that should be called when the close box of a desk accessory window is clicked (instead of calling its Close routine). So all we have to do is to install a pointer to our own Close routine here every time the desk accessory window is activated and remove it when it is deactivated (so that other DAs may be closed correctly). The custom Close routine would then set the flag mentioned above and call CloseDeskAcc with the driver ID number of our DA.

Hooking into SystemTask

Now that our Close routine knows whether we really wanted to call it or not, how do we go about making the desk accessory permanent? After all, the heap will be cleaned on starting up an application, and we won’t be able to keep our DA in the application heap even if we wanted. Even if we put it into the system heap instead, it will stay there - eating up memory - but receive no more system calls, so it will be unusable.

Here a clever trick comes in that I again got to know on one of our developer’s club meetings (idea by L. de Bersuder): Since every application will call SystemTask pretty soon after having been started up, just install a patch (located in the system heap) to the SystemTask routine that reopens the desk accessory, then resets the old SystemTask trap address and thereafter removes itself from the system heap. This method, of course, will work for one such permanent DA at a time only, but provides a good starting point from which on one can do further experimentation.

It is time, now, to look at the program. Listing 1 just contains general Forth definitions that are necessary for the program (and haven’t changed much compared to the V3#2 column). Listing 3 is the RMaker input for generating the desk accessory, and Listing 2 is our example.

The code for the SystemTask intercept routine is at the beginning of the listing. The actual intercept routine does nothing but check whether there is a dialog present in front (in case our DA will set up a dialog as well, this can lead to conflicts), and if that is not the case, restores the old trap address for SystemTask, then opens the desk accessory, using a built-in name string. If you change the name of the accessory, you would have to change this string accordingly. The intercept routine is called by a glue routine which saves the registers and sets up a local A6 stack for the Forth code (our usual method); then the Forth code is entered. The Forth word write-out writes the code for the patch routine to a PROC resource (marked locked, in system heap, and with an ID of -16000, so that it belongs to the desk accessory).

Installation of the SystemTask patch is performed in the Close routine. Here the flag closeflag is checked; if it is =1, it is assumed that the close was involuntary and the patch is installed by calling install.intercept. The latter routine gets the PROC resource containing the patch code (it will be in the system heap), stores the old trap address of SystemTask in trapaddr in the patch routine and sets the new trap address to the beginning of the intercept routine. The appropriate offsets *trapaddr and *inter have been calculated beforehand at compilation time. This, by the way, is one simple method to reference Forth code from outside routines.

After the installation of the intercept routine, the system is set up to reinstall the desk accessory the next time SystemTask gets a call.

Multiple windows and the custom Close routine

To close the desk accessory for good, we make use of the CloseOrnHook system global. Both windows belonging to the DA carry the driver reference number in their WindowKind fields; so the system would normally handle close box clicks for them. To avoid this, we have to put a non-zero value into CloseOrnHook. Since a) we might want to install a different behavior for the close boxes depending which window is closed, and b) we need a custom close routine anyway to disable the automatic reinstallation, we install a pointer to the realclose routine in CloseOrnHook every time one of the DA windows is activated and reset that location to zero when it is deactivated.

The routine pointed to by CloseOrnHook receives two parameters: the dCtlEntry pointer in A1 and the window pointer in A4. The window pointer is used to determine the action (one window will beep, the other one will close the DA for good when it is closed), and dCtlEntry is needed to determine the DA’s driver reference number so that we can close it.

Multiple Menus

This is only a little more involving than having just a single menu. In order to have the system pass the menu parameters to the DA for one out of several menus, we have to install the DA’s driver reference number in the global MBarEnable ($A20, word). Then, when a window is activated, we get the handle of the current menu bar and save it away, and set up the menu bar using our own list of menus. In our case, I added two menus which will show up when the main window is clicked. When that window is deactivated, we reset the old menu bar from the stored value and set MBarEnable to zero. As long as MBarEnable is <>0, the DA will receive the menu ID in csParam and the menu item number in csParam + 2. This is taken care of in the Ctl routine. Our menu handler again simply displays the names of the items.

Other remarks

The zoom box and grow box are handled differently in this DA than they were in my first example (I briefly mentioned this in the March column). When a mouse down event is detected, we set the windowKind field of the window record to 8 (application-created window) before calling FindWindow again, this time receiving the correct part code from FindWindow. The windowKind is reset to the old value thereafter, so that close box and drag region clicks will again be handled correctly by the system.

Knowing the zoom box or grow box part code, we can then go and take the appropriate actions.

Just for fun, I added a button in the main (resizeable) window which will show or hide the other window. That window displays the time.

Happy threading and see you next month.

{1}
Listing 1: Some general definitions for  Mach2 DA
( © J. Langowski/MacTutor March 1987  )

HEX
44525652 CONSTANT “drvr
50524F43 CONSTANT “proc
434E544C CONSTANT “cntl

( *** System globals *** )
HEX
8FC CONSTANT JioDone 

DECIMAL
( windowrecord fields, starting with grafport )
16 CONSTANT portRect ( Grafport rectangle )

( fields of WindowPeek )
108 CONSTANT windowKind 
110 CONSTANT wVisible
111 CONSTANT wHiLited
112 CONSTANT goAwayFlag
113 CONSTANT spareFlag
130 CONSTANT dataHandle
140 CONSTANT controlList
152 CONSTANT refCon

( fields of device control entry )
 4 CONSTANT dCtlFlags
 6 CONSTANT dCtlQHdr
16 CONSTANT dCtlPosition
20 CONSTANT dCtlStorage
24 CONSTANT dCtlRefNum
26 CONSTANT dCtlCurTicks
30 CONSTANT dCtlWindow
34 CONSTANT dCtlDelay
36 CONSTANT dCtlEMask
38 CONSTANT dCtlMenu

( csCodes for Ctl calls )
-1 CONSTANT goodBye
64 CONSTANT accEvent
65 CONSTANT accRun
66 CONSTANT accCursor
67 CONSTANT accMenu
68 CONSTANT accUndo
70 CONSTANT accCut
71 CONSTANT accCopy
72 CONSTANT accPaste
73 CONSTANT accClear

( *** standard parameter block data structure *** )
0   CONSTANT  qLink ( pointer to next queue entry [long word] )
4   CONSTANT  qType( queue type [word] )
6   CONSTANT  ioTrap ( routine trap [word] )
8   CONSTANT  ioCmdAddr ( routine address [long word] )
12  CONSTANT  ioCompletion( completion routine [long word] )
16  CONSTANT  ioResult    ( result code returned here [word] )
18  CONSTANT  ioNamePtr ( pointer to file name [long word] )
22  CONSTANT  ioVRefNum ( volume reference number )
24  CONSTANT  ioRefNum
26  CONSTANT  csCode ( type of control call )
28  CONSTANT  csParam( control call parameters )

( *** eventrecord data structure *** )
0  CONSTANT what
2  CONSTANT message
6  CONSTANT when
10 CONSTANT where
14 CONSTANT modifiers

( *** event codes *** )
0  CONSTANT null-evt
1  CONSTANT mousedn-evt
2  CONSTANT mouseup-evt
3  CONSTANT keydn-evt
4  CONSTANT keyup-evt
5  CONSTANT autokey-evt
6  CONSTANT update-evt
7  CONSTANT disk-evt
8  CONSTANT activate-evt
10 CONSTANT network-evt
11 CONSTANT driver-evt

0 CONSTANT inDesk
1 CONSTANT inMenuBar
2 CONSTANT inSysWindow
3 CONSTANT inContent
4 CONSTANT inDrag
5 CONSTANT inGrow
6 CONSTANT inGoAway
7 CONSTANT inZoomIn
8 CONSTANT inZoomOut

CODE shl ( data #bits )
 MOVE.L (A6)+,D0
 MOVE.L (A6),D1
 LSL.L  D0,D1
 MOVE.L D1,(A6)
 RTS
END-CODEMACH

CODE shr ( data #bits )
 MOVE.L (A6)+,D0
 MOVE.L (A6),D1
 LSR.L  D0,D1
 MOVE.L D1,(A6)
 RTS
END-CODEMACH

CODE on
 MOVEQ.L#1,D0
 MOVE.L (A6)+,A0
 MOVE.L D0,(A0)
 RTS
END-CODE MACH

CODE off
 MOVE.L (A6)+,A0
 CLR.L  (A0)
 RTS
END-CODE MACH

CODE unpack
 MOVE.L (A6),D0
 CLR.L   D1
 MOVE.W D0,D1
 CLR.W  D0
 SWAP.W D0
 MOVE.L D0,(A6)
 MOVE.L D1,-(A6)
 RTS
END-CODE MACH

{2}
Listing 2: The desk accessory
( A multi-window, multi-menu, permanent desk accessory  )
( J. Langowski March 87 )

only forth also assembler also mac

INCLUDE” general defs”

BINARY
0000110111101010 CONSTANT DAEmask

HEX
A20 CONSTANT MBarEnable
A88 CONSTANT CloseOrnHook
1B4 CONSTANT SystemTask

( *** close intercept routine *** )

HEADER inter.start
HEADER DAName
 DC.B   10,0,’Mach 2 DA’
HEADER trapaddr 
 DC.L 0
header inter.stack 40 allot
CODE setup.inter.stack
    LEA -8(PC),A6   ( local stack grows downward from here )
    RTS
END-CODE

: inter 
 call frontwindow windowkind + @
 2 <> IF
 [‘] trapaddr @ SystemTask call SetTrapAddress
 [‘] DAName call OpenDeskAcc drop
 THEN
;
 
CODE intercept
 MOVEM.LA0-A4/A6/D0-D7,-(A7)
 JSR  setup.inter.stack
 JSR  inter
 MOVEM.L (A7)+,A0-A4/A6/D0-D7
 MOVE.L trapaddr,-(A7)
 RTS
END-CODE
HEADER inter.end
( for exportation )
‘ trapaddr ‘ inter.start - CONSTANT *trapaddr
‘ intercept  ‘ inter.start - CONSTANT *inter
DECIMAL


( *** start of desk accessory main code *** )

header testDA ( marker for writing to DRVR resource )
 header drvrFlags  2 allot
 header drvrdelay  2 allot
 header drvrEMask  2 allot 
 header drvrMenu   2 allot
 header drvrOpen   2 allot
 header drvrPrime  2 allot
 header drvrCtl  2 allot
 header drvrStatus 2 allot 
 header drvrClose  2 allot
 header drvrname  32 allot

( *** main desk accessory routines *** )
( globals )
header temprect 8 allot
header SizeRect 8 allot   ( grow size limits )
header NewSize 4 allot  ( for SizeWindow )
header penLoc 4 allot( pen location )
header tempString 256 allot ( for numeric conversion etc. )
header ButtonHdl 4 allot  ( for storage of control handle )
header closeflag 4 allot  ( for storage of close status )
header CurMenuList 4 allot  ( menu list temporary storage )
header CloseOrn 4 allot ( CloseOrnHook temporary storage )
header window2 4 allot  ( second DA window )
header showflag 4 allot   ( state of 2nd window, 1: visible, 0: not)
header myRes0 4 allot( local res ID=0 offset )
header temp 4 allot( general purpose )

: @mouse { | mousept -- point } 
 ^ mousept call getMouse mousept ;

: cl  ( WPtr -- ) portrect + call eraserect ;
 
: tp  call drawstring ;

: crd [‘] penLoc call getpen
 10 ( horizontal boundary )
 [‘] penLoc w@ 12 +
 call moveto
;

: realclose { | dCtlEntry }
 MOVE.L A1,-(A6)
 -> dCtlEntry
 MOVE.L A4,-(A6)
 CASE 
 dCtlEntry dCtlWindow + @ OF
 [‘] closeflag off
 dCtlEntry dCtlRefNum + w@ call CloseDeskAcc
 ENDOF

 [‘] window2 @ OF 5 call sysbeep ENDOF
 ENDCASE
;

( *** event-handling routines *** )
: >oldMBar
 [‘] CurMenuList @ call SetMenuBar
 call DrawMenuBar
 0 MBarEnable w!
;

: activate-handler { DAWind event-rec | menuID -- }
 [‘] myRes0 @ -> menuID
 CloseOrnHook @ [‘] CloseOrn !
 [‘] realclose CloseOrnHook !
 event-rec modifiers + w@ 1 and
 IF ( window activated )
 call frontwindow CASE DAWind OF
 menuID MBarEnable w!
 call GetMenuBar [‘] CurMenuList !
 call ClearMenuBar 
 menuID call getRMenu 0 call InsertMenu
 menuID 1+  call getRMenu 0 call InsertMenu
 call drawMenuBar
 ENDOF
 ENDCASE
 ELSE >oldMBar ( window deactivated )
 [‘] CloseOrn @ CloseOrnHook !
 THEN
;

 
: update-handler { DAWind event-rec | -- }
 [‘] penLoc call GetPen
 DAWind CALL BeginUpdate
    DAWind cl
    DAWind CALL DrawGrowIcon
    DAWind CALL DrawControls
 DAWind CALL EndUpdate
 [‘] penLoc 2+ w@ [‘] penLoc w@ 
 call moveto ( restore pen position )
;

: invalSize { gPort | b r -- }
 gPort 4 + w@ -> b
 gPort 6 + w@ -> r
 [‘] temprect r 16 - 0 r b call setrect
 [‘] temprect call invalrect
 [‘] temprect 0 b 16 - r b call setrect
 [‘] temprect call invalrect
;

: mousedn-handler 
 { DCtlEntry DAWind event-rec | 
 whereM DAPort whichCtl whichWind 
 mouseloc menuID menuRes wKind -- }
 [‘] myRes0 @ -> menuID
 DAWind portrect + -> DAPort
 event-rec where + @ dup -> whereM -> mouseloc
 ^ mouseloc call GlobalToLocal
 whereM ^ whichWind call FindWindow drop ( result code )

whichWind CASE
 DAWind OF
 DAWind windowkind + dup w@ -> wKind 
 8 swap w! ( set to application-created window )
 whereM ^ whichWind call FindWindow 
 CASE  
 inGrow OF
 DAPort invalSize
 DAWind whereM [‘] SizeRect call GrowWindow 
 DAWind swap unpack swap -1 call sizewindow
 DAPort invalSize
 ENDOF

 inZoomIn OF 
    DAWind whereM 7 call TrackBox
 IF DAPort invalSize
    DAWind 7 0 call ZoomWindow THEN
 ENDOF

 inZoomOut OF 
    DAWind whereM 8 call TrackBox
 IF DAPort invalSize
    DAWind 8 0 call ZoomWindow THEN
 ENDOF

 mouseloc DAWind ^ whichCtl call FindControl
 IF
 whichCtl mouseLoc 0 call TrackControl
 IF [‘] window2 @ 
    1 [‘] showflag @ - [‘] showflag !
    [‘] showflag @
    IF call showwindow ELSE call hidewindow THEN  
 THEN
 ELSE
 “ Mouse down” tp crd
 THEN
 
 ENDCASE
 wKind DAWind windowkind + w! ( reset to DA window )

 ENDOF

 [‘] window2 @ OF 5 call sysbeep ENDOF

ENDCASE
;

: update-cursor  { DAWind | -- }
 @mouse DAWind portrect + call PtInRect
 IF call InitCursor THEN
;

: getDrvrID { dCtlEntry | -- num }
 dCtlEntry dCtlRefNum + w@ l_ext
 1+ negate
;

: ownResID ( resID drvrID )
 5 shl + -16384 +
;

: install.intercept { dCtlEntry | procHdl -- }
 “proc [‘] myRes0 @ call GetResource -> procHdl
 SystemTask call GetTrapAddr
 procHdl @ *trapaddr + !
 procHdl @ *inter + SystemTask call SetTrapAddr 
;

: Open { DCtlEntry ParamBlockRec | 
 DAWind DAWind2 Res0 oldPort -- }
 ^ oldPort call GetPort
 dCtlEntry dCtlWindow + @
 0= IF ( not open already )
 [‘] closeflag on
 [‘] showflag off
 0 dCtlEntry getDrvrID ownResID -> Res0
 Res0 [‘] myRes0 !
 “proc Res0 call GetResource
 call ReleaseResource ( remove from sysheap )
 Res0 dCtlEntry DCtlMenu + w! 
 ( menu ref has to be updated )
 Res0 0 0 call getNewWindow -> DAWind
 DAWind  dCtlEntry dCtlWindow + !  
 ( store window pointer )
 DAWind  dCtlEntry dCtlRefNum + w@  
 swap windowKind + w!
 Res0 1+ 0 0 call getNewWindow -> DAWind2
 DAWind2 [‘] window2 !
 DAWind2  dCtlEntry dCtlRefNum + w@  
 swap windowKind + w!
 DAWind  call setport
 [‘] sizerect 50 50 500 320 call setrect
 10 40   call moveto
 Res0 DAWind call GetNewControl [‘] ButtonHdl ! 
 oldPort call setPort
 THEN
;

: Close { DCtlEntry ParamBlockRec | -- }
 dCtlEntry dCtlWindow + 
 dup @ call DisposWindow  0 swap ! 
 ( so that Open will work again )
 [‘] window2 @ call disposWindow
 [‘] closeflag @ IF DCtlEntry install.intercept THEN
 >oldMBar
;

: Ctl { DCtlEntry ParamBlockRec | 
 DAWind oldPort event-rec menuID menuRes -- }
 
 ^ oldPort call GetPort
 dCtlEntry dCtlWindow + @ dup -> DAWind call setport
 4 call textfont 9 call textsize
 DCtlEntry DCtlMenu + w@ l_ext -> menuID
 ParamBlockRec csCode + w@ l_ext 
 CASE
 goodByeOF 10 call sysbeep
 dCtlEntry ParamBlockRec Close
 [‘] closeflag off ENDOF
 accEvent OF 
 ParamBlockRec csParam + @ -> event-rec
 event-rec what + w@ 
 CASE
 mousedn-evtOF   
 DCtlEntry DAWind event-rec
  mousedn-handler  ENDOF

 keydn-evtOF DAWind cl
 DAWind call DrawGrowIcon
 DAWind call DrawControls
 10 40 call moveto 
 “ Key down.” tp crd
 ENDOF

 autokey-evtOF ENDOF

 update-evt OF
  DAWind event-rec update-handler   ENDOF
 
 disk-evt OFENDOF

 activate-evt  OF
  DAWind event-rec activate-handler  ENDOF

 network-evtOF ENDOF
 driver-evt OF ENDOF

 ENDCASE

 ENDOF

 accRun OF  [‘] window2 @ dup call setport cl
 4 call textfont 9 call textsize
 20 10 call moveto
 [‘] temp call readdatetime drop
 [‘] temp @ -1 [‘] tempstring 
 call IUTimeString
 [‘] tempstring tp  
 ENDOF
 accCursorOFDAWind update-cursor ENDOF
 accMenuOF
 ParamBlockRec csParam + @ 
 unpack -> menuRes
 l_ext  
 CASE menuID OF
 menuRes
 CASE   1 OF “ Item1-1!” tp crd ENDOF
 2 OF “ Item1-2!” tp crd ENDOF
 3 OF “ Item1-3!” tp crd ENDOF
 4 OF “ Item1-4!” tp crd ENDOF
 6 OF “ Item1-6!” tp crd ENDOF
 ENDCASE ENDOF
  menuID 1+ OF
 menuRes
 CASE   1 OF “ Item2-1!” tp crd ENDOF
 2 OF “ Item2-2!” tp crd ENDOF
 3 OF “ Item2-3!” tp crd ENDOF
 4 OF “ Item2-4!” tp crd ENDOF
 6 OF “ Item2-6!” tp crd ENDOF
 ENDCASE 
 ENDOF
 ENDCASE 
 0 call HiLiteMenu
 ENDOF 
 accUndoOFENDOF
 accCut OFENDOF
 accCopyOFENDOF
 accPaste OFENDOF
 accClear OFENDOF
 ENDCASE
 oldport call setPort
;


: DrStatus { DCtlEntry ParamBlockRec | -- }
 ;

: Prime { DCtlEntry ParamBlockRec | -- }
 ;

( *** glue routines *** )
header local.stack 1000 allot

CODE setup.local.stack
    LEA -8(PC),A6   ( local stack grows downward from here )
    RTS
END-CODE

CODE DAOpen 
 MOVEM.L A0-A1,-(A7)
 setup.local.stack
 MOVE.L  A1,-(A6) 
 MOVE.L  A0,-(A6)
 Open
 CLR.L  D0
 MOVEM.L (A7)+,A0-A1 
RTS END-CODE

CODE DAClose  
 MOVEM.L A0-A1,-(A7)
 setup.local.stack
 MOVE.L  A1,-(A6) 
 MOVE.L  A0,-(A6)
 Close
 CLR.L   D0
 MOVEM.L (A7)+,A0-A1 
RTS END-CODE

CODE DACtl 
 MOVEM.L A0-A1,-(A7)
 setup.local.stack
 MOVE.L  A1,-(A6) 
 MOVE.L  A0,-(A6)
 Ctl
 CLR.L   D0
 MOVEM.L (A7)+,A0-A1
 MOVE.L  JioDone,-(A7) 
RTS END-CODE

CODE DAStatus 
 MOVEM.L A0-A1,-(A7)
 setup.local.stack
 MOVE.L  A1,-(A6) 
 MOVE.L  A0,-(A6)
 DrStatus
 CLR.L   D0
 MOVEM.L (A7)+,A0-A1 
RTS END-CODE

CODE DAPrime 
 MOVEM.L A0-A1,-(A7)
 setup.local.stack
 MOVE.L  A1,-(A6) 
 MOVE.L  A0,-(A6)
 Prime
 CLR.L   D0
 MOVEM.L (A7)+,A0-A1 
RTS END-CODE

header endDA 
( *** code written to DRVR resource ends here *** )

( *** initialization routines *** ) 

: setFlags  [‘] drvrFlags w! ;
: setDelay  [‘] drvrDelay w! ;
: setEMask  [‘] drvrEMask w! ;
: setMenuID [‘] drvrMenu  w! ;

: setOpen [‘] drvrOpen  w! ;
: setPrime[‘] drvrPrime w! ;
: setCtl[‘] drvrCtlw! ;
: setStatus [‘] drvrStatusw! ;
: setClose[‘] drvrClose w! ;

: setName { addr len | target -- }
 [‘] drvrName -> target
 len target c!
 addr target 1+
 len 31 > if  31 else len then
 cmove
;
 

( write resource to file ) 
: $create-res ( str-addr - errcode )
 call CreateResFile
 call ResError L_ext
;

: $open-res { addr | refNum - refNum or errcode }
 addr call OpenResFile -> refNum
 call ResError L_ext
 ?dup IF ELSE refNum THEN
; 

: close-res ( refNum - errcode )
 call CloseResFile
 call ResError L_ext
;

: make-res { addr len rtype ID name | -- }
 addr len call PtrToHand 
 abort” Could not create resource handle”
 rtype ID name call AddResource
;

: write-out { filename | refnum -- } 
 filename $create-res 
 abort” That resource file already exists”
 filename $open-res
 dup 0< abort” Open resource file failed”
 -> refnum
 refnum call UseResFile
 [‘] testDA [‘] endDA over - 
 “drvr 12 “ Mach 2 DA” make-res
 [‘] inter.start [‘] inter.end over - 
 “proc -16000 “ Mach 2 DA” make-res
 “proc -16000 call GetResource
 dup 80 call SetResAttrs  ( 64: sysheap + 16: locked )
 call ChangedResource
 refnum close-res abort” Could not close resource file”
;

: init-DA
( initialize offsets )
 [‘] DAOpen [‘] testDA -  setOpen 
 [‘] DAPrime   [‘] testDA -  setPrime
 [‘] DACtl     [‘] testDA -  setCtl 
 [‘] DAStatus  [‘] testDA -  setStatus
 [‘] DAClose   [‘] testDA -  setClose
( initialize driver name )
 “ Mach 2 DA” count setname
( initialize driver flags, 
 NeedLock, NeedTime, NeedGoodBye, CtlEnable )
 [ hex ] 7400 setFlags [ decimal ]
( initialize delay time )
 60 setDelay
( initialize event mask, events recommended in IM )
 DAEMask setEMask 
( initialize menu ID, local ID=0 for DRVR ID=12 )
 -16000 setMenuID ( careful! this field will NOT be changed
 by the DA Mover when ID is changed )
;
 
: make-DA
 init-DA
 “ Mach2 DA.rsrc” $delete drop
 “ Mach2 DA.rsrc” write-out
;

{3}
Listing 3: RMaker input file
*   Resources for MACH 2 desk accessory 

Mach2 DA
DFILDMOV

INCLUDE Mach2 DA.rsrc

Type MENU
     ,-16000
First
Item 1-1
Item 1-2
Item 1-3
Item 1-4
(-
Item 1-6

Type MENU
     ,-15999
Second
Item 2-1
Item 2-2
Item 2-3
Item 2-4
(-
Item 2-6


Type WIND
     ,-16000
Mach2 Desk Accessory
240 10 320 250
Visible GoAway
8
0

Type WIND
     ,-15999
Time
140 400 165 500
Invisible GoAway
16
0

Type CNTL
     ,-16000
Time
10 10 27 50
Visible
0
0
0 0 0