home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP14.EXE / CHP1412.PRG < prev    next >
Encoding:
Text File  |  1991-06-12  |  7.6 KB  |  249 lines
  1. /*
  2.    Listing 14.12 LITE_MENU() Example
  3.    Author: Greg Lief
  4.    Excerpted from "Clipper 5: A Developer's Guide"
  5.    Copyright (c) 1991 M&T Books
  6.                       501 Galveston Drive
  7.                       Redwood City, CA 94063-4728
  8.                       (415) 366-3600
  9. */
  10.  
  11. #include "inkey.ch"
  12. #include "mymenu.ch"  // contains modified @..PROMPT and MENU TO
  13.  
  14.  
  15. #define TEST            // remove this if you don't need the test code
  16.  
  17. //───── begin stub test program
  18.  
  19. #ifdef TEST
  20.  
  21. function main 
  22. local menulist, sel 
  23. cls 
  24. setcolor('w/b, n/bg') 
  25. @ 0, 0 say "Press F1 to see where you are"
  26. set key K_F1 to helpme
  27. do while sel != 0 .and. sel != 7 
  28.    @  9,33 prompt padr('Customers', 14) message 'Add/edit customer data' ; 
  29.            action custfile() 
  30.    @ 10,33 prompt padr('Invoices ', 14) message 'Add/edit invoice data' ; 
  31.            action invfile() 
  32.    @ 11,33 prompt padr('Vendors', 14) message 'Add/edit vendor data' ; 
  33.            action vendorfile() 
  34.    @ 12,33 prompt padr('Reports', 14) action reports() 
  35.    @ 13,33 prompt 'reconci~Liation' action reconcile() 
  36.    @ 14,33 prompt 'Maintenance   '  message "Rebuild indices, backup, etc." ; 
  37.            action maint() 
  38.    @ 15,33 prompt padr('Quit', 14) 
  39.    menu to sel 
  40. enddo 
  41. return nil 
  42.  
  43.  
  44. static function helpme(p, l, v)
  45. output("Proc: " + p + space(5) + "Var: " + v + space(5) + ;
  46.        "Current option: " + substr(v, at('[', v) + 1, 1))
  47. output("Grumpfish Library features excellent context-specific help development!")
  48. return nil 
  49.  
  50. static function custfile 
  51. output("You selected the Customers option") 
  52. return nil 
  53.  
  54.  
  55. static function invfile 
  56. output("You selected the Invoices option") 
  57. return nil 
  58.  
  59.  
  60. static function vendorfile 
  61. output("You selected the Vendors option") 
  62. return nil 
  63.  
  64.  
  65. static function reports 
  66. output("You selected the Reports option") 
  67. return nil 
  68.  
  69.  
  70. static function reconcile 
  71. output("You selected the Reconciliation option") 
  72. return nil 
  73.  
  74.  
  75. static function maint 
  76. output("You selected the Maintenance option") 
  77. return nil 
  78.  
  79.  
  80. static function output(msg) 
  81. @ maxrow(), 0 say padc(msg, maxcol() + 1) color '+gr/r'
  82. inkey(0) 
  83. scroll(maxrow(), 0, maxrow(), maxcol(), 0) 
  84. return nil 
  85.  
  86. #endif
  87.  
  88. //───── end stub test program
  89.  
  90.  
  91.  
  92. //───── these manifest constants are for easy identification
  93. //───── of levels in the multi-dimensional array
  94. #define  ROW             1 
  95. #define  COL             2 
  96. #define  PROMPT          3 
  97. #define  MESSAGE         4 
  98. #define  ACTION          5 
  99.  
  100. /* 
  101.    LITE_MENU() -- alternate menu system 
  102. */ 
  103. function lite_menu(marray, selection, varname) 
  104. local num_elem := len(marray), xx, nkey := 0, triggerltr := [], ; 
  105.       fallout := .f., oldmsgctr := set(_SET_MCENTER, .T.), ptr, ; 
  106.       mess_row := set(_SET_MESSAGE), oldcursor := setcursor(0), ; 
  107.       oldcolor := setcolor(), plaincolor, hilitcolor 
  108.  
  109. //───── if MESSAGE row was never set, use the bottom row of screen
  110. if mess_row == 0
  111.    mess_row := maxrow()
  112. endif 
  113.  
  114. //───── set default colors for unselected and selected options
  115. xx = at(',', oldcolor) 
  116. plaincolor = substr(oldcolor, 1, xx - 1) 
  117. hilitcolor = substr(oldcolor, xx + 1) 
  118.  
  119. /* 
  120.    determine initial highlighted item default to 1 -- also perform 
  121.    error-checking to ensure they didn't specify an invalid selection 
  122. */ 
  123. if selection == NIL .or. (selection < 1 .or. selection > num_elem)
  124.    selection = 1 
  125. endif 
  126.  
  127. // build the string containing available letters for selection 
  128. for xx = 1 to num_elem 
  129.    /* 
  130.       the default is to add the first non-space character. 
  131.       However, if there is a tilde embedded in this menu 
  132.       option, use the letter directly following it. 
  133.    */ 
  134.    if (ptr := at("~", marray[xx, PROMPT]) ) > 0
  135.       triggerltr += upper(substr(marray[xx, PROMPT], ptr + 1, 1)) 
  136.    else 
  137.       triggerltr += upper(left(marray[xx, PROMPT], 1)) 
  138.    endif 
  139.    ShowOption(marray[xx], plaincolor) 
  140. next 
  141. //───── commence main key-grabbing loop
  142. do while nkey != K_ENTER .and. nkey != K_ESC 
  143.    // display current option
  144.    @ marray[selection, ROW], marray[selection, COL] say ; 
  145.                  strtran(marray[selection, PROMPT], "~", "") color hilitcolor
  146.    /* display corresponding message if there is one */ 
  147.    setcolor(plaincolor) 
  148.    if marray[selection, MESSAGE] == NIL 
  149.       scroll(mess_row, 0, mess_row, maxcol(), 0) 
  150.    else 
  151.       @ mess_row, 0 say padc(marray[selection, MESSAGE], maxcol() + 1)
  152.    endif 
  153.    if fallout 
  154.       exit 
  155.    else 
  156.       nkey := inkey(0)
  157.       do case 
  158.  
  159.          /*
  160.             use SETKEY() to see if an action block attached to the last
  161.             keypress -- if it returns anything other than NIL, then you 
  162.             know that the answer is a resounding YES!
  163.          */
  164.          case setkey(nkey) != NIL 
  165.             /*
  166.                pass action block the name of the previous procedure,
  167.                along with the name of the variable referenced in the 
  168.                MENU TO statement and the current highlighted menu 
  169.                option (this means that you can tie a help screen to 
  170.                each individual menu option; try that with MENU TO)
  171.             */
  172.             eval(setkey(nkey), procname(1), procline(1), varname + ; 
  173.                        "[" + ltrim(str(selection)) + "]") 
  174.  
  175.          /* go down one line, observing wrap-around conventions */ 
  176.          case nkey == K_DOWN
  177.             ShowOption(marray[selection], plaincolor) 
  178.             if selection == num_elem
  179.                selection := 1
  180.             else 
  181.                selection++ 
  182.             endif 
  183.  
  184.          /* go up one line, observing wrap-around conventions */ 
  185.          case nkey == K_UP
  186.             ShowOption(marray[selection], plaincolor) 
  187.             if selection == 1
  188.                selection := num_elem
  189.             else 
  190.                selection-- 
  191.             endif 
  192.  
  193.          /* jump to top option */ 
  194.          case nkey == K_HOME
  195.             /* no point in changing color if we're already there */ 
  196.             if selection != 1 
  197.                ShowOption(marray[selection], plaincolor) 
  198.                selection := 1
  199.             endif 
  200.  
  201.          /* jump to bottom option */ 
  202.          case nkey == K_END
  203.             /* no point in changing color if we're already there */ 
  204.             if selection != num_elem 
  205.                ShowOption(marray[selection], plaincolor) 
  206.                selection := num_elem
  207.             endif 
  208.  
  209.          /* first letter - jump to appropriate option */ 
  210.          case upper(chr(nkey)) $ triggerltr 
  211.             ShowOption(marray[selection], plaincolor) 
  212.             selection := at(upper(chr(nkey)), triggerltr)
  213.             fallout := .t.
  214.  
  215.       endcase 
  216.    endif 
  217. enddo 
  218. //───── if there is an action block attached to this selection, run it
  219. if lastkey() != K_ESC 
  220.    if marray[selection, ACTION] != NIL 
  221.       eval(marray[selection, ACTION]) 
  222.    endif 
  223. else 
  224.    selection := 0  // since they Esc'd out, return a zero
  225. endif 
  226. setcursor(oldcursor) 
  227. set(_SET_MCENTER, oldmsgctr)   // reset SET MESSAGE CENTER 
  228. setcolor(oldcolor) 
  229. return nil 
  230.  
  231.  
  232. /* 
  233.   Function: ShowOption() 
  234.   Purpose:  Display current prompt in mixed colors 
  235. */ 
  236. static function ShowOption(item, plaincolor) 
  237. local ptr := at("~", item[PROMPT]) 
  238. if ptr > 0
  239.    @ item[ROW], item[COL] say strtran(item[PROMPT], "~", "") color plaincolor
  240.    @ item[ROW], item[COL] + ptr - 1 say ; 
  241.                     substr(item[PROMPT], ptr + 1, 1) color '+' + plaincolor
  242. else 
  243.    @ item[ROW], item[COL] say left(item[PROMPT], 1) color '+' + plaincolor
  244.    dispout(substr(item[PROMPT], 2), plaincolor)
  245. endif 
  246. return nil
  247.  
  248. //───── end of file CHP1412.PRG
  249.