home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / comp / sys / handheld / 2631 < prev    next >
Encoding:
Internet Message Format  |  1992-12-30  |  14.6 KB
  1. Path: sparky!uunet!gossip.pyramid.com!olivea!charnel!rat!usc!sdd.hp.com!hp-cv!hp-pcd!hpcvra!rnews!hpcvbbs!akcs.softcalc
  2. From: akcs.softcalc@hpcvbbs.cv.hp.com (brian maguire)
  3. Newsgroups: comp.sys.handhelds
  4. Subject: HP48: XMENU.S version 1.03 (source listi
  5. Message-ID: <2b41d595.5071comp.sys.handhelds@hpcvbbs.cv.hp.com>
  6. Date: 30 Dec 92 17:40:04 GMT
  7. Lines: 428
  8.  
  9.  
  10.      TITLE Expanded Menus, Version 1.03
  11. **** xmenu.s ***********************************************
  12. **
  13. ** File:    Version 1.03, 12/29/92
  14. ** Author:  Brian Maguire
  15. **
  16. ************************************************************
  17. **                                                        **
  18. **              XMENU - Menu Expander 1.03                **
  19. **                                                        **
  20. **             Copyright 1992 Brian Maguire               **
  21. **                  All Right Reserved                    **
  22. **                                                        **
  23. ************************************************************
  24. *
  25. * DISCLAIMERS
  26. *
  27. * XMENU is presented without warranties, expressed or
  28. * implied.  The author makes no guarantee as to the fitness
  29. * of this software.
  30. *
  31. * XMENU can be copied freely provided the software is copied
  32. * in its entirety.  The user cannot be charged, in whole or
  33. * in part, except for the cost of reproduction.  No part of
  34. * this package may be used for commercial purposes or as
  35. * part of third party software (commercial or public),
  36. * without written permission from the author.
  37. *
  38. ************************************************************
  39. *
  40. * ACKNOWLEDGEMENTS:
  41. *
  42. *  Thanks to Conan J. Fee whose XPNDR program inspired me to
  43. *  finish writing XMENU and Detlef Muller for his
  44. *  participation in writing XPNDR.
  45. *
  46. *  Also, thanks to Todd Eckrich for his help in debugging.
  47. *
  48. ************************************************************
  49. *
  50. * The expanded menu program displays a menu using as many as
  51. * four rows at a time with the top four rows of keys
  52. * corresponding to each row of menu labels.  This will
  53. * normally be enough to display all rows of a built-in menu.
  54. * If a menu contains more than four rows, a scroll indicator
  55. * will be displayed in the status area.  Pressing ENTER will
  56. * advance the menu screen one page.  Likewise, [ORANGE]-
  57. * ENTER will decrement the menu screen one page.
  58. *
  59. * Pressing a key in the top four rows that corresponds to a
  60. * menu label will immediately evaluate that menu item.
  61. * Pressing any non-menu key will cause the 48 to beep.
  62. * Pressing [ON] exits XMENU.
  63. *
  64. * Menu tree structures are supported.  When a menu key
  65. * creates a different menu, it is nested below the parent
  66. * menu.  Pressing [+/] will exit the sub-menu and restore
  67. * the calling parent menu.  Likewise, pressing [BLUE]-[+/-]
  68. * will exit all sub-menus and restore the top most menu.
  69. *
  70. * Because the VAR menu is unique in the fact that the
  71. * contents of the menu can change by moving into a sub-
  72. * directory, but the menu definition doesn't actually
  73. * change, UPDIR has been assigned to [ORANGE]-[+/-].
  74. *
  75. * In addition to the menu display, XMENU also displays as
  76. * many line of the stack as possible using the medium font
  77. * size.  A total of six lines are used for both the menu and
  78. * stack.  If the menu only uses two lines, four will be used
  79. * for the stack.
  80. *
  81. * Most menus are defined by a list or a program that
  82. * generates a list.  This data list is used by the built-in
  83. * menu commands to load the touch table (menu key bindings).
  84. * But several menus, like the VAR menu, are defined by a
  85. * list.  Instead, they load the touch table themselves, on
  86. * the fly.  Because it is difficult to determine how many
  87. * display lines will be needed for these menus, XMENU always
  88. * allocates four.  The only built-in menus that are forced
  89. * to four display lines are VAR, LIBRARY, PORT0, PORT1,
  90. * PORT2, and any library menu.
  91. *
  92. * The following criteria was used when writing this program
  93. *
  94. * 1) Self contained
  95. *    XMENU had to be a self standing program, not a library
  96. *    or a directory.
  97. *
  98. * 2) Minimal amount of time writing
  99. *    I don't really have much free time so I tried to keep
  100. *    it simply.  Very little time was spend trying to pack
  101. *    the code.  I did try to document it enough so someone
  102. *    who is familiar with RPL can follow it though.
  103. *
  104. ************************************************************
  105. *
  106. * Bug reports, comments, or questions can be sent to the
  107. * following internet address..
  108. *
  109. *    Before 2-01-92  brian_maguire@mts.cc.wayne.edu
  110. *    After  2-01-92  brian@sparcom.com
  111. *
  112. * or, to the following HPBBS address...
  113. *
  114. *    akcs.softcalc
  115. *
  116. ************************************************************
  117. RPL
  118. ************************************************************
  119. * Unfrozen entries
  120. ************************************************************
  121. *
  122. * The following entries have not changed in ROM versions
  123. * A-J.  Since they are unfrozen, it is possible that they
  124. * will be moved in future ROM versions.
  125.  
  126. ASSEMBLE
  127. =SetDA3Bad     EQU  #394F9
  128. =MenuDef@      EQU  #418A4
  129. =SHRINKVDISP   EQU  #130CA
  130. RPL
  131.  
  132. ************************************************************
  133. * Local lambda definitions
  134. ************************************************************
  135.  
  136. DEFINE    getlines@ 7GETLAM   ( sub-routine : -> MenuLines )
  137. DEFINE    domnukey@ 6GETLAM   ( menu key eval. sub-routine )
  138. DEFINE    xmlines@  5GETLAM   ( # of disp lines for menu )
  139. DEFINE    xmrow@    4GETLAM   ( first menu row of page )
  140. DEFINE    xmpath@   3GETLAM   ( menu path used by UP )
  141. DEFINE    xmnext@   2GETLAM   ( more rows below? )
  142. DEFINE    xmexit@   1GETLAM   ( exit flag )
  143.  
  144. DEFINE    getlines! 7PUTLAM
  145. DEFINE    domnukey! 6PUTLAM
  146. DEFINE    xmlines!  5PUTLAM
  147. DEFINE    xmrow!    4PUTLAM
  148. DEFINE    xmpath!   3PUTLAM
  149. DEFINE    xmnext!   2PUTLAM
  150. DEFINE    xmexit!   1PUTLAM
  151.  
  152. ************************************************************
  153.  
  154. NULLNAME XMENU ( -->  )
  155.  
  156. ::
  157.      CK0
  158.      POLSaveUI ERRSET
  159.      ::
  160.  
  161. **  Sub-routine to set MenuLines.  If the menu data is not a
  162. **  list then default to  4.
  163.  
  164.      '
  165.      ::
  166.           DoFirstRow
  167.           MenuDef@ EVAL       ( return menu data )
  168.           DUPTYPELIST?
  169.           ITE
  170.                ::
  171.                     LENCOMP #1- SIX #/ SWAPDROP #1+
  172.                     FOUR #MIN
  173.                ;
  174.                :: DROP FOUR ;
  175.           xmlines!
  176.      ;
  177.  
  178. ** This sub-routine is stored in 4LAM to reduce the size and
  179. ** speed up the key handler.  It also make the source file
  180. ** more readable
  181. ** STACK ON INPUT:  #key #plane
  182.  
  183.      '         ( define menu key evaluator sub-program )
  184.           ::
  185.                SetDA2aBad
  186.  
  187. ************************************************************
  188. **
  189. **  Including this section of code will cause XMENU to exit
  190. **  when a key is pressed that is assigned to a menu label.
  191. **  Leaving this section commented will force XMENU to exit
  192. **  only when [ON] is pressed.
  193. *
  194. *              TRUE xmexit!
  195. *
  196. ************************************************************
  197.  
  198. ( get and eval keyob )
  199.  
  200.                MenuDef@ MenuRow@   ( cache old MenuInfo )
  201.                { NULLLAM NULLLAM }
  202.                BIND
  203.                Key>StdKeyOb        ( Get keyob and eval )
  204.                EVAL
  205.                2GETLAM 1GETABND    ( push old menu info )
  206.  
  207. ( compare old and new menus )
  208.  
  209.                OVER MenuDef@ EQUAL ( old/new menu same? )
  210.                NOTcasedrop         ( no, add to path )
  211.                ::
  212.                     xmpath@ INNERCOMP
  213.                     get1 SWAP#1+        ( add old MenuDef )
  214.                     xmrow@ SWAP#1+      ( add old menu row )
  215.                     {}N xmpath!
  216.                     getlines@ EVAL      ( init MenuLines )
  217.                     ClrDAsOK       ( flag display refresh )
  218.                ;
  219.                SWAPDROP MenuRow@ EQUAL ( old/new row same? )
  220.                NOT?SEMI            ( rows dif, then SEMI )
  221.                xmrow@ MenuRow!     ( restore first MenuRow )
  222.  
  223.           ;
  224.  
  225.           FOUR
  226.           ONE NULL{} FalseFalse
  227.           {
  228.                NULLLAM NULLLAM NULLLAM NULLLAM
  229.                NULLLAM NULLLAM NULLLAM
  230.           }
  231.           BIND
  232.  
  233.  
  234.           ONE MenuRow!             ( init MenuRow )
  235.           getlines@ EVAL           ( init MenuLines )
  236.  
  237.  
  238.           '
  239.  
  240. *** Application Display Routine ****
  241.  
  242.           ::
  243.                TOADISP             ( force ABUFF )
  244.  
  245. ( Status Display )
  246.  
  247.                DA1OK?NOTIT ?DispStatus
  248.  
  249. ( Stack Display )
  250.  
  251.                DA2aOK?NOTIT
  252.                     ::
  253.                          KEYINBUFFER? case SetDA2aBad
  254.                          NINETEEN !DcompWidth
  255.                          SIX xmlines@ #-
  256.                          #1+_ONE_DO (DO)
  257.                               INDEX@ #:>$
  258.                               DEPTH #1- INDEX@ #< ?SKIP
  259.                               ::
  260.                                    INDEX@ #1+PICK
  261.                                    1stkdecomp$w &$
  262.                               ;
  263.                               NINE xmlines@ #- INDEX@#-
  264.                               DISPN
  265.                          LOOP
  266.                          ClrDA2aBad
  267.                     ;
  268.  
  269. ( Menu Display )
  270.  
  271.                DA3OK?NOTIT
  272.                ::
  273.                     KEYINBUFFER? case SetDA3Bad
  274.                     TURNMENUOFF         ( hide menu )
  275.                     TRUE xmnext!        ( init next )
  276.                     SetThisRow          ( Set top row )
  277.                     MenuRow@ xmrow!   ( save top row )
  278.                     xmlines@
  279. ( Row loop )
  280.                     #1+_ONE_DO (DO)
  281.                          xmnext@ IT
  282.  
  283. ( Display labels on menu grob [which is hidden] )
  284.  
  285.                          ::
  286.                               # 6E  # 58 FOURTWO FORTYFOUR
  287.                               TWENTYTWO ZERO
  288. ( Label loop )
  289.                               SEVEN ONE_DO (DO)
  290.                                    INDEX@ GETDF DoLabel
  291.                               LOOP
  292.                          ;
  293.  
  294. ( GROB! menu grob on display grob [ABUFF or GBUFF] )
  295.  
  296.                          HARDBUFF2 HARDBUFF
  297.                          #ZERO#SEVEN
  298.                          xmlines@ #- INDEX@ #+ #8*
  299.                          GROB!
  300.  
  301. ( Advance MenuRow. )
  302. ( If row raps around to 1 clear menu and flag )
  303.  
  304.                          DoNextRow MenuRow@ #1= IT
  305.                               :: FALSE xmnext! CLEARMENU ;
  306.  
  307.                     LOOP
  308.                     xmrow@ MenuRow!     ( restore 1st row )
  309.  
  310. ( display XMENU and prev/next indicators )
  311.  
  312.                     "X"
  313.                     xmrow@ #1<> IT      ( TopRow>1? )
  314.                          :: "\90" &$ ;
  315.                     xmnext@ IT          ( more rows? )
  316.                           :: "\8F" &$ ;
  317.                     THIRTYNINE THIRTYSEVEN FIFTYSIX
  318.                     Blank&GROB!
  319.                     SetDA3Valid
  320.                ;
  321.                ClrDAsOK
  322.           ;
  323.  
  324.           '
  325. *** Applacation Key Handler *****
  326.  
  327.           ::
  328.  
  329.                DUP THREE #> case2drop   ( non alpha? )
  330.                     'DoBadKeyT
  331.                SWAP
  332.                THIRTYFIVE #=casedrop              ( LSHIFT )
  333.                     DROPFALSE
  334.                FORTY #=casedrop                   ( RSHIFT )
  335.                     DROPFALSE
  336.                FORTYFIVE #=casedrop               ( ON )
  337.                     :: #3= caseFALSE
  338.                          '
  339.                          :: TakeOver TRUE xmexit! ;
  340.                          TRUE
  341.                     ;
  342.                TWENTYFIVE #=casedrop              ( ENTER )
  343.                     ::
  344.                          ONE ?CaseKeyDef     ( do next )
  345.                               ::   TakeOver
  346.                                    TWENTYFOUR SetSomeRow
  347.                               ;
  348.                          TWO ?CaseKeyDef     ( do prev )
  349.                               ::   TakeOver
  350.                                    # FFFE8 SetSomeRow
  351.                               ;
  352.  
  353.                          DROP' DoFirstRow TRUE
  354.                     ;
  355.                TWENTYSIX #=casedrop               ( +/- )
  356.                     ::
  357.                          ONE ?CaseKeyDef     ( do UpMenu )
  358.                               ::   TakeOver
  359.                                    xmpath@ INNERCOMP
  360.                                    DUP#0=csedrp DoBadKey
  361.                                    #2- UNROT StartMenu
  362.                                    getlines@ EVAL
  363.                                    {}N xmpath!
  364.                                    ClrDAsOK
  365.                               ;
  366.                          TWO ?CaseKeyDef     ( do updir )
  367.                               :: TakeOver UPDIR ;
  368.  
  369.                          DROP'               ( do HomeMenu )
  370.                               ::   TakeOver xmpath@
  371.                                    DUPNULL{}? casedrop
  372.                                         DoBadKey
  373.                                    NULL{} xmpath!
  374.                                    INNERCOMP #2- NDROP
  375.                                    StartMenu
  376.                                    getlines@ EVAL
  377.                                    ClrDAsOK
  378.                               ;
  379.                          TRUE
  380.                     ;
  381.                DUP TWENTYFIVE #> case2drop   ( key<25? )
  382.                     'DoBadKeyT
  383.  
  384.                #1- SIX #/ SWAP#1+SWAP
  385.                #6* xmrow@ SWAPOVER #+DUP
  386.  
  387. ( STACK: #plane, #menukey[1-6], #oldrow, #newrow, #newrow )
  388.  
  389.                MenuRow! SetThisRow
  390.                MenuRow@ #<>case
  391.  
  392. ( row not defined, restore old row and DoBadKey )
  393.  
  394.                     :: MenuRow! 2DROP 'DoBadKeyT ;
  395.                DROPSWAP
  396.                ' TakeOver UNROT    ( add 'Takeover' to top )
  397.                domnukey@ FOUR ::N  ( Build secondary )
  398.                TRUE
  399.  
  400. ************************************************************
  401. **
  402. **  THIS NEXT SECTION IS OPTIONAL.  IF YOU WOULD LIKE TO USE
  403. **  IT THEN UNCOMMMENT THE LINES OF CODE.
  404. **
  405. **  The following code toggles the label of the menu key
  406. **  that was pressed by inverting it twice.  It uses the
  407. **  fact that three [#key/#plane] sets are really on the
  408. **  stack when the key handler is called, although the key
  409. **  handler must consume only the bottom pair and leave the
  410. **  top two alone.  4PICK on the first line of code gets the
  411. **  #key from the second [#key/#plane] set.
  412. *
  413. *
  414. *              HARDBUFF 4PICK
  415. *              #1- SIX #/ SWAP TWENTYTWO #*
  416. *              SWAP #8* THIRTYTHREE #+ THREE NDUP
  417. *              OVER TWENTYONE #+ OVER SEVEN #+ SUBGROB
  418. *              FOUR NDUP INVGROB 4UNROLL GROB!
  419. *              SLOW SLOW INVGROB 4UNROLL GROB!
  420.  
  421. ************************************************************
  422.  
  423.           ;
  424.  
  425.           TrueTrue FALSE ONEFALSE'
  426.           1GETLAM 'ERRJMP
  427.           POLSetUI ClrDAsOK
  428.           POLKeyUI
  429.           ABND
  430.           MenuDef@ MenuRow@        ( push appl. menu_info )
  431.      ;
  432.      ERRTRAP
  433.      POLResUI&Err POLRestoreUI
  434.      StartMenu                     ( set last appl. menu )
  435.      DispMenu SHRINKVDISP     ( display menu, resize ABUFF )
  436.      ClrDAsOK SetDA2aBad
  437. ;
  438.