home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / sys / handheld / 2592 < prev    next >
Encoding:
Internet Message Format  |  1992-12-17  |  13.0 KB
  1. From: akcs.softcalc@hpcvbbs.cv.hp.com (brian maguire)
  2. Date: Thu, 17 Dec 1992 18:40:03 GMT
  3. Subject: XMENU.S - source code to XMENU
  4. Message-ID: <2b30bebd.5045comp.sys.handhelds@hpcvbbs.cv.hp.com>
  5. Path: sparky!uunet!cs.utexas.edu!sdd.hp.com!hpscit.sc.hp.com!cupnews0.cup.hp.com!news1.boi.hp.com!hp-pcd!hpcvra!rnews!hpcvbbs!akcs.softcalc
  6. Newsgroups: comp.sys.handhelds
  7. Lines: 351
  8.  
  9.         TITLE Expanded Menus, Version 1.02
  10. **** xmenu.s ***********************************************
  11. **
  12. ** File:    Version 1.02, 12/12/92
  13. ** Author:  Brian Maguire
  14. **
  15. ************************************************************
  16. **                                                        **
  17. **              XMENU - Menu Expander 1.02                **
  18. **                                                        **
  19. **             Copyright 1992 Brian Maguire               **
  20. **                  All Right Reserved                    **
  21. **                                                        **
  22. ************************************************************
  23. **
  24. ** This is the source code file for XMENU.  for a complete
  25. ** description please refer to the doc file.
  26. **
  27. ************************************************************
  28. RPL
  29. ************************************************************
  30. * Unfrozen entries
  31. ************************************************************
  32.  
  33. ASSEMBLE
  34. =SetDA3Bad      EQU     #394F9
  35. =MenuDef@       EQU     #418A4
  36. =SHRINKVDISP    EQU     #130CA
  37. RPL
  38.  
  39. ************************************************************
  40. * Local lambda definitions
  41. ************************************************************
  42.  
  43. DEFINE  getlines@       7GETLAM ( sub-routine : -> MenuLines )
  44. DEFINE  domnukey@       6GETLAM ( menu key eval. sub-routine )
  45. DEFINE  xmlines@        5GETLAM ( # of disp lines for menu )
  46. DEFINE  xmrow@  4GETLAM ( first menu row of page )
  47. DEFINE  xmpath@ 3GETLAM ( menu path used by UP )
  48. DEFINE  xmnext@ 2GETLAM ( more rows below? )
  49. DEFINE  xmexit@ 1GETLAM ( exit flag )
  50.  
  51. DEFINE  getlines!       7PUTLAM
  52. DEFINE  domnukey!       6PUTLAM
  53. DEFINE  xmlines!        5PUTLAM
  54. DEFINE  xmrow!  4PUTLAM
  55. DEFINE  xmpath! 3PUTLAM
  56. DEFINE  xmnext! 2PUTLAM
  57. DEFINE  xmexit! 1PUTLAM
  58.  
  59. ************************************************************
  60.  
  61.  
  62. NULLNAME XMENU  ( -->  )
  63.  
  64. ::
  65.  
  66.         CK0
  67.         POLSaveUI ERRSET
  68.         ::
  69.  
  70. **  Sub-routine to set MenuLines.  If the menu data is not a 
  71. **  list then default to  4.
  72.  
  73.         '
  74.         ::
  75.                 MenuDef@ EVAL           ( return menu data )
  76.                 DUPTYPELIST?
  77.                 ITE
  78.                         ::
  79.                                 LENCOMP #1- SIX #/ SWAPDROP #1+
  80.                                 FOUR #MIN
  81.                         ;
  82.                         :: DROP FOUR ;
  83.                 xmlines!
  84.         ;
  85.  
  86. ** This sub-routine is stored in 4LAM to reduce the size and
  87. ** speed up the key handler.  It also make the source file 
  88. ** more readable
  89. ** STACK ON INPUT:  #key #plane 
  90.  
  91.         '               ( define menu key evaluator sub-program )
  92.                 ::
  93.                         SetDA2aBad
  94.  
  95. ************************************************************
  96. **
  97. **  Including this section of code will cause XMENU to exit 
  98. **  when a key is pressed that is assigned to a menu label.
  99. **  Leaving this section commented will force XMENU to exit 
  100. **  only when [ON] is pressed.
  101. *
  102. *                       TRUE xmexit!
  103. *
  104. ************************************************************
  105.  
  106.  
  107. ( get and eval keyob )
  108.  
  109.                         MenuDef@ MenuRow@       ( cache old MenuInfo )
  110.                         { NULLLAM NULLLAM }
  111.                         BIND
  112.                         Key>StdKeyOb            ( Get keyob and eval )
  113.                         EVAL
  114.                         2GETLAM 1GETABND        ( push old menu info )
  115.  
  116. ( compare old and new menus )
  117.  
  118.                         OVER MenuDef@ EQUAL ( old/new menu same? )
  119.                         NOTcasedrop             ( no, add to path )
  120.                         ::
  121.                                 xmpath@ INNERCOMP
  122.                                 get1 SWAP#1+            ( add old MenuDef
  123. )
  124.                                 xmrow@ SWAP#1+          ( add old menu
  125. row )
  126.                                 {}N xmpath!
  127.                                 getlines@ EVAL          ( init MenuLines
  128. )
  129.                         ;
  130.                         SWAPDROP MenuRow@ EQUAL ( old/new row same? )
  131.                         NOT?SEMI                        ( rows dif, then
  132. SEMI )
  133.                         xmrow@ MenuRow! ( restore first MenuRow )
  134.  
  135.                 ;
  136.  
  137.                 FOUR
  138.                 ONE NULL{} FalseFalse
  139.                 {
  140.                         NULLLAM NULLLAM NULLLAM NULLLAM
  141.                         NULLLAM NULLLAM NULLLAM
  142.                 }
  143.                 BIND
  144.  
  145.  
  146.                 getlines@ EVAL                  ( init MenuLines )
  147.                 ONE MenuRow!                            ( init MenuRow )
  148.  
  149.  
  150.                 '
  151.  
  152. *** Application Display Routine ****
  153.  
  154.                 ::
  155.                         TOADISP                 ( force ABUFF )
  156.  
  157. ( Status Display )
  158.  
  159.                         DA1OK?NOTIT ?DispStatus
  160.  
  161. ( Stack Display )
  162.  
  163.                         DA2aOK?NOTIT
  164.                                 ::
  165.                                         KEYINBUFFER? case SetDA2aBad
  166.                                         NINETEEN !DcompWidth
  167.                                         SIX xmlines@ #-
  168.                                         #1+_ONE_DO (DO)
  169.                                                 INDEX@ #:>$
  170.                                                 DEPTH #1- INDEX@ #< ?SKIP
  171.                                                 ::
  172.                                                         INDEX@ #1+PICK 
  173.                                                         1stkdecomp$w &$
  174.                                                 ;
  175.                                                 NINE xmlines@ #- INDEX@#-
  176.  
  177.                                                 DISPN
  178.                                         LOOP
  179.                                         ClrDA2aBad
  180.                                 ;
  181.  
  182. ( Menu Display )
  183.  
  184.                         DA3OK?NOTIT
  185.                         ::
  186.                                 KEYINBUFFER? case SetDA3Bad
  187.                                 TRUE xmnext!            ( init next )
  188.                                 MenuRow@ xmrow!   ( save first MenuRow )
  189.                                 xmlines@
  190.                                 #1+_ONE_DO              ( Row loop )
  191.                                         xmnext@ IT
  192.  
  193. ( Display labels on menu grob [which is hidden] )
  194.  
  195.                                         ::
  196.  
  197.                                                 # 6E  # 58 FOURTWO
  198. FORTYFOUR
  199.                                                 TWENTYTWO ZERO
  200.                                                 SEVEN ONE_DO    ( Label
  201. loop )
  202.                                                         INDEX@ GETDF
  203. DoLabel
  204.                                                 [LOOP]
  205.                                         ;
  206.  
  207. ( GROB! menu grob on display grob [ABUFF or GBUFF] )
  208.  
  209.                                         HARDBUFF2 HARDBUFF
  210.                                         ZERO
  211.                                         SEVEN xmlines@ #- INDEX@ #+ #8*
  212.                                         GROB!
  213.  
  214. ( Advance MenuRow. )
  215. ( If row raps around to 1 clear menu and flag )
  216.  
  217.                                         MenuRow@ #6+ DoNextRow MenuRow@
  218.                                         #<> IT
  219.                                                 :: FALSE xmnext!
  220. CLEARMENU ;
  221.  
  222.                                 [LOOP]
  223.                                 xmrow@ MenuRow! ( restore 1st row )
  224.  
  225. ( display XMENU and prev/next indicators )
  226.  
  227.                                 "X"
  228.                                 xmrow@ #1<> IT          ( TopRow>1? )
  229.                                         :: "\90" &$ ;
  230.                                 xmnext@ IT              ( more rows? )
  231.                                          :: "\8F" &$ ;
  232.                                 THIRTYNINE THIRTYSEVEN FIFTYSIX
  233.                                 Blank&GROB!
  234.                                 SetDA3Valid
  235.                         ;
  236.                         ClrDAsOK
  237.                 ;
  238.  
  239.                 '
  240. *** Applacation Key Handler *****
  241.  
  242.                 ::
  243.  
  244.                         DUP THREE #> case2drop  ( non alpha? )
  245.                                 'DoBadKeyT
  246.                         SWAP
  247.                         THIRTYFIVE #=casedrop                   ( LSHIFT
  248. )
  249.                                 :: DROPFALSE ;
  250.                         FORTY #=casedrop                                (
  251. RSHIFT )
  252.                                 :: DROPFALSE ;
  253.                         FORTYFIVE #=casedrop                    ( ON )
  254.                                 :: #3= caseFALSE
  255.                                         '
  256.                                         :: TakeOver TRUE xmexit! ;
  257.                                         TRUE
  258.                                 ;
  259.                         TWENTYFIVE #=casedrop                   ( ENTER )
  260.                                 ::
  261.                                         ONE ?CaseKeyDef ( do next )
  262.                                                 ::      TakeOver
  263.                                                         TWENTYFOUR
  264. SetSomeRow
  265.                                                 ;
  266.                                         TWO ?CaseKeyDef ( do prev )
  267.                                                 ::      TakeOver
  268.                                                         # FFFE8
  269. SetSomeRow
  270.                                                 ;
  271.  
  272.                                         DROP' DoFirstRow TRUE
  273.                                 ;
  274.                         TWENTYSIX #=casedrop                    ( +/- )
  275.                                 ::
  276.                                         ONE ?CaseKeyDef ( do UpMenu )
  277.                                                 ::      TakeOver
  278.                                                         xmpath@ INNERCOMP
  279.  
  280.                                                         DUP#0=csedrp
  281. DoBadKey
  282.                                                         #2- UNROT
  283. StartMenu
  284.                                                         getlines@ EVAL
  285.                                                         {}N xmpath!
  286.                                                 ;
  287.                                         TWO ?CaseKeyDef ( do updir )
  288.                                                 :: TakeOver UPDIR ;
  289.  
  290.                                         DROP'                   ( do
  291. HomeMenu )
  292.                                                 ::      TakeOver xmpath@
  293.                                                         DUPNULL{}?
  294. casedrop 
  295.                                                                 DoBadKey
  296.                                                         NULL{} xmpath!
  297.                                                         INNERCOMP #2-
  298. NDROP
  299.                                                         StartMenu
  300.                                                 ;
  301.                                         TRUE
  302.                                 ;
  303.                         DUP TWENTYFIVE #> case2drop     ( key<25 )
  304.                                 'DoBadKeyT
  305.  
  306.                         #1- SIX #/ SWAP#1+SWAP
  307.                         #6* xmrow@ SWAPOVER #+
  308.  
  309. ( STACK: #plane, #menukey[1-6], #oldrow, #newrow )
  310.  
  311.                         DUP MenuRow! SetThisRow
  312.                         MenuRow@ #<>case                ( row not defined
  313. )
  314.                                 :: MenuRow! 2DROP 'DoBadKeyT ;
  315.                         DROPSWAP
  316.                         domnukey@ THREE ::N
  317.                         TRUE
  318.  
  319. ************************************************************
  320. **
  321. **  THIS NEXT SECTION IS OPTIONAL.  IF YOU WOULD LIKE TO USE 
  322. **  IT THEN UNCOMMMENT THE LINES OF CODE.
  323. **
  324. **  The following code toggles the label of the menu key 
  325. **  that was pressed by inverting it twice.  It uses the 
  326. **  fact that three [#key/#plane] sets are really on the 
  327. **  stack when the key handler is called, although the key 
  328. **  handler must consume only the bottom pair and leave the 
  329. **  top two alone.  4PICK on the first line of code gets the 
  330. **  #key from the second [#key/#plane] set.
  331.  
  332.  
  333. *                       HARDBUFF 4PICK 
  334. *                       #1- SIX #/ SWAP TWENTYTWO #*
  335. *                       SWAP #8* THIRTYTHREE #+ THREE NDUP
  336. *                       OVER TWENTYONE #+ OVER SEVEN #+ SUBGROB
  337. *                       FOUR NDUP INVGROB 4UNROLL GROB!
  338. *                       SLOW SLOW INVGROB 4UNROLL GROB!
  339.  
  340. ************************************************************
  341.  
  342.                 ;
  343.  
  344.                 TrueTrue FALSE ONEFALSE
  345.                 ' 1GETLAM 'ERRJMP
  346.                 POLSetUI ClrDAsOK
  347.                 TURNMENUOFF                             ( hide menu )
  348.                 POLKeyUI
  349.                 ABND
  350.                 MenuDef@ MenuRow@               ( push appl. menu_info )
  351.         ;
  352.         ERRTRAP
  353.         POLResUI&Err POLRestoreUI
  354.         StartMenu                                       ( set last appl.
  355. menu )
  356.         DispMenu SHRINKVDISP    ( display menu, resize ABUFF )
  357.         ClrDAsOK SetDA2aBad
  358. ;
  359.  
  360.  
  361.