From: akcs.softcalc@hpcvbbs.cv.hp.com (brian maguire)
Newsgroups: comp.sys.handhelds
Subject: HP48: XMENU.S version 1.03 (source listi
Date: 30 Dec 92 17:40:04 GMT


     TITLE Expanded Menus, Version 1.03
**** xmenu.s ***********************************************
**
** File:    Version 1.03, 12/29/92
** Author:  Brian Maguire
**
************************************************************
**                                                        **
**              XMENU - Menu Expander 1.03                **
**                                                        **
**             Copyright 1992 Brian Maguire               **
**                  All Right Reserved                    **
**                                                        **
************************************************************
*
* DISCLAIMERS
*
* XMENU is presented without warranties, expressed or
* implied.  The author makes no guarantee as to the fitness
* of this software.
*
* XMENU can be copied freely provided the software is copied
* in its entirety.  The user cannot be charged, in whole or
* in part, except for the cost of reproduction.  No part of
* this package may be used for commercial purposes or as
* part of third party software (commercial or public),
* without written permission from the author.
*
************************************************************
*
* ACKNOWLEDGEMENTS:
*
*  Thanks to Conan J. Fee whose XPNDR program inspired me to
*  finish writing XMENU and Detlef Muller for his
*  participation in writing XPNDR.
*
*  Also, thanks to Todd Eckrich for his help in debugging.
*
************************************************************
*
* The expanded menu program displays a menu using as many as
* four rows at a time with the top four rows of keys
* corresponding to each row of menu labels.  This will
* normally be enough to display all rows of a built-in menu.
* If a menu contains more than four rows, a scroll indicator
* will be displayed in the status area.  Pressing ENTER will
* advance the menu screen one page.  Likewise, [ORANGE]-
* ENTER will decrement the menu screen one page.
*
* Pressing a key in the top four rows that corresponds to a
* menu label will immediately evaluate that menu item.
* Pressing any non-menu key will cause the 48 to beep.
* Pressing [ON] exits XMENU.
*
* Menu tree structures are supported.  When a menu key
* creates a different menu, it is nested below the parent
* menu.  Pressing [+/] will exit the sub-menu and restore
* the calling parent menu.  Likewise, pressing [BLUE]-[+/-]
* will exit all sub-menus and restore the top most menu.
*
* Because the VAR menu is unique in the fact that the
* contents of the menu can change by moving into a sub-
* directory, but the menu definition doesn't actually
* change, UPDIR has been assigned to [ORANGE]-[+/-].
*
* In addition to the menu display, XMENU also displays as
* many line of the stack as possible using the medium font
* size.  A total of six lines are used for both the menu and
* stack.  If the menu only uses two lines, four will be used
* for the stack.
*
* Most menus are defined by a list or a program that
* generates a list.  This data list is used by the built-in
* menu commands to load the touch table (menu key bindings).
* But several menus, like the VAR menu, are defined by a
* list.  Instead, they load the touch table themselves, on
* the fly.  Because it is difficult to determine how many
* display lines will be needed for these menus, XMENU always
* allocates four.  The only built-in menus that are forced
* to four display lines are VAR, LIBRARY, PORT0, PORT1,
* PORT2, and any library menu.
*
* The following criteria was used when writing this program
*
* 1) Self contained
*    XMENU had to be a self standing program, not a library
*    or a directory.
*
* 2) Minimal amount of time writing
*    I don't really have much free time so I tried to keep
*    it simply.  Very little time was spend trying to pack
*    the code.  I did try to document it enough so someone
*    who is familiar with RPL can follow it though.
*
************************************************************
*
* Bug reports, comments, or questions can be sent to the
* following internet address..
*
*    Before 2-01-92  brian_maguire@mts.cc.wayne.edu
*    After  2-01-92  brian@sparcom.com
*
* or, to the following HPBBS address...
*
*    akcs.softcalc
*
************************************************************
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
          ;
 
          '
*** 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!
                                   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
;
Newsgroups: comp.sys.handhelds