home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / LITEMENU.PRG < prev    next >
Encoding:
Text File  |  1991-07-31  |  5.5 KB  |  157 lines
  1. /*
  2.    Function: LITE_MENU()
  3.    System:   Grumpfish Library
  4.    Author:   Greg Lief
  5.    Copyright (c) 1988-90 Greg Lief
  6.    Dialect:  Clipper 5.01
  7.    Compile with: clipper litemenu /n/w/a
  8.    Purpose:  Replacement for MENU TO... and ACHOICE()
  9.    Calls:    ShadowBox()
  10. */
  11.  
  12. //───── begin preprocessor directives
  13.  
  14. #include "grump.ch"
  15. #include "inkey.ch"
  16.  
  17. //───── end preprocessor directives
  18.  
  19. //───── begin global declarations
  20.  
  21. static max_len
  22.  
  23. //───── end global declarations
  24.  
  25. function lite_menu(ntop, nleft, marray, confirmit, plaincolor, hilitcolor, ;
  26.                    selection, ctitle, trigcolor)
  27. local num_elem := len(marray), xx, nkey := 0, luvletters := [], ;
  28.       fallout := .f., oldscrn, ptr
  29.  
  30. default confirmit to .t.
  31. default plaincolor to ColorSet(C_MENU_UNSELECTED, .T.)
  32. default hilitcolor to ColorSet(C_MENU_SELECTED, .T.)
  33. default trigcolor to "+" + ColorSet(C_MENU_SELECTED, .T.)
  34. default selection to 1         /* set initial highlighted item */
  35. default ctitle to ''           /* title for LITE_MENU() box */
  36.  
  37. GFSaveEnv( , 0, plaincolor )   // shut off cursor and change color
  38. selection := min(selection, num_elem)   // preclude bound array error
  39.  
  40. //───── determine length of the longest menu option
  41. max_len := len(ctitle) + 4
  42. aeval(marray, { | a | max_len := MAX(max_len, len(strtran(a, "~", ""))) } )
  43.  
  44. //───── if the box coordinates were ignored, use defaults
  45. default ntop to int((maxrow() - num_elem) / 2) - 1
  46. default nleft to int((maxcol() + 1 - max_len) / 2)
  47.  
  48. oldscrn := shadowbox(ntop, nleft, ntop + num_elem + 1, nleft + max_len + 1, ;
  49.                      2, ctitle)
  50. //───── build the string containing available letters for selection
  51. for xx = 1 to num_elem
  52.    //───── the default is to add the first non-space character.  however,
  53.    //───── if there is a tilde embedded in this menu option, use the letter
  54.    //───── directly following it.
  55.    if (ptr := at("~", marray[xx])) > 0
  56.       luvletters += upper(substr(marray[xx], ptr + 1, 1))
  57.    else
  58.       luvletters += upper(substr(marray[xx], 1, 1))
  59.    endif
  60.    ShowOption(xx, marray[xx], ntop, nleft, plaincolor, trigcolor)
  61. next
  62. //───── commence main key-grabbing loop
  63. do while nkey != K_ENTER .and. nkey != K_ESC
  64.    //───── first display current option in highlight color
  65.    @ ntop + selection, nleft + 1 ssay padr(strtran(marray[selection], "~", ""),;
  66.                                      max_len) color hilitcolor
  67.    if fallout
  68.       exit
  69.    else
  70.       nkey := ginkey(0)
  71.       do case
  72.  
  73.          //───── go down one option, observing wrap-around conventions
  74.          case nkey == K_DOWN
  75.             ShowOption(selection, marray[selection], ntop, nleft, ;
  76.                        plaincolor, trigcolor)
  77.             if selection = num_elem
  78.                selection := 1
  79.             else
  80.                selection++
  81.             endif
  82.  
  83.          //───── go up one line, observing wrap-around conventions
  84.          case nkey == K_UP
  85.             ShowOption(selection, marray[selection], ntop, nleft, ;
  86.                        plaincolor, trigcolor)
  87.             if selection = 1
  88.                selection := num_elem
  89.             else
  90.                selection--
  91.             endif
  92.  
  93.          //───── jump to top option
  94.          case nkey == K_HOME
  95.             //───── no point in going thru color rigmarole if we're already there
  96.             if selection != 1
  97.                ShowOption(selection, marray[selection], ntop, nleft, ;
  98.                           plaincolor, trigcolor)
  99.                selection := 1
  100.             endif
  101.  
  102.          //───── jump to bottom option
  103.          case nkey == K_END
  104.             //───── no point in going thru color rigmarole if we're already there
  105.             if selection != num_elem
  106.                ShowOption(selection, marray[selection], ntop, nleft, ;
  107.                           plaincolor, trigcolor)
  108.                selection := num_elem
  109.             endif
  110.  
  111.          //───── first letter - jump to appropriate option
  112.          case upper(chr(nkey)) $ luvletters
  113.             ShowOption(selection, marray[selection], ntop, nleft, ;
  114.                        plaincolor, trigcolor)
  115.             selection := at(upper(chr(nkey)), luvletters)
  116.             /*
  117.                if we do not need confirmation, we will set the fallout flag
  118.                to true so that we will fall out immediately after redisplaying
  119.                this option.  we could just as easily fall out right here, but
  120.                it is more aesthetically pleasing to redisplay the selected
  121.                option so that the user knows what they just selected
  122.             */
  123.             fallout := ! confirmit
  124.  
  125.       endcase
  126.    endif
  127. enddo
  128. GFRestEnv()
  129. byebyebox(oldscrn)
  130. return (if(lastkey() == K_ESC, 0, selection))
  131.  
  132. * end function Lite_Menu()
  133. *--------------------------------------------------------------------*
  134.  
  135.  
  136. /*
  137.   Function: ShowOption()
  138.   Purpose:  Display current prompt in mixed colors
  139. */
  140. static function showoption(noffset, coption, ntop, nleft, ccolor, ctrigger)
  141. local ptr := at("~", coption)
  142. if ptr > 0
  143.    @ ntop + noffset, nleft + 1 ssay padr(strtran(coption, "~", ""), ;
  144.                                     max_len) color ccolor
  145.    @ ntop + noffset, nleft + ptr ssay substr(coption, ptr + 1, 1) ;
  146.                                     color ctrigger
  147. else
  148.    @ ntop + noffset, nleft + 1 ssay substr(coption, 1, 1) color ctrigger
  149.    dispout(padr(substr(coption, 2), max_len - 1), ccolor)
  150. endif
  151. return nil
  152.  
  153. * end static function ShowOption()
  154. *--------------------------------------------------------------------*
  155.  
  156. * eof litemenu.prg
  157.