home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / MENUV.PRG < prev    next >
Encoding:
Text File  |  1991-07-22  |  4.7 KB  |  130 lines
  1. /*
  2.     Program: MENUV()
  3.     System: GRUMPFISH LIBRARY
  4.     Author: Greg Lief
  5.     Copyright (c) 1988, Greg Lief
  6.     Clipper 5.x version
  7.     Compile instructions: clipper menuv /n/w/a
  8.  
  9.     Creates vertical bounce-bar menu
  10.  
  11.     5.0 NOTES: MenuV() now expects a multi-dimensional array rather
  12.                than a messy delimited character string.  The old
  13.                (primitive) format was:
  14.  
  15.     mainmenu[1] = 'Data Entry$Edit info^DATA_ENTRY()'
  16.     mainmenu[2] = 'Reports$Hard copies^REPORTS()'
  17.     mainmenu[3] = 'Utilities$Misc.^UTILITIES()'
  18.     mainmenu[4] = 'Mastermind$Waste time^POPMM()'
  19.     mainmenu[5] = 'Quit$Exit to DOS'
  20.  
  21.     Out with the crud, and in with the new:
  22.  
  23.     mainmenu := { { 'Data Entry', 'Edit info', 'DATA_ENTRY()'} , ;
  24.                   { 'Reports', 'Hard copies', 'REPORTS()' }  , ;
  25.                   { 'Utilities', 'Miscellaneous', 'UTILITIES()' } , ;
  26.                   { 'Mastermind', 'Waste time', 'POPMM()' } , ;
  27.                   { 'Quit', 'Exit to DOS'} }
  28.  
  29.     To skip anything, just leave it NIL.  For example:
  30.  
  31.                   { 'Reports', , }  , ;
  32.  
  33.     will display Reports as a menu option, but will not display
  34.     an accompaying message nor execute any function upon selection.
  35. */
  36.  
  37. //───── begin preprocessor directives
  38.  
  39. #include "grump.ch"
  40.  
  41. //───── end preprocessor directives
  42.  
  43. function Menuv(marray, ctitle, nboxtype, boxcolor, titlecolor)
  44. local choice, use_proc, num_ele := len(marray), max_len, ntop, nleft, ;
  45.       nbottom, nright, gfmenuscrn, oldcol, xx, cproc, oldmessc, ;
  46.       oldmessrow, oldwrap
  47.  
  48. GFSaveEnv()
  49. //───── establish MESSAGE and WRAP settings
  50. oldmessc := set(_SET_MCENTER, .T.)  // set message to be centered
  51. //───── if no message row has been established already, set it to 24
  52. if (oldmessrow := set(_SET_MESSAGE)) == 0
  53.    set(_SET_MESSAGE, 24)
  54. endif
  55. oldwrap := set(_SET_WRAP, .T.)     // SET WRAP ON
  56.  
  57. //───── establish defaults if parameters were not passed
  58. default ctitle to 'Menu'
  59. default nboxtype to 1
  60. default boxcolor to ColorSet(C_MENU_UNSELECTED, .T.) + ',' + ;
  61.                   ColorSet(C_MENU_SELECTED, .T.)
  62. default titlecolor to ColorSet(C_MENU_SELECTED, .T.)
  63.  
  64. //───── we can only accommodate a maximum of 20 menu items
  65. if num_ele < 21
  66.    //───── determine maximum length for menu selections and draw box accordingly
  67.    max_len := len(ctitle) + 4  // must be at least as wide as the menu title!
  68.    use_proc := .f.             // set true if user passed procedures to do
  69.    aeval(marray, { | a | max_len := max(max_len, len(a[1])) } )
  70.    //───── if any procedure names were passed, set USE_PROC true
  71.    use_proc := ( ascan( marray, { | a | a[3] != NIL } ) > 0)
  72.  
  73.    //───── assign left and right column coordinates
  74.    nleft := int((maxcol() + 1 - max_len) / 2)
  75.    nright := nleft + max_len
  76.  
  77.    //───── calculate top and bottom rows for box based on # of options
  78.    nbottom := ( ntop := 12 - int((num_ele + 3) / 2) ) + num_ele + 2
  79.  
  80.    //───── draw the box and any necessary shadows
  81.    if nboxtype > 5                         // 3-D effect
  82.       if nboxtype > 10                     // super-duper 3-D
  83.          setcolor('W/W')
  84.          scroll(ntop - 2, nleft + 3, nbottom - 2, nright + 4, 0)
  85.       endif
  86.       setcolor('W/N')
  87.       scroll(ntop - 1, nleft + 1, nbottom - 1, nright + 2, 0)
  88.    endif
  89.    @ ntop, nleft-1, nbottom, nright box ;
  90.                     BOXFRAMES[if(nboxtype%5 = 0, 5, nboxtype%5)] color boxcolor
  91.    @ ntop, int((maxcol() - 1 - len(ctitle)) / 2) ssay ' ' + ctitle + ' ' ;
  92.                     color titlecolor
  93.  
  94.    //───── main loop
  95.    do while .t.
  96.       setcolor(boxcolor)
  97.       //───── first -- display all prompts centered on the screen
  98.       setpos(ntop + 1, nleft)
  99.       for xx = 1 to num_ele
  100.          @ row()+1, int( (80 - len(marray[xx][1])) / 2) ;
  101.                     prompt marray[xx][1] message marray[xx][2]
  102.       next
  103.       menu to choice
  104.       //───── exit the loop if they selected the last choice, escaped, or
  105.       //───── no procedures were passed to be done
  106.       if choice == len(marray) .or. choice == 0 .or. ! use_proc
  107.          exit
  108.       else
  109.          //───── execute the function tied to this option if there is one
  110.          if marray[choice][3] != NIL
  111.             cproc := &( "{ | | " + marray[choice][3] + "}" )
  112.             gfmenuscrn := savescreen(0, 0, maxrow(), maxcol())
  113.             eval(cproc)
  114.             restscreen(0, 0, maxrow(), maxcol(), gfmenuscrn)
  115.          endif
  116.       endif
  117.    enddo
  118. endif
  119. //───── restore previous message and wrap settings
  120. set(_SET_MCENTER, oldmessc)
  121. set(_SET_MESSAGE, oldmessrow)
  122. set(_SET_WRAP, oldwrap)
  123. GFRestEnv()
  124. return choice
  125.  
  126. * end function MenuV()
  127. *--------------------------------------------------------------------*
  128.  
  129. * eof menuv.prg
  130.