home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / tipi / menu.tpi < prev    next >
Text File  |  1993-11-06  |  2KB  |  89 lines
  1. # MENU.TPI
  2. # by Kent Peterson
  3. # This program demonstrates a technique for making
  4. # Menus
  5.  
  6.  
  7. defvar menuitems
  8. defvar menuchoice
  9. defvar menurow
  10. defvar menucol
  11. defstr menuchoice$
  12.  
  13. define placepointer
  14.  menurow fetch menuchoice fetch + 1 - menucol fetch locate
  15. enddef
  16.  
  17. define clearpointer
  18.  placepointer "   " print$
  19. enddef
  20.  
  21. define drawpointer
  22.  placepointer 205 chr$ 16 chr$ +$ " " +$ print$
  23. enddef
  24.  
  25. define choice+
  26.  clearpointer
  27.  menuchoice fetch 1 + menuitems fetch
  28.  min menuchoice store
  29.  drawpointer
  30. enddef
  31.  
  32. define choice-
  33.  clearpointer
  34.  menuchoice fetch 1 - 1
  35.  max menuchoice store
  36.  drawpointer
  37. enddef
  38.  
  39. define menu (  -- choice )
  40.             ( menustring$ -- choice$ )
  41. # choice is set to 0 if ESC is pressed,
  42. # number of menu choice if ENTER is pressed.
  43. # The up and down arrow keys move the cursor
  44.  0 cursor
  45.  row menurow store       # save the menu row
  46.  column menucol store    #      and column
  47.  menuitems fetch
  48.  do
  49.   menuitems fetch index  - 1 + # counts up
  50.   menurow fetch + 1 - menucol fetch locate
  51.   "   " print$ index pick$ print$
  52.  loop
  53.  drawpointer
  54.  begin
  55.   begin
  56.    key dup if dup endif
  57.   until
  58.   case 13 of 1                      endof   # return
  59.        27 of 1 0 menuchoice store   endof   # escape
  60.       328 of 0 choice-              endof   # up
  61.       336 of 0 choice+              endof   # down
  62.       default 0
  63.   endcase
  64.  until
  65.  menuchoice fetch dup
  66.  if menuitems fetch swap - 1 + pick$ else drop "" endif
  67.  menuchoice$ store
  68.  menuitems fetch
  69.  do drop$ loop
  70.  menuchoice fetch
  71.  menuchoice$ fetch
  72.  1 cursor
  73. enddef
  74.  
  75. 4 menuitems store
  76. 1 menuchoice store
  77. "Edit"
  78. "Lookup"
  79. "Run"
  80. "Quit"
  81. 0 0 locate
  82. cls
  83. menu
  84. 5 0 locate
  85. print " " print$ print$ cr
  86. begin key until
  87.  
  88.  
  89.