\ Multi-Forth menu management and intuitext \ Copyright (c) 1986 Creative Solutions, Inc. \ by David Butler 2-27-86 anew DemoMarker hex : MENUNUM ( n -- n ) 01f and ; : ITEMNUM ( n -- n ) -5 scale 03f and ; : SUBNUM ( n -- n ) -0b ( decimal -11 ) scale 01f and ; : SHIFTMENU ( n -- n ) 01f and ; : SHIFTITEM ( n -- n ) 031f and 5 scale ; : SHIFTSUB ( n -- n ) 01f and 0b ( decimal 11) scale ; decimal 4 constant #MenuItems \ this will determine number of MenuItems \ ******************************************************* \ * Define IntuiText Structures for MenuItems * \ ******************************************************* \ Each menu item must have a text string, and it must \ be in the form an IntuiText structure. \ Setup and initialize IntuiText structures for menuitems... create &mtext \ allocate an array of structures #MenuItems IntuiText * here over erase allot : text[] ( n -- ) \ address of IntuiText item, this is a convenient \ way to address an array of structures, \ but would be better to use 1array ... IntuiText * &mtext + ; \ Here I will create an initialization word which I will \ execute once, then forget it. This saves me from having \ to define each IntuiText item separately. The effect of the \ routine is simply to get the common initial values into the \ structure... : InitText ( -- ) \ this will be executed once, at compile time #MenuItems 0 do 0 i text[] +itFrontPen c! 1 i text[] +itBackPen c! JAM2 i text[] +itDrawMode c! 0 i text[] +itLeftEdge w! 1 i text[] +itTopEdge w! 0 i text[] +itNextText ! loop ; InitText \ do it, then throw away initializing code forget InitText \ Set up the actual text strings for each menu item create John 0," John" create Paul 0," Paul" create George 0," George" create Ringo 0," Ringo" : InitItemNames ( -- ) \ addresses must be initialized at runtime John 0 Text[] +itIText ! Paul 1 Text[] +itIText ! George 2 Text[] +itIText ! Ringo 3 Text[] +itIText ! ; \ ******************************************************* \ * Define MenuItems * \ ******************************************************* \ Now, set up an array of MenuItem structures \ First, allocate space for array of MenuItem structures... create &mitem #MenuItems MenuItem * allot \ set up a convenient method to access elements of MenuItem \ structure array... : mitem[] ( n -- ) \ address of individual menu item MenuItem * &mitem + ; \ We could do this later, but since this code will be \ forgotten anyway, might as well compute the MenuItem flag \ mask here... (COMMSEQ allows AmigaKey command shortcuts) CHECKIT COMMSEQ | ITEMTEXT | ITEMENABLE | HIGHBOX | constant MFLAGS \ Here I will create another initialization word which I will \ execute once, then forget. This saves me from having \ to define each menu item separately. The effect of the \ routine is simply to get the common initial values into the \ structure... : InitMenuItems ( -- ) \ we can initialize data at compile time... #MenuItems 0 do 0 i mitem[] +miLeftEdge w! i 10 * i mitem[] +miTopEdge w! 112 i mitem[] +miWidth w! 10 i mitem[] +miHeight w! MFLAGS i mitem[] +miFlags w! \ pre-computed mask 0 i mitem[] +miSelectFill ! 0 i mitem[] +miCommand c! 0 i mitem[] +miSubItem ! 0 i mitem[] +miNextSelect w! loop ; InitMenuItems \ do it once, then throw away initializing code forget InitMenuItems : InitMenuList ( -- ) \ due to relocation issue, \ addresses must be initialized at runtime #MenuItems 0 \ do for all menuitems (last gets bad NextItem...) do i 1+ mitem[] i mitem[] +miNextItem ! \ address of next item i text[] i mitem[] +miItemFill ! \ address of IntuiText loop \ fix last in menuitem list (terminate menu item list) 0 #MenuItems 1- mitem[] +miNextItem ! ; \ Now put in command key equivalents (Note COMMSEQ flag must be \ set in +miFlags) and Mutual excludes bit masks hex ascii J 0 mitem[] +miCommand c! FFFE 0 mitem[] +miMutualExclude ! \ exclude all but first menu item ascii P 1 mitem[] +miCommand c! FFFD 1 mitem[] +miMutualExclude ! \ exclude all but second menu item ascii G 2 mitem[] +miCommand c! FFFB 2 mitem[] +miMutualExclude ! \ exclude all but third menu item ascii R 3 mitem[] +miCommand c! FFF7 3 mitem[] +miMutualExclude ! \ exclude all but fourth menu item decimal \ ******************************************************* \ * Define the Menu * \ ******************************************************* struct Menu Beatles 0 Beatles +mNextMenu ! 0 Beatles +mLeftEdge w! 0 Beatles +mTopEdge w! 112 Beatles +mWidth w! 10 Beatles +mHeight w! MENUENABLED Beatles +mFlags w! structend \ define window struct NewWindow bw bw InitWindow \ copy default value to new window 20 bw +nwLeftEdge w! 20 bw +nwTopEdge w! 500 bw +nwWidth w! 100 bw +nwHeight w! fCLOSEWINDOW MOUSEBUTTONS | MENUPICK | NEWSIZE | INACTIVEWINDOW | bw +nwIDCMPFlags ! WINDOWCLOSE SMART_REFRESH | ACTIVATE | WINDOWDRAG | WINDOWDEPTH | WINDOWSIZING | REPORTMOUSE | ACTIVATE | GIMMEZEROZERO | INACTIVEWINDOW | bw +nwFlags ! WBENCHSCREEN bw +nwType w! structend ginit : Move&Text ( x y addr cnt -- ) \ move, then draw text 2swap xform.array xlate moveto rport !a1 !d0 !a0 graphics 10 ; \ 10 is Text : StartupAction clr.window 20 20 " Simple Menu Demonstration" count Move&Text 20 30 " Activate this window, then press right" count Move&Text 20 40 " mouse button." count Move&Text 20 50 " Note (right) Amiga command key shortcut." count Move&Text ; : JohnAction ( -- ) clr.window 20 20 " John Lennon was the soul of the Beatles..." count Move&Text 20 30 " His song writing partnership with Paul" count Move&Text 20 40 " McCartney produced many of this generation's" count Move&Text 20 50 " most memorable songs." count Move&Text ; : PaulAction ( -- ) clr.window 20 20 " Paul McCartney was the heart of the Beatles..." count Move&Text 20 30 " His song writing partnership with John" count Move&Text 20 40 " Lennon produced many of this generation's" count Move&Text 20 50 " most memorable songs." count Move&Text ; : GeorgeAction ( -- ) clr.window 20 20 " George Harrison was the spirit of the Beatles..." count Move&Text 20 30 " His song called SOMETHING was one of Beatle's" count Move&Text 20 40 " biggest hits." count Move&Text ; : RingoAction ( -- ) clr.window Rport 20 20 " Richard Starkey was the band's comic relief." count Move&Text Rport 20 30 " However, his marriage to Barbara Bach showed" count Move&Text Rport 20 40 " that he had the last laugh." count Move&Text ; : goodbye ( -- ) \ bye if turnkey, abort if not ?turnkey if bye else abort then ; : CleanUpBeatles ( -- ) Currentwindow @ dup ClearMenuStrip closewindow ; : BeatleEvents ( -- ) begin GetEvent case fCLOSEWINDOW of CleanUpBeatles goodbye endof MENUPICK of ThisEvent +eCode w@ ITEMNUM case 0 of JohnAction endof 1 of PaulAction endof 2 of GeorgeAction endof 3 of RingoAction endof endcase endof pause ( give other tasks some cycles... ) endcase again ; create $Beatles 0," The Beatles " create bwtitle 0," A Beatles Window " : dobeatles ( -- ) \ this is the turnkey token ginit InitItemNames \ initialize IntuiText string InitMenuList \ initialize MenuItem linked list & \ pointers to IntuiText strings $Beatles Beatles +mMenuName ! \ give Menu a name 0 mitem[] Beatles +mFirstItem ! \ give Menu ptr to its items bwtitle bw +nwTitle ! \ give Window a name bw openwindow verifywindow \ open the window CurrentWindow @ beatles SetMenuStrip \ attach the menu to it StartupAction BeatleEvents ; dobeatles