TITLE Expanded Menus, Version 1.03 **** xmenu.s *********************************************** ** ** File: Version 1.03, 12/29/92 ** Author: Brian Maguire ** ************************************************************ RPL ************************************************************ * Unfrozen entries ************************************************************ * * The following entries have not changed in ROM versions * A-J. Since they are unfrozen, it is possible that they * will be moved in future ROM versions. ASSEMBLE =SetDA3Bad EQU #394F9 =MenuDef@ EQU #418A4 =SHRINKVDISP EQU #130CA RPL ************************************************************ * Local lambda definitions ************************************************************ DEFINE getlines@ 7GETLAM ( sub-routine : -> MenuLines ) DEFINE domnukey@ 6GETLAM ( menu key eval. sub-routine ) DEFINE xmlines@ 5GETLAM ( # of disp lines for menu ) DEFINE xmrow@ 4GETLAM ( first menu row of page ) DEFINE xmpath@ 3GETLAM ( menu path used by UP ) DEFINE xmnext@ 2GETLAM ( more rows below? ) DEFINE xmexit@ 1GETLAM ( exit flag ) DEFINE getlines! 7PUTLAM DEFINE domnukey! 6PUTLAM DEFINE xmlines! 5PUTLAM DEFINE xmrow! 4PUTLAM DEFINE xmpath! 3PUTLAM DEFINE xmnext! 2PUTLAM DEFINE xmexit! 1PUTLAM ************************************************************ NULLNAME XMENU ( --> ) :: CK0 POLSaveUI ERRSET :: ** Sub-routine to set MenuLines. If the menu data is not a ** list then default to 4. ' :: DoFirstRow MenuDef@ EVAL ( return menu data ) DUPTYPELIST? ITE :: LENCOMP #1- SIX #/ SWAPDROP #1+ FOUR #MIN ; :: DROP FOUR ; xmlines! ; ** This sub-routine is stored in 4LAM to reduce the size and ** speed up the key handler. It also make the source file ** more readable ** STACK ON INPUT: #key #plane ' ( define menu key evaluator sub-program ) :: SetDA2aBad ************************************************************ ** ** Including this section of code will cause XMENU to exit ** when a key is pressed that is assigned to a menu label. ** Leaving this section commented will force XMENU to exit ** only when [ON] is pressed. * * TRUE xmexit! * ************************************************************ ( get and eval keyob ) MenuDef@ MenuRow@ ( cache old MenuInfo ) { NULLLAM NULLLAM } BIND Key>StdKeyOb ( Get keyob and eval ) EVAL 2GETLAM 1GETABND ( push old menu info ) ( compare old and new menus ) OVER MenuDef@ EQUAL ( old/new menu same? ) NOTcasedrop ( no, add to path ) :: xmpath@ INNERCOMP get1 SWAP#1+ ( add old MenuDef ) xmrow@ SWAP#1+ ( add old menu row ) {}N xmpath! getlines@ EVAL ( init MenuLines ) ClrDAsOK ( flag display refresh ) ; SWAPDROP MenuRow@ EQUAL ( old/new row same? ) NOT?SEMI ( rows dif, then SEMI ) xmrow@ MenuRow! ( restore first MenuRow ) ; FOUR ONE NULL{} FalseFalse { NULLLAM NULLLAM NULLLAM NULLLAM NULLLAM NULLLAM NULLLAM } BIND ONE MenuRow! ( init MenuRow ) getlines@ EVAL ( init MenuLines ) ' *** Application Display Routine **** :: TOADISP ( force ABUFF ) ( Status Display ) DA1OK?NOTIT ?DispStatus ( Stack Display ) DA2aOK?NOTIT :: KEYINBUFFER? case SetDA2aBad NINETEEN !DcompWidth SIX xmlines@ #- #1+_ONE_DO (DO) INDEX@ #:>$ DEPTH #1- INDEX@ #< ?SKIP :: INDEX@ #1+PICK 1stkdecomp$w &$ ; NINE xmlines@ #- INDEX@#- DISPN LOOP ClrDA2aBad ; ( Menu Display ) DA3OK?NOTIT :: KEYINBUFFER? case SetDA3Bad TURNMENUOFF ( hide menu ) TRUE xmnext! ( init next ) SetThisRow ( Set top row ) MenuRow@ xmrow! ( save top row ) xmlines@ ( Row loop ) #1+_ONE_DO (DO) xmnext@ IT ( Display labels on menu grob [which is hidden] ) :: # 6E # 58 FOURTWO FORTYFOUR TWENTYTWO ZERO ( Label loop ) SEVEN ONE_DO (DO) INDEX@ GETDF DoLabel LOOP ; ( GROB! menu grob on display grob [ABUFF or GBUFF] ) HARDBUFF2 HARDBUFF #ZERO#SEVEN xmlines@ #- INDEX@ #+ #8* GROB! ( Advance MenuRow. ) ( If row raps around to 1 clear menu and flag ) DoNextRow MenuRow@ #1= IT :: FALSE xmnext! CLEARMENU ; LOOP xmrow@ MenuRow! ( restore 1st row ) ( display XMENU and prev/next indicators ) "X" xmrow@ #1<> IT ( TopRow>1? ) :: "\90" &$ ; xmnext@ IT ( more rows? ) :: "\8F" &$ ; THIRTYNINE THIRTYSEVEN FIFTYSIX Blank&GROB! SetDA3Valid ; ClrDAsOK ; ' *** Application Key Handler ***** :: DUP THREE #> case2drop ( non alpha? ) 'DoBadKeyT SWAP THIRTYFIVE #=casedrop ( LSHIFT ) DROPFALSE FORTY #=casedrop ( RSHIFT ) DROPFALSE FORTYFIVE #=casedrop ( ON ) :: #3= caseFALSE ' :: TakeOver TRUE xmexit! ; TRUE ; TWENTYFIVE #=casedrop ( ENTER ) :: ONE ?CaseKeyDef ( do next ) :: TakeOver TWENTYFOUR SetSomeRow ; TWO ?CaseKeyDef ( do prev ) :: TakeOver # FFFE8 SetSomeRow ; DROP' DoFirstRow TRUE ; TWENTYSIX #=casedrop ( +/- ) :: ONE ?CaseKeyDef ( do UpMenu ) :: TakeOver xmpath@ INNERCOMP DUP#0=csedrp DoBadKey #2- UNROT StartMenu getlines@ EVAL {}N xmpath! ClrDAsOK ; TWO ?CaseKeyDef ( do updir ) :: TakeOver UPDIR ; DROP' ( do HomeMenu ) :: TakeOver xmpath@ DUPNULL{}? casedrop DoBadKey NULL{} xmpath! INNERCOMP #2- NDROP StartMenu getlines@ EVAL ClrDAsOK ; TRUE ; DUP TWENTYFIVE #> case2drop ( key<25? ) 'DoBadKeyT #1- SIX #/ SWAP#1+SWAP #6* xmrow@ SWAPOVER #+DUP ( STACK: #plane, #menukey[1-6], #oldrow, #newrow, #newrow ) MenuRow! SetThisRow MenuRow@ #<>case ( row not defined, restore old row and DoBadKey ) :: MenuRow! 2DROP 'DoBadKeyT ; DROPSWAP ' TakeOver UNROT ( add 'Takeover' to top ) domnukey@ FOUR ::N ( Build secondary ) TRUE ************************************************************ ** ** THIS NEXT SECTION IS OPTIONAL. IF YOU WOULD LIKE TO USE ** IT THEN UNCOMMMENT THE LINES OF CODE. ** ** The following code toggles the label of the menu key ** that was pressed by inverting it twice. It uses the ** fact that three [#key/#plane] sets are really on the ** stack when the key handler is called, although the key ** handler must consume only the bottom pair and leave the ** top two alone. 4PICK on the first line of code gets the ** #key from the second [#key/#plane] set. * * * HARDBUFF 4PICK * #1- SIX #/ SWAP TWENTYTWO #* * SWAP #8* THIRTYTHREE #+ THREE NDUP * OVER TWENTYONE #+ OVER SEVEN #+ SUBGROB * FOUR NDUP INVGROB 4UNROLL GROB! * SLOW SLOW INVGROB 4UNROLL GROB! ************************************************************ ; TrueTrue FALSE ONEFALSE' 1GETLAM 'ERRJMP POLSetUI ClrDAsOK POLKeyUI ABND MenuDef@ MenuRow@ ( push appl. menu_info ) ; ERRTRAP POLResUI&Err POLRestoreUI StartMenu ( set last appl. menu ) DispMenu SHRINKVDISP ( display menu, resize ABUFF ) ClrDAsOK SetDA2aBad ;