Newsgroups: comp.sys.handhelds

        TITLE Expanded Menus, Version 1.02
**** xmenu.s ***********************************************
**
** File:    Version 1.02, 12/12/92
** Author:  Brian Maguire
**
************************************************************
**                                                        **
**              XMENU - Menu Expander 1.02                **
**                                                        **
**             Copyright 1992 Brian Maguire               **
**                  All Right Reserved                    **
**                                                        **
************************************************************
**
** This is the source code file for XMENU.  for a complete
** description please refer to the doc file.
**
************************************************************
RPL
************************************************************
* Unfrozen entries
************************************************************
 
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.
 
        '
        ::
                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
)
                        ;
                        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
 
 
                getlines@ EVAL                  ( init MenuLines )
                ONE MenuRow!                            ( init MenuRow )
 
 
                '
 
*** 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
                                TRUE xmnext!            ( init next )
                                MenuRow@ xmrow!   ( save first MenuRow )
                                xmlines@
                                #1+_ONE_DO              ( Row loop )
                                        xmnext@ IT
 
( Display labels on menu grob [which is hidden] )
 
                                        ::
 
                                                # 6E  # 58 FOURTWO
FORTYFOUR
                                                TWENTYTWO ZERO
                                                SEVEN ONE_DO    ( Label
loop )
                                                        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 )
 
                                        MenuRow@ #6+ DoNextRow MenuRow@
                                        #<> 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
                ;
 
                '
*** Applacation 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!
                                                ;
                                        TWO ?CaseKeyDef ( do updir )
                                                :: TakeOver UPDIR ;
 
                                        DROP'                   ( do
HomeMenu )
                                                ::      TakeOver xmpath@
                                                        DUPNULL{}?
casedrop 
                                                                DoBadKey
                                                        NULL{} xmpath!
                                                        INNERCOMP #2-
NDROP
                                                        StartMenu
                                                ;
                                        TRUE
                                ;
                        DUP TWENTYFIVE #> case2drop     ( key<25 )
                                'DoBadKeyT
 
                        #1- SIX #/ SWAP#1+SWAP
                        #6* xmrow@ SWAPOVER #+
 
( STACK: #plane, #menukey[1-6], #oldrow, #newrow )
 
                        DUP MenuRow! SetThisRow
                        MenuRow@ #<>case                ( row not defined
)
                                :: MenuRow! 2DROP 'DoBadKeyT ;
                        DROPSWAP
                        domnukey@ THREE ::N
                        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
                TURNMENUOFF                             ( hide menu )
                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
;
 

From: akcs.softcalc@hpcvbbs.cv.hp.com (brian maguire)
Date: Thu, 17 Dec 1992 18:40:03 GMT
Subject: XMENU - Menu Expander
Message-ID: <2b30bdde.5044comp.sys.handhelds@hpcvbbs.cv.hp.com>