home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP14.EXE / CHP1411.PRG < prev    next >
Encoding:
Text File  |  1991-06-12  |  8.4 KB  |  243 lines
  1. /*
  2.    Listing 14.11 Very Fancy ACHOICE() Menu
  3.    Author: Greg Lief
  4.    Excerpted from Grumpfish Library's APICK() Function
  5.    Copyright (c) 1988-91 Greg Lief
  6.    Distributed by Grumpfish Inc., Box 17761, Salem, OR 97305 USA (503) 588-1815
  7. */
  8.  
  9. //───── NOTE: must be compiled with the /N compiler option
  10.  
  11. #include "achoice.ch" 
  12. #include "box.ch" 
  13. #include "inkey.ch" 
  14.  
  15. #define ISCHAR(a)        valtype(a) == "C" 
  16. #define K_SPACEBAR       32 
  17. #define CHECKMARK        chr(251) 
  18.  
  19. static rel_elem               // relative element position in ACHOICE() 
  20. static rel_row                // relative row position in ACHOICE() 
  21. static num_opts               // length of array - used in ACHOICE() 
  22. static bar_line               // current position of elevator indicator 
  23. static stat_clr               // color for elevator indicator 
  24. static bar_clr                // color for status bar 
  25. static draw_bar               // flag for whether or not to draw elevator bar 
  26. static ntop, nleft, nbottom, nright  // coordinates for ACHOICE() box 
  27.  
  28. function main 
  29. local nrow := 9, ncol := 25, x, oldcursor := setcursor(0), ; 
  30.       oldcolor, cities := {"Baltimore", "Boston", "Detroit", ; 
  31.       "New York", "Chicago", "Toronto", "Cleveland", "Milwaukee", ; 
  32.       "Texas", "Seattle", "California", "Oakland", "Minnesota", "Kansas City"} 
  33. cls 
  34. gchoice(cities) 
  35. cls 
  36. dispbox(8, 23, 16, 56, B_SINGLE + ' ', 'w/rb')
  37. @ 8, 30 say "[ Selected Cities ]" color '+w/rb'
  38. for x = 1 to len(cities) 
  39.    if right(cities[x], 1) = CHECKMARK 
  40.       @ nrow, ncol say substr(cities[x], 1, len(cities[x]) - 1) color '+w/rb'
  41.       if ncol == 25
  42.          ncol := 42
  43.       else 
  44.          ncol := 25
  45.          nrow++ 
  46.       endif 
  47.    endif 
  48. next 
  49. inkey(0) 
  50. setcursor(oldcursor) 
  51. return nil 
  52.  
  53.  
  54. /*
  55.    GCHOICE() - shell for ACHOICE()
  56. */
  57. function gchoice 
  58. parameter aarray 
  59. local x, maxwidth := 0, oldcolor, oldscrn, available := {}, ; 
  60.       unsel_clr, box_clr, hilite_clr 
  61. num_opts := len(aarray)
  62.  
  63. //───── determine widest array element and set columns accordingly
  64. aeval(aarray, { | a | maxwidth := max(maxwidth, len(a)) } ) 
  65. nleft   := int((maxcol() - 2 - maxwidth) / 2)
  66. nright  := nleft + maxwidth + 2
  67. //───── determine top and bottom rows based on length of array
  68. ntop    := max(7, 11 - int(num_opts / 2))
  69. nbottom := maxrow() - ntop
  70.  
  71. /* 
  72.    build a parallel array for available choices by looping through 
  73.    the main array - unavailable selections will begin with tilde (~) 
  74. */ 
  75. aeval(aarray, { | a | aadd(available, ; 
  76.              if(ISCHAR(a), substr(a, 1, 1) != '~', .t.) ) } ) 
  77.  
  78. /* 
  79.    now we manipulate the elements in the actual array: 
  80.    1) add a space to the end of each array element, 
  81.       which will then be used for the checkmark 
  82.    2) strip out tildes 
  83. */ 
  84. for x = 1 to num_opts 
  85.    if ISCHAR(aarray[x]) 
  86.       if left(aarray[x], 1) != '~' 
  87.          aarray[x] += chr(K_SPACEBAR) 
  88.       else 
  89.          aarray[x] := substr(aarray[x], 2)
  90.          // see if they want to draw a horizontal line - if so, 
  91.          // trimmed length of this array element will now be one. 
  92.          if len(trim(aarray[x])) == 1
  93.             aarray[x] := replicate(trim(aarray[x]), maxwidth)
  94.          endif 
  95.       endif 
  96.    endif 
  97. next 
  98.  
  99. rel_elem := rel_row := 1 
  100. box_clr  := '+W/' + if(iscolor(), 'B', 'N')
  101. bar_clr  := 'W/N, I'
  102. stat_clr := '+GR/N'
  103. unsel_clr := substr(box_clr, 2)
  104. hilite_clr := 'I'
  105. draw_bar := (num_opts > nbottom - ntop - 1)
  106. //───── force status bar to be drawn on first pass
  107. bar_line := ntop + 2
  108. oldcolor := setcolor(box_clr)
  109. oldscrn := savescreen(ntop, nleft, nbottom, nright)
  110. @ ntop, nleft, nbottom, nright box B_DOUBLE + ' ' 
  111. if draw_bar 
  112.    @ ntop + 1, nright, nbottom - 1, nright box chr(176) color bar_clr
  113. endif 
  114. setcolor(box_clr + ',' + hilite_clr + ',,,' + unsel_clr) 
  115. keyboard chr(255) 
  116. do while .t. 
  117.    achoice(ntop + 1, nleft + 1, nbottom - 1, nright - 1,; 
  118.            aarray, available, 'keytest', rel_elem, rel_row) 
  119.    if lastkey() == K_ENTER .or. lastkey() == K_ESC
  120.       exit 
  121.    endif 
  122. enddo 
  123. restscreen(ntop, nleft, nbottom, nright, oldscrn) 
  124. setcolor(oldcolor) 
  125. return NIL 
  126.  
  127.  
  128. /*
  129.     KeyTest() - Handle keystroke exceptions for ACHOICE()
  130. */
  131. function KeyTest(status, curr_elem, curr_row) 
  132. memvar aarray 
  133. local xx, oldrow := row(), oldcol := col(), ret_val := AC_CONT, ; 
  134.       telem, key := lastkey()
  135. static searchstr := [] 
  136. do case 
  137.  
  138.    case status == AC_HITTOP
  139.       rel_elem := num_opts
  140.       keyboard chr(255)        // force status bar display
  141.       ret_val := AC_ABORT      // force ACHOICE() to restart
  142.  
  143.    case status == AC_HITBOTTOM
  144.       rel_elem := 1
  145.       keyboard chr(255)        // force status bar display
  146.       ret_val := AC_ABORT      // force ACHOICE() to restart
  147.  
  148.    case status == AC_IDLE  .or. key == 255
  149.       if draw_bar 
  150.          //───── draw arrows if elements beyond top or bottom of window
  151.          //───── first, the bottom
  152.          @ nbottom, nright say if(num_opts - curr_elem >= nbottom - oldrow, ; 
  153.                                chr(25), chr(188)) 
  154.          //───── then the top
  155.          @ ntop, nright say if(oldrow - curr_elem < ntop, chr(24), chr(187)) 
  156.  
  157.          //───── if status bar position has changed, redraw it now
  158.          if bar_line != ntop + 1 + int((curr_elem / num_opts) * ; 
  159.                         (nbottom - ntop - 2)) 
  160.             //───── first, blank out previous status bar
  161.             @ bar_line, nright say chr(176) color bar_clr
  162.             //───── then recalculate position of status bar
  163.             bar_line := ntop + 1 + int( (curr_elem / num_opts) * ;
  164.                         (nbottom - ntop - 2) ) 
  165.             //───── finally, redraw it
  166.             @ bar_line, nright say chr(219) color stat_clr
  167.          endif 
  168.       endif 
  169.  
  170.    case key == K_SPACEBAR        // toggle this element on/off
  171.       aArray[curr_elem] := left(aArray[curr_elem], ;
  172.                          len(aArray[curr_elem]) - 1) + ;
  173.                          if(right(aArray[curr_elem], 1) == " ", CHECKMARK, " ")
  174.       rel_elem := curr_elem
  175.       rel_row  := curr_row
  176.       searchstr := []            // reset search string
  177.       @ nbottom, 36 say replicate(chr(205), 8) 
  178.       ret_val := AC_ABORT        // Force ACHOICE redisplay
  179.  
  180.    case key == K_ENTER .or. key == K_ESC
  181.       ret_val := AC_ABORT        // prepare to fall out
  182.  
  183.    case key == K_HOME
  184.       keyboard chr(K_CTRL_PGUP) 
  185.  
  186.    case key == K_END
  187.       keyboard chr(K_CTRL_PGDN) 
  188.  
  189.    case key == K_F8              // tag all items
  190.       for xx = 1 to num_opts 
  191.          aArray[xx] := left(aArray[xx], len(aArray[xx]) - 1) + CHECKMARK
  192.       next 
  193.       rel_elem := curr_elem      // save current position
  194.       rel_row  := curr_row       // and relative position
  195.       ret_val  := AC_ABORT       // Force ACHOICE redisplay
  196.  
  197.    case key == K_F9              // clear all tags
  198.       for xx = 1 to num_opts 
  199.          aArray[xx] := left(aArray[xx], len(aArray[xx]) - 1) + chr(K_SPACEBAR)
  200.       next 
  201.       rel_elem := curr_elem      // save current position
  202.       rel_row  := curr_row       // and relative position
  203.       ret_val := AC_ABORT        // Force ACHOICE redisplay
  204.  
  205.    case key == K_F10             // reverse all tags
  206.       for xx = 1 TO num_opts 
  207.          aArray[xx] := left(aArray[xx], len(aArray[xx]) - 1) + ;
  208.                       if(right(aArray[xx], 1) = " ", "√", " ") 
  209.       next 
  210.       rel_elem := curr_elem       // save current position
  211.       rel_row  := curr_row        // and relative position
  212.       ret_val  := AC_ABORT        // force ACHOICE redisplay
  213.  
  214.  
  215.    case IsAlpha(chr(key))        // letter key - search 
  216.       searchstr += chr(key) 
  217.       telem := ascan2(aArray, searchstr)
  218.       rel_elem := if(telem = 0, curr_elem, telem)
  219.       @ nbottom, 36 say "[" + padr(searchstr, 6) + "]" 
  220.       ret_val := AC_ABORT         // Force ACHOICE redisplay
  221.  
  222.    case key == K_BS .or. key == K_LEFT
  223.       if len(searchstr) > 0 
  224.          searchstr := substr(searchstr, 1, len(searchstr) - 1)
  225.          telem := ascan2(aArray, searchstr)
  226.          rel_elem := IF(telem == 0, curr_elem, telem)
  227.       endif 
  228.       @ nbottom, 36 say if(len(searchstr) == 0, replicate(chr(205), 8), ;
  229.                         "[" + padr(searchstr, 6) + "]") 
  230.       ret_val := AC_ABORT        // Force ACHOICE redisplay
  231.  
  232. endcase 
  233. return ret_val 
  234.  
  235.  
  236. /*
  237.    AScan2() - Case-insensitive ASCAN()
  238. */
  239. static function AScan2(array, value) 
  240. return ascan(array, { | a | if(ISCHAR(a), upper(a) = upper(value), .F.) }, 1)
  241.  
  242. //───── end of file CHP1411.PRG
  243.