TweetFollow Us on Twitter

Custom Menu
Volume Number:3
Issue Number:7
Column Tag:Forth Forum

Custom Menu Definition

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

"Pascal calling and menu definition routines"

Once again, this month's excursion will take us into a field that is unusual for threaded code languages on the Macintosh: we will define a custom menu routine entirely in Mach 2 Forth and create the necessary glue code that is needed to call this routine as a Pascal procedure, the way the Toolbox expects it.

The subject as such had already been addressed by Darryl Lovato (V2#8), where he redefined the standard menu definition procedure in TML Pascal. Besides giving you one more example of 'kernel-independent' Forth code, I chose this topic to illustrate the concept of Pascal parameter passing in Forth (discovering on the way one potentially awful bug in the desk accessory glue code that I wrote recently. Read on.).

We'll also have some Forth bits recently sent to me by Juri Munkki (the creator of the TED editor task), and some news on further Mach2 developments. But first, to our main theme.

Menu Defintion Routines

The format of a menu is record is given below.

As you might know, the routine that is used by the Menu Manager to draw a menu is kept in a MDEF resource. Since each menu contains information on the ID of its corresponding MDEF resource, the menu definition routine may be changed easily by changing the routine ID in the MENU resource. (Fig. 1). The standard Macintosh MDEF (contained in the Mac+ ROMS) has an ID of 0. If the menu resource contains a different ID, that MDEF will be loaded and a handle to it put into the menuProc field of the menu record. Alternatively, one may install the menu with its old ID, and substitute the handle afterwards.

In order to write our custom menu definition routine in Forth, we need to know some details about the parameters that are passed to it and how they are located on the stack. The menu definition routine is a Pascal procedure defined in the following way (IM):

procedure MyMenu (message: INTEGER; theMenu: MenuHandle; VAR menuRect: 
Rect; hitPt: Point; VAR whichItem: INTEGER);

with the parameters

message: 0, 1, or 2. 0 is mDrawMsg, telling the menu routine to draw the menu within the bounds given by menuRect. 1 is mChooseMsg, which tells the routine that the menu item corresponding to the mouse location in hitPt should be highlighted and its number returned in whichItem. 2, mSizeMsg, indicates that the menu's dimensions should be calculated and stored in the menuWidth and menuHeight fields of the menu record.

theMenu a handle to the menu record from which the routine was initiated.

menuRect: the rectangle, in global coordinates, in which the menu is located.

hitPt the mouse location, in global coordinates, when the routine was called.

whichItem on entry contains the item number of the last item selected and on exit the number of the new item selected.

The menu manager expects the entry point to the routine to be at the beginning of the MDEF resource. Since the entry point to the highest-level Forth word is usually somewhere near the end of the code, this will require some hacking with vectors.

Fig. 2 shows how the stack looks like on entry to the routine. As usual, the top of stack (lowest in memory) contains the return address, followed by the parameters. What our glue code has to do is to save the return address somewhere, move all parameters from the A7 to the Forth stack (A6), save the contents of all registers, and call the Forth routine. On exit, the registers should be restored, before returning through an RTS. Fig. 3 shows a possible stack arrangement just before entering (or after exiting) the Forth routine.

This simple method, however, has some drawbacks. In order to put the parameters on the Forth stack, we have to define an A6 stack space first (thereby changing A6), so the registers will have to be saved before the parameters are transferred. That by itself is not a big problem, in fact it is the standard method for Pascal procedure calling. The other problem is with setting up the A6 stack. In earlier columns I included routines for stack setup in the glue code, defining stack space within the code space. Although this will do the job, it completely precludes re-entrancy and can be space-consuming if different routines cannot share the same stack space. Therefore, this time I'll describe an improvement that is also much closer to the Pascal calling conventions.

In Pascal routines, the first instruction usually is a

 LINK A6, -nnn

where nnn is the number of bytes to reserve on the stack for local variables. The LINK instruction will push the current value of A6 on the stack, copy A7 to A6 (thereby making A6 point to the top of stack), and reserve nnn bytes on the stack, changing A7 accordingly. Before we exit the routine, we'll have an

 UNLK A6

which reverses the action of LINK: it replaces A7 with the current value of A6 and pops the top of stack into A6, thereby restoring A6 and A7 to the values they had on routine entry.

To get rid of the parameters on the stack, we then put the return address into A0

 MOVE.L (A7)+,A0

pop the parameters (m bytes) off the stack

 ADD.L  #m,A7

and leave the routine through the return address

 JMP    (A0) .

The glue code at the end of listing 1 implements this calling procedure. Its advantage is that after the LINK instruction we may peacefully save the registers on the stack, preserving A6 as a pointer to our parameters (they start at 8(A6)). Also, we have automatically created a local variable space (512 bytes in our example) which serves as a Forth stack with A6 already aligned in the proper way. Since the Forth stack is located within a stack frame in the A7 stack, re-entry is no problem (remember, though, that some applications don't provide too much A7 stack space, so be careful).

Half the local stack space is devoted to the A3 stack, which is the loop return stack in Mach2. A3, too, is set up by the glue code. And here comes the potential bug in my DA routines that I had already mentioned: those glue routines do not contain support for an A3 stack. Since I did not use DO...LOOPs in the examples, there were no problems, but should you use that code to develop other desk accessories that use loops, be careful to add the extra A3 setup.

Messages to the MDEF routine

Now that we have passed all the parameters to the menu definition routine in the right way, what are we going to do with them? We have to write a routine that handles the three possible message, mDrawMsg, mChooseMsg and mSizeMsg.

Our custom menu will look like the one in Fig. 4.

Fig. 4: Output from the custom MDEF routine

A simple four-by-four palette arrangement of fixed size (100 by 100 pixels in the example). The item number returned will be from 1 to 16, and we do not take into account whether a menu item is disabled or not.

The three possible messages are handled in a CASE statement which forms the main body of the MDEF routine. Refer to Listing 1 to see how they work. First, the menu width and height are recalled from the menu record, and the sizes of the palette rectangles calculated (wd and ht). The top and left coordinates of the menu rectangle are obtained from menuRect. The CASE statement follows, where the Draw message simply draws sixteen little boxes into the menu rectangle, filling them with some patterns. These patterns are part of the Quickdraw global variables, to which the words white, etc. provide access.

The Size message stores the menu's dimensions in the menu record.

The Choose message is the most complicated one: whichItem on entry contains the number of the item selected last (zero if none). The item rectangles are scanned, one after the other, to see whether hitPt is in one of them. If so, the new item number is calculated and compared to the old one. If they are the same, nothing is done; if they are not, both the new and the old item rectangles are inverted and the new item number returned in whichItem. If the new mouse location does not correspond to any item, we just invert the old item and return zero in whichItem.

At the end of the listing, code is provided to install the new MDEF routine in the header of an existing menu for testing (and to remove it, of course). To get the IDs of the menus installed in the Mach2 system (or any other Forth you might transport this code to), the word list.menus is defined near the beginning of the listing. Finally, at the very end I added some code to write a MDEF 1 resource to a new resource file so that you may install this custom menu with ResEdit.

Feedback dept.

I recently received some more mail from Juri Munkki, who already had an article in this magazine. It deals with implementing animation under Mach2 and you'll read about it very soon; for now just a clever trick that I found in the code. ANEW <word>, used at the beginning of a file to forget the previous definition, is very useful and does not exist in Mach2. A redefinition using FORGET was possible in Mach2.0, but no more in 2.1, since FORGET is not a global definition anymore. Listing 2 shows Juri's hack to circumvent that problem: he takes the definition of DUMP, which is defined (global) just before FORGET in the dictionary, and uses it as a pointer to access the FORGET code. Try out for yourself. There is also a word that will return heap space for a variable that contains a handle.

The new Mach2 update, containing the editor, is on its way (as of beginning of May). In addition to the editor (still only single-window, sorry to say), the debugger has the bus, address, etc. error handlers fixed: they return back directly into the Forth system. Also, a switch is included by which you can select to enter TMON (or any other debugger) or the Forth debugger upon pressing the interrupt switch. For customizing, the source code of the I/O task is included, and the SANE handling has improved (like error traps etc.). I might tell you more about it next time when I've received my copy.

For this time, happy threading.

{1}
Listing 1: Menu definition routine
( © J. Langowski/MacTutor   )

( *** menu definition procedures. J.L. April 1987 *** )

ONLY FORTH ALSO ASSEMBLER ALSO MAC

HEX
4D444546 CONSTANT "mdef
0 CONSTANT mDrawMsg
1 CONSTANT mChooseMsg
2 CONSTANT mSizeMsg
DECIMAL

CODE white
 MOVE.L (A5),-(A6)
 SUBQ.L #8,(A6)
 RTS
END-CODE MACH

CODE black
 MOVE.L (A5),-(A6)
 SUBI.L #16,(A6)
 RTS
END-CODE MACH

CODE gray
 MOVE.L (A5),-(A6)
 SUBI.L #24,(A6)
 RTS
END-CODE MACH

CODE ltgray
 MOVE.L (A5),-(A6)
 SUBI.L #32,(A6)
 RTS
END-CODE MACH

CODE dkgray
 MOVE.L (A5),-(A6)
 SUBI.L #40,(A6)
 RTS
END-CODE MACH

CODE w*
 MOVE.L (A6)+,D1
 MOVE.L (A6)+,D0
 MULS.W D1,D0
 MOVE.L D0,-(A6)
 RTS
END-CODE MACH

CODE w/
 MOVE.L (A6)+,D1
 MOVE.L (A6)+,D0
 DIVS.W D1,D0
 EXT.L  D0
 MOVE.L D0,-(A6)
 RTS
END-CODE MACH
 
CODE w/mod
 MOVE.L (A6)+,D1
 MOVE.L (A6)+,D0
 DIVS.W D1,D0
 MOVE.L D0,D1
 SWAP.W D1
 EXT.L  D1
 EXT.L  D0
 MOVE.L D1,-(A6)
 MOVE.L D0,-(A6)
 RTS
END-CODE MACH
 
( *** menu record data structure *** )
 0 CONSTANT menuID ( integer )
 2 CONSTANT menuWidth( integer )
 4 CONSTANT menuHeight  ( integer )
 6 CONSTANT menuProc ( handle )
10 CONSTANT enableFlags   ( longint )
14 CONSTANT menuData ( Str255 and other data ) 
 ( *** menu Data format *** )
 ( counted string: menu title )
 ( followed by 1 to 31 times: )
 ( counted string: menu item  )
 ( byte: item icon # )
 ( byte: equivalent character )
 ( byte: check mark character )
 ( byte: text attributes )
 ( .... )
 ( end: zero byte. )

: list.menus 
 32767 0 do 
 i call getMhandle
 ?dup IF ." Menu # " i . ." , handle " dup . cr 
 ." MenuData:" cr
 @ menuData + dup count type cr 
 ( type menu title )
 dup c@ + 1+ ( start of first item string )
 BEGIN
 dup count dup
 WHILE type cr 
 dup c@ + 5 +
 REPEAT drop 
 THEN
 PAUSE loop
;

( *** code moved to custom menu routine space starts here *** )

header start
 JMP start  ( to be filled later )
header temprect 8 allot
header itemrect 8 allot

( redefine multiplication and division words )
( so they remain local to our code, not relative )
( to application globals )
: * w* ;
: / w/ ;
: /mod w/mod ;

: mdef { message theMenu menuRect hitPt whichItem | 
 width height wd ht top left item# wi# -- }
 theMenu @ dup menuwidth  + w@ -> width
 width 4 / -> wd 
   menuheight + w@ -> height  
      height 4 / -> ht
 menuRect    w@ -> top
 menuRect 2+ w@ -> left

 message CASE
 mDrawMsg OF ( draw menu )
 height 0 DO
 4 0 DO 
 ['] temprect 
 left i wd * + top j + over wd + over ht +
 call setrect   
 ['] tempRect 4 4 
 i  CASE  0 OF white ENDOF
 1 OF ltgray  ENDOF
 2 OF gray  ENDOF
 3 OF dkgray  ENDOF
   black ( shouldn't occur )
   ENDCASE CALL FillRoundRect 
 ['] tempRect 4 4 CALL FrameRoundRect
 LOOP
 ht +LOOP
 ENDOF

 mChooseMsg OF ( choose item )
 whichItem w@ -> wi#
 ['] ItemRect 
 wi# 1- 4 /mod ht * top + swap wd * left + swap
 over wd + over ht +  call setrect
 hitPt menuRect call PtInrect
 IF
   4 0 DO
 4 0 DO 
 i j 4 * + 1+ -> item#
 ['] temprect 
 left i wd * + top j ht * + 
 over wd + over ht +  call setrect   
 hitPt ['] tempRect call PtInRect 
 IF item# wi# <>
  IF ['] ItemRect 4 4 call InvertRoundRect
     ['] tempRect 4 4 call InvertRoundRect
   item# whichItem w!
   THEN
 THEN
 LOOP
   LOOP
 ELSE
  wi# IF ['] ItemRect 4 4 call InvertRoundRect THEN
   0 whichItem w!
 THEN
 ENDOF

 mSizeMsg OF ( our sizes are constant ) 
 100 theMenu @ menuWidth  + w!
 100 theMenu @ menuHeight + w!
 ENDOF
 ENDCASE
;

( *** glue routine *** )

CODE custom.menu
    LINKA6,#-512 ( 512 bytes of local Forth stack )
 MOVEM.L A0-A5/D0-D7,-(A7)( save registers )
 MOVE.L A6,A3    ( setup local loop return stack )
 SUBA.L #256,A3  ( in the low 256 local stack bytes )
 MOVE.L 8(A6),D0 ( VAR whichItem: INTEGER )
 MOVE.L 12(A6),D1  ( hitPt: Point )
 MOVE.L 16(A6),A0( VAR menuRect: Rect )
 MOVE.L 20(A6),A1  ( theMenu: MenuHandle )
 MOVEQ.L #0,D2
 MOVE.W 24(A6),D2  ( message: INTEGER )
 
 MOVE.L D2,-(A6)
 MOVE.L A1,-(A6)
 MOVE.L A0,-(A6)
 MOVE.L D1,-(A6)
 MOVE.L D0,-(A6)

 JSR mdef ( call Forth routine )

 MOVEM.L (A7)+,A0-A5/D0-D7( restore registers )
 UNLK A6
 MOVE.L (A7)+,A0 ( return address )
 ADD.W  #18,A7   ( pop off 18 bytes of parameters )
 JMP    (A0)
END-CODE

header end

' custom.menu ' start 2+ - ' start 2+ w!

( *** installation *** )
variable Hregular

: install.custom { menu# | mh procH -- }
 menu# call getMHandle -> mh
 mh 0= abort" Non-existing menu ID given."
 ['] start ['] end over - call PtrToHand 
 abort" Can't get enough memory to install."
 -> procH 
 mh call HLock
 mh @ menuProc + @ Hregular !
 procH mh @ menuProc + !
 mh call HUnLock
 . . cr
;

: remove.custom { menu# | mh procH -- }
 menu# call getMHandle -> mh
 mh 0= abort" Non-existing menu ID given."
 mh call HLock
 mh @ menuProc + @ call DisposHandle
 Hregular @ mh @ menuProc + !
 mh call HUnLock
 . . . cr
;

( *** making a resource *** )
: $create-res call CreateResFile call ResError L_ext ;

: $open-res { addr | refNum -- result }
 addr call openresfile -> refNum
 call ResError L_ext
 dup not IF drop refNum THEN 
;

: $close-res call CloseResFile call ResError L_ext ;

: make-mdef { | refNum -- }
 " mdef.res" dup $create-res
 abort" You have to delete the old 'mdef.res' file first."
 $open-res dup -> refNum call UseResFile 
 ['] start ['] end over - call PtrToHand drop ( result code )
 "mdef 1 " Mach2 MDEF" call AddResource
 refNum $close-res drop ( result code )
;
{2}
Listing 2: some Mach2 tricks from Finland
( Juri Munkki, April 1987 )

: ANEW { | LEN }
  32 WORD DUP C@ 1+ NEGATE -> LEN
  FIND SWAP DROP
   IF .s LEN >IN +! 
      ['] DUMP ( dump is defined just before FORGET )
      2+ @ 6 + EXECUTE CALL DRAWMENUBAR THEN
 LEN >IN +!
CREATE DOES> DROP
;

( Heapvar:
  Used in the form: HEAPVAR VARIABLE_NAME. 
  If VARIABLE_NAME exists, it returns the handle 
  from VARIABLE_NAME to the heap. It should be used
  before ANEW to free space from the heap. )
: HEAPVAR
  32 WORD
  FIND IF LINK>BODY EXECUTE 
     @ DUP 
     IF DUP CALL HUNLOCK DROP
            CALL DISPOSHANDLE DROP ELSE DROP THEN
     ELSE DROP
   THEN
;
 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Latest Forum Discussions

See All

Six fantastic ways to spend National Vid...
As if anyone needed an excuse to play games today, I am about to give you one: it is National Video Games Day. A day for us to play games, like we no doubt do every day. Let’s not look a gift horse in the mouth. Instead, feast your eyes on this... | Read more »
Old School RuneScape players turn out in...
The sheer leap in technological advancements in our lifetime has been mind-blowing. We went from Commodore 64s to VR glasses in what feels like a heartbeat, but more importantly, the internet. It can be a dark mess, but it also brought hundreds of... | Read more »
Today's Best Mobile Game Discounts...
Every day, we pick out a curated list of the best mobile discounts on the App Store and post them here. This list won't be comprehensive, but it every game on it is recommended. Feel free to check out the coverage we did on them in the links below... | Read more »
Nintendo and The Pokémon Company's...
Unless you have been living under a rock, you know that Nintendo has been locked in an epic battle with Pocketpair, creator of the obvious Pokémon rip-off Palworld. Nintendo often resorts to legal retaliation at the drop of a hat, but it seems this... | Read more »
Apple exclusive mobile games don’t make...
If you are a gamer on phones, no doubt you have been as distressed as I am on one huge sticking point: exclusivity. For years, Xbox and PlayStation have done battle, and before this was the Sega Genesis and the Nintendo NES. On console, it makes... | Read more »
Regionally exclusive events make no sens...
Last week, over on our sister site AppSpy, I babbled excitedly about the Pokémon GO Safari Days event. You can get nine Eevees with an explorer hat per day. Or, can you? Specifically, you, reader. Do you have the time or funds to possibly fly for... | Read more »
As Jon Bellamy defends his choice to can...
Back in March, Jagex announced the appointment of a new CEO, Jon Bellamy. Mr Bellamy then decided to almost immediately paint a huge target on his back by cancelling the Runescapes Pride event. This led to widespread condemnation about his perceived... | Read more »
Marvel Contest of Champions adds two mor...
When I saw the latest two Marvel Contest of Champions characters, I scoffed. Mr Knight and Silver Samurai, thought I, they are running out of good choices. Then I realised no, I was being far too cynical. This is one of the things that games do best... | Read more »
Grass is green, and water is wet: Pokémo...
It must be a day that ends in Y, because Pokémon Trading Card Game Pocket has kicked off its Zoroark Drop Event. Here you can get a promo version of another card, and look forward to the next Wonder Pick Event and the next Mass Outbreak that will be... | Read more »
Enter the Gungeon review
It took me a minute to get around to reviewing this game for a couple of very good reasons. The first is that Enter the Gungeon's style of roguelike bullet-hell action is teetering on the edge of being straight-up malicious, which made getting... | Read more »

Price Scanner via MacPrices.net

Take $150 off every Apple 11-inch M3 iPad Air
Amazon is offering a $150 discount on 11-inch M3 WiFi iPad Airs right now. Shipping is free: – 11″ 128GB M3 WiFi iPad Air: $449, $150 off – 11″ 256GB M3 WiFi iPad Air: $549, $150 off – 11″ 512GB M3... Read more
Apple iPad minis back on sale for $100 off MS...
Amazon is offering $100 discounts (up to 20% off) on Apple’s newest 2024 WiFi iPad minis, each with free shipping. These are the lowest prices available for new minis among the Apple retailers we... Read more
Apple’s 16-inch M4 Max MacBook Pros are on sa...
Amazon has 16-inch M4 Max MacBook Pros (Silver and Black colors) on sale for up to $410 off Apple’s MSRP right now. Shipping is free. Be sure to select Amazon as the seller, rather than a third-party... Read more
Red Pocket Mobile is offering a $150 rebate o...
Red Pocket Mobile has new Apple iPhone 17’s on sale for $150 off MSRP when you switch and open up a new line of service. Red Pocket Mobile is a nationwide MVNO using all the major wireless carrier... Read more
Switch to Verizon, and get any iPhone 16 for...
With yesterday’s introduction of the new iPhone 17 models, Verizon responded by running “on us” promos across much of the iPhone 16 lineup: iPhone 16 and 16 Plus show as $0/mo for 36 months with bill... Read more
Here is a summary of the new features in Appl...
Apple’s September 2025 event introduced major updates across its most popular product lines, focusing on health, performance, and design breakthroughs. The AirPods Pro 3 now feature best-in-class... Read more
Apple’s Smartphone Lineup Could Use A Touch o...
COMMENTARY – Whatever happened to the old adage, “less is more”? Apple’s smartphone lineup. — which is due for its annual refresh either this month or next (possibly at an Apple Event on September 9... Read more
Take $50 off every 11th-generation A16 WiFi i...
Amazon has Apple’s 11th-generation A16 WiFi iPads in stock on sale for $50 off MSRP right now. Shipping is free: – 11″ 11th-generation 128GB WiFi iPads: $299 $50 off MSRP – 11″ 11th-generation 256GB... Read more
Sunday Sale: 14-inch M4 MacBook Pros for up t...
Don’t pay full price! Amazon has Apple’s 14-inch M4 MacBook Pros (Silver and Black colors) on sale for up to $220 off MSRP right now. Shipping is free. Be sure to select Amazon as the seller, rather... Read more
Mac mini with M4 Pro CPU back on sale for $12...
B&H Photo has Apple’s Mac mini with the M4 Pro CPU back on sale for $1259, $140 off MSRP. B&H offers free 1-2 day shipping to most US addresses: – Mac mini M4 Pro CPU (24GB/512GB): $1259, $... Read more

Jobs Board

All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.