home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / LITEMEN2.PRG < prev    next >
Encoding:
Text File  |  1991-08-28  |  10.6 KB  |  293 lines
  1. /*
  2.    Function: LITE_MENU2()
  3.    System:   Grumpfish Library
  4.    Author:   Greg Lief
  5.    Copyright (c) 1988-90 Greg Lief
  6.    Dialect:  Clipper 5.01
  7.    Compile with: clipper litemen2 /n/w/a
  8.    Purpose:  Replacement for MENU TO... and ACHOICE()
  9.  
  10.    Warning:  You must include the following line in your program if
  11.              you want to use this function:
  12.  
  13.                 #include "grumpm.ch"
  14.  
  15.    Caveat:   Pretty minor, actually.  In the same fashion that Clipper
  16.              carries around a PUBLIC variable GETLIST for GETs, this
  17.              function needs to use the variable MENULIST.  Therefore,
  18.              to avoid compiler warnings, you should include this line
  19.              of code in your program somewhere:
  20.  
  21.                 memvar menulist
  22. */
  23.  
  24. //───── begin preprocessor directives
  25.  
  26. #include "grump.ch"
  27. #include "inkey.ch"
  28.  
  29. #define  ROW             1
  30. #define  COL             2
  31. #define  PROMPT          3
  32. #define  MESSAGE         4
  33. #define  MESSAGECOLOR    5
  34. #define  WHEN            6
  35. #define  ACTION          7
  36. #define  TRIGGERCOLOR    8
  37.  
  38. #define  FORWARD         1
  39. #define  BACKWARD       -1
  40.  
  41. static unavacolor := '+n/n'   // color for unavailable menu options
  42.  
  43. //───── end preprocessor directives
  44.  
  45. function lite_menu2(marray, plaincolor, selection, varname, bevent, ;
  46.                     ntimeout, bexit, trigcolor, cleft, cright)
  47. local num_elem := len(marray), xx, nkey := 0, luvletters := [], ;
  48.       fallout := .f., oldmsgctr := set(_SET_MCENTER, .T.), ptr, ;
  49.       mess_row := set(_SET_MESSAGE), oldcursor := setcursor(0), hilitcolor, ;
  50.       oldcolor := setcolor(), direction := FORWARD, nstart
  51.  
  52. //───── if no time-out was specified, use a ridiculous default
  53. default ntimeout to 100000000
  54.  
  55. //───── if MESSAGE row was never set, use the bottom row of screen
  56. if mess_row == 0
  57.    mess_row := maxrow()
  58. endif
  59.  
  60. //───── set default colors for unselected, selected, and unavailable options
  61. default plaincolor to setcolor()
  62. xx := at(',', plaincolor)
  63. ptr := rat(',', plaincolor)
  64. if xx == ptr     // this means only unselected & selected colors were passed
  65.    hilitcolor := substr(plaincolor, xx + 1)
  66. else
  67.    hilitcolor := substr(plaincolor, xx + 1, ptr - xx - 1)
  68.    /*
  69.       if a color string was passed that contains two commas, then use
  70.       whatever lies to the right of the second comma as the color for
  71.       unavailable menu options -- but if we are using the current
  72.       color setting, instead use the default (+N/N) as defined above
  73.    */
  74.    if plaincolor != setcolor()
  75.       unavacolor := substr(plaincolor, ptr + 1)
  76.    endif
  77. endif
  78.  
  79. //───── establish default color for highlighting trigger letters
  80. default trigcolor to "+" + plaincolor
  81.  
  82. /*
  83.    determine initial highlighted item default to 1 -- also perform
  84.    error-checking to ensure they didn't specify an invalid selection
  85. */
  86. if selection == NIL .or. (selection < 1 .or. selection > num_elem)
  87.    selection := 1
  88. endif
  89.  
  90. //───── build the string containing available letters for selection
  91. for xx = 1 to num_elem
  92.    /*
  93.       first make sure that any WHEN clause for this option is
  94.       satisfied, and that the option can therefore be selected
  95.    */
  96.    if marray[xx, WHEN] = NIL .or. eval( marray[xx, WHEN] )
  97.       /*
  98.          the default is to add the first non-space character.
  99.          However, if there is a tilde embedded in this menu
  100.          option, use the letter directly following it.
  101.       */
  102.       if (ptr := at("~", marray[xx, PROMPT]) ) > 0
  103.          luvletters += upper(substr(marray[xx, PROMPT], ptr + 1, 1))
  104.       else
  105.          luvletters += upper(left(ltrim(marray[xx, PROMPT]), 1))
  106.       endif
  107.    else
  108.       /* add placeholder CHR(255) for unavailable options */
  109.       luvletters += chr(255)
  110.       /* strip out any tildes now */
  111.       marray[xx, PROMPT] = strtran(marray[xx, PROMPT], "~", "")
  112.    endif
  113.    ShowOption(marray[xx], plaincolor, trigcolor)
  114. next
  115. /*
  116.    if LUVLETTERS is full of ASCII chr 255, that means there
  117.    are no selectable menu options at this time - fall out
  118. */
  119. if luvletters == replicate(chr(255), num_elem)
  120.    selection := 0
  121. else
  122.    //───── commence main key-grabbing loop
  123.    do while nkey != K_ENTER .and. nkey != K_ESC
  124.       /* first make sure that current option is available for selection */
  125.       if marray[selection, WHEN] == NIL .or. eval(marray[selection, WHEN])
  126.          //───── then display current option in highlight color
  127.          @ marray[selection, ROW], marray[selection, COL] ssay ;
  128.                  strtran(marray[selection, PROMPT], "~", "") color hilitcolor
  129.  
  130.          //───── display corresponding message if there is one
  131.          if marray[selection, MESSAGE] == NIL
  132.             scroll(mess_row, 0, mess_row, maxcol(), 0)
  133.          else
  134.             @ mess_row, 0 ssay padc(marray[selection, MESSAGE], maxcol() + 1) ;
  135.             color if( marray[selection, MESSAGECOLOR] = NIL, plaincolor, ;
  136.                       marray[selection, MESSAGECOLOR] )
  137.          endif
  138.          if fallout
  139.             exit
  140.          else
  141.             /*
  142.                begin keypress wait loop -- necessary to accommodate
  143.                recurring event and keyboard inactivity timeout
  144.             */
  145.             nstart := seconds()
  146.             do while (nkey := inkey()) == 0 .and. seconds() - nstart < ntimeout
  147.                if bevent != NIL
  148.                   eval(bevent)
  149.                endif
  150.             enddo
  151.  
  152.             //───── we timed out!
  153.             if nkey == 0
  154.                //───── if no exitevent was specified, use screen blanker
  155.                if bexit == NIL
  156.                   blankscr3(-1)
  157.                else
  158.                   eval(bexit)
  159.                endif
  160.             endif
  161.             do case
  162.  
  163.                /*
  164.                   First, check for left and right arrow keypresses.
  165.                   If the LEFT and RIGHT clauses were used in conjunction
  166.                   with the MENU TO command, we must stuff characters into
  167.                   the buffer now.  This would generally be used with a
  168.                   pull-down menu system.
  169.                */
  170.                case nkey == K_LEFT .and. cleft != NIL
  171.                   keyboard cleft
  172.  
  173.                case nkey == K_RIGHT .and. cright != NIL
  174.                   keyboard cright
  175.  
  176.                /*
  177.                   next, check for action block attached to last keypress
  178.                   if there is one, evaluate it and pass it the name of
  179.                   the MENU TO variable along with the current highlighted
  180.                   option (e.g., SEL[5] if you are on the fifth option)
  181.                */
  182.                case setkey(nkey) != NIL
  183.                   eval(setkey(nkey), procname(1), procline(1), varname + ;
  184.                        "[" + ltrim(str(selection)) + "]")
  185.  
  186.                //───── go down one line, observing wrap-around conventions
  187.                case nkey == K_DOWN .or. nkey == K_RIGHT
  188.                   direction := FORWARD
  189.                   ShowOption(marray[selection], plaincolor, trigcolor)
  190.                   if selection == num_elem
  191.                      selection := 1
  192.                   else
  193.                      selection += direction
  194.                   endif
  195.  
  196.                //───── go up one line, observing wrap-around conventions
  197.                case nkey == K_UP .or. nkey == K_LEFT
  198.                   direction := BACKWARD
  199.                   ShowOption(marray[selection], plaincolor, trigcolor)
  200.                   if selection == 1
  201.                      selection := num_elem
  202.                   else
  203.                      selection--
  204.                   endif
  205.  
  206.                //───── jump to top option
  207.                case nkey == K_HOME
  208.                   //───── no point in changing color if we're already there
  209.                   if selection != 1
  210.                      ShowOption(marray[selection], plaincolor, trigcolor)
  211.                      selection := 1
  212.                      direction := FORWARD
  213.                   endif
  214.  
  215.                //───── jump to bottom option
  216.                case nkey == K_END
  217.                   //───── no point in changing color if we're already there
  218.                   if selection != num_elem
  219.                      ShowOption(marray[selection], plaincolor, trigcolor)
  220.                      selection := num_elem
  221.                      direction := BACKWARD
  222.                   endif
  223.  
  224.                //───── first letter - jump to appropriate option
  225.                case upper(chr(nkey)) $ luvletters
  226.                   ShowOption(marray[selection], plaincolor, trigcolor)
  227.                   selection := at(upper(chr(nkey)), luvletters)
  228.                   fallout := .t.
  229.  
  230.             endcase
  231.          endif
  232.       else
  233.          //───── keep moving in current direction
  234.          selection += DIRECTION
  235.          //───── wrap-around
  236.          if selection == 0
  237.             selection := num_elem
  238.          elseif selection > num_elem
  239.             selection := 1
  240.          endif
  241.       endif
  242.    enddo
  243.    //───── if there is an action block attached to this selection, run it
  244.    if lastkey() != K_ESC
  245.       if marray[selection][ACTION] != NIL
  246.          //───── reset cursor because this module might expect it on
  247.          setcursor(oldcursor)
  248.          eval(marray[selection][ACTION])
  249.          //───── now that that's over with, turn the rascal back off
  250.          setcursor(0)
  251.       endif
  252.    else
  253.       selection := 0  // since they Esc'd out, return a zero
  254.    endif
  255. endif
  256. setcursor(oldcursor)
  257. set(_SET_MCENTER, oldmsgctr)   // reset SET MESSAGE CENTER
  258. setcolor(oldcolor)
  259. return selection
  260.  
  261. * end function Lite_Menu2()
  262. *--------------------------------------------------------------------*
  263.  
  264.  
  265. /*
  266.   Function: ShowOption()
  267.   Purpose:  Display current prompt in mixed colors
  268. */
  269. static function ShowOption(item, plaincolor, trigcolor)
  270. local ptr
  271. /* first make sure that this option is available for selection */
  272. if item[WHEN] = NIL .or. eval( item[WHEN] )
  273.    if ( ptr := at("~", item[PROMPT]) ) > 0
  274.       @ item[ROW], item[COL] ssay strtran(item[PROMPT], "~", "") ;
  275.                    color plaincolor
  276.       @ item[ROW], item[COL] + ptr - 1 ssay substr(item[PROMPT], ptr + 1, 1) ;
  277.         color if( empty(item[TRIGGERCOLOR]), trigcolor, item[TRIGGERCOLOR] )
  278.    else
  279.       @ item[ROW], item[COL] ssay left(item[PROMPT], 1) ;
  280.         color if( empty(item[TRIGGERCOLOR]), trigcolor, item[TRIGGERCOLOR] )
  281.       dispout(substr(item[PROMPT], 2), plaincolor)
  282.    endif
  283. else
  284.    //───── display unavailable menu options in gray on black
  285.    @ item[ROW], item[COL] ssay item[PROMPT] color unavacolor
  286. endif
  287. return nil
  288.  
  289. * end static function ShowOption()
  290. *--------------------------------------------------------------------*
  291.  
  292. * eof litemen2.prg
  293.