home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NANNWS35.ARC / TWOMENU2.PRG < prev    next >
Encoding:
Text File  |  1989-03-01  |  7.7 KB  |  322 lines
  1. * Program: TwoMenu2.prg
  2. * Author:  Rick Spence
  3. * Version: Clipper Summer '87
  4. * Note(s): See Function Definition below.
  5. *
  6. * Copyright (c) 1989 Nantucket Corporation.
  7.  
  8. * Sample call for twodmenu() function.
  9. * (Alternative Implementation.)
  10. CLEAR
  11.  
  12. t = 10
  13. l = 10
  14. b = 20
  15. r = 45
  16.  
  17. * We make this public as we redimension it if we insert an
  18. * element.  It is then clearer that you need to explicitly
  19. * RELEASE it.
  20.  
  21. PUBLIC sel_list[7]
  22.  
  23. sel_list[1] = "Brauer, Doris"
  24. sel_list[2] = "Brown, Laurell"
  25. sel_list[3] = "Cummings-Knight, Philip"
  26. sel_list[4] = "Gruen, Keith"
  27. sel_list[5] = "Humbs, Ingrid"
  28. sel_list[6] = "Muller, Dietmar"
  29. sel_list[7] = "Spence, Rick"
  30.  
  31. PRIVATE commands[5]
  32.  
  33. commands[1] = "Select"
  34. commands[2] = "Delete"
  35. commands[3] = "Insert"
  36. commands[4] = "Change"
  37. commands[5] = "Exit"
  38.  
  39. PRIVATE funcs[5]
  40.  
  41. funcs[1] = "sel_func"
  42. funcs[2] = "del_func"
  43. funcs[3] = "ins_func"
  44. funcs[4] = "change_func"
  45. funcs[5] = "ex_func"
  46.  
  47. com_sel = 1
  48. sel_no = twodmenu(t, l, b, r, sel_list, commands, @com_sel, funcs)
  49.  
  50. RELEASE sel_list
  51.  
  52.  
  53. * Alternative Function Definition:
  54. *
  55. * NUMERIC twodmenu(t, l, b, r, sel_list, commands,;
  56. *    @com_selected, funcs)
  57. *                       
  58. * NUMERIC t, l, b, r    - The box's coordinates.
  59. *
  60. * CHARACTER sel_list[]  - The list of items from which to choose.
  61. *
  62. * CHARACTER commands[]  - The list of commands.
  63. *
  64. * NUMERIC @com_selected - The number of the selected command.
  65. *                         This must be passed by reference.
  66. *
  67. * CHARACTER funcs       - Function to be called, corresponding to
  68. *                         command elements.
  69. *
  70. *                         Function returns one of:
  71. *
  72. *                         0 - Exit, with twodmenu() returning
  73. *                             current values.
  74. *
  75. *                         1 - Abort exit, with twodmenu()
  76. *                             returning 0.
  77. *
  78. *                         2 - Redisplay, which forces twodmenu()
  79. *                             to redisplay the list.  This is
  80. *                             useful if an item has been deleted
  81. *                             or inserted.
  82. *
  83. *                         The function is passed the currently
  84. *                         selected item as a parameter.
  85. *
  86. * The function returns the element number of the sel_list array
  87. * that the user chose.  This is zero if the user escaped from the
  88. * function with the escape key.
  89.  
  90.  
  91. FUNCTION twodmenu
  92. PARAM t, l, b, r, sel_list, commands, com_selected, funcs
  93. PRIVATE selection, win_save, com_cols[LEN(commands)], i, tot_width
  94. PRIVATE spaces_between, num_commands, cur_pos, start_chars
  95. PRIVATE ac_mode, ac_rel, AC_REDRAW, AC_FINISHED
  96.  
  97. * Initialize required memory variable constants.
  98. init_consts()
  99.  
  100. selection = 1
  101. num_commands = LEN(commands)
  102.  
  103. win_save = SAVESCREEN(t, l, b, r)
  104.  
  105. * Draw interleaved boxes.
  106. @ t, l TO b, r
  107. @ b - 2, l, b, r BOX CHR(195) + CHR(196) + CHR(180) + CHR(179) + ;
  108.    CHR(217) + CHR(196) + CHR(192) + CHR(179)
  109.  
  110. * Figure out spacing for commands.
  111. tot_width = 0
  112. FOR i = 1 TO num_commands
  113.    tot_width = tot_width + LEN(commands[i])
  114. NEXT
  115.  
  116. spaces_between = INT(((r - l - 1) - tot_width)/(num_commands + 1))
  117.  
  118. * Draw commands and build first characters string.
  119. cur_pos = l + 1 + spaces_between
  120. start_chars = ""
  121.  
  122. FOR i = 1 TO num_commands
  123.    com_cols[i] = cur_pos
  124.    @ b - 1, cur_pos SAY commands[i]
  125.    cur_pos = cur_pos + LEN(commands[i]) + spaces_between
  126.    start_chars = start_chars + UPPER(SUBSTR(commands[i], 1, 1))
  127. NEXT
  128.  
  129. highlight_current()
  130.  
  131. ac_redraw = 0
  132. ac_finished = 1
  133.  
  134. ac_mode = ac_redraw
  135. ac_rel = 0
  136. selection = 1
  137.  
  138. DO WHILE ac_mode = ac_redraw
  139.    ac_mode = ac_finished
  140.  
  141.    * Clear the list area.
  142.    SCROLL(t + 1, l + 1, b - 3, r - 1, 0)
  143.     
  144.    selection = ACHOICE(t + 1, l + 1, b - 3, r - 1, sel_list, ;
  145.       .T., "ac_func", selection, ac_rel)
  146. ENDDO
  147.  
  148. RESTSCREEN(t, l, b, r, win_save)
  149. RETURN selection
  150.  
  151.  
  152. * ACHOICE() user function.
  153. FUNCTION ac_func
  154. PARAMETER mode, cur_elem, rel_pos
  155. PRIVATE ret_val, lkey, fname, f_ret_val
  156.  
  157. ac_rel = rel_pos
  158. ret_val = ac_continue
  159. IF mode = ac_excep
  160.    lkey = LASTKEY()
  161.    DO CASE
  162.       CASE lkey = esc
  163.          ret_val = ac_abort
  164.  
  165.       CASE lkey = enter .OR. UPPER(CHR(lkey)) $ start_chars
  166.          IF lkey != enter
  167.             dehighlight_current()
  168.             com_selected = at(UPPER(CHR(lkey)), start_chars)
  169.             highlight_current()
  170.          ENDIF
  171.  
  172.          IF type("funcs[com_selected]") != "U"
  173.             * Call func.
  174.             fname = funcs[com_selected] + "(cur_elem)"
  175.             f_ret_val = &fname
  176.             DO CASE
  177.                CASE f_ret_val = 0
  178.                   ret_val = ac_select
  179.  
  180.                CASE f_ret_val = 1
  181.                   ret_val = ac_abort
  182.  
  183.                CASE f_ret_val = 2      && Redraw.
  184.                   * Set global to force reentry
  185.                   ac_mode = ac_redraw
  186.                   ret_val = ac_select
  187.  
  188.                CASE f_ret_val = 3
  189.                   ret_val = ac_continue
  190.  
  191.                OTHERWISE
  192.                   ret_val = ac_select
  193.             ENDCASE
  194.          ELSE
  195.             ret_val = ac_select
  196.          ENDIF
  197.  
  198.          CASE lkey = left_arrow
  199.             dehighlight_current()
  200.             IF com_selected = 1
  201.                com_selected = num_commands
  202.             ELSE
  203.                com_selected = com_selected - 1
  204.             ENDIF
  205.  
  206.             highlight_current()
  207.             ret_val = ac_continue
  208.  
  209.          CASE lkey = right_arrow
  210.             dehighlight_current()
  211.             IF com_selected = num_commands
  212.                com_selected = 1
  213.             ELSE
  214.                com_selected = com_selected + 1
  215.             ENDIF
  216.  
  217.             highlight_current()
  218.             ret_val = ac_continue
  219.  
  220.    ENDCASE
  221. ENDIF
  222. RETURN ret_val
  223.  
  224.  
  225. FUNCTION highlight_current
  226. * Highlight current command.
  227. @ b - 1, com_cols[com_selected] GET commands[com_selected]
  228. CLEAR GETS
  229. RETURN void
  230.  
  231.  
  232. FUNCTION dehighlight_current
  233. * Highlight current command.
  234. @ b - 1, com_cols[com_selected] SAY commands[com_selected]
  235. RETURN void
  236.  
  237.  
  238. FUNCTION init_consts
  239. PUBLIC left_arrow, right_arrow, void, esc, enter
  240. PUBLIC ac_continue, ac_select, ac_abort, ac_excep
  241.  
  242. left_arrow = 19
  243. right_arrow = 4
  244. void = .T.
  245. esc = 27
  246. enter = 13
  247.  
  248. ac_continue = 2
  249. ac_select = 1
  250. ac_abort = 0
  251. ac_excep  = 3 
  252.  
  253. RETURN void
  254.  
  255.  
  256. * Here are the sample functions I wrote to operate on the list.
  257.  
  258. * Select the current item and exit.
  259.  
  260. FUNCTION sel_func
  261. PARAM cur_elem
  262. RETURN 0                               && Exit.
  263.  
  264.  
  265. * Delete the current item.
  266. FUNCTION del_func
  267. PARAM cur_elem
  268.  
  269. * Get around ADEL() anomaly.
  270. IF cur_elem = LEN(sel_list)
  271.    sel_list[cur_elem] = .T.
  272. ELSE
  273.    ADEL(sel_list, cur_elem)
  274. ENDIF
  275. RETURN 2                               && Redraw.
  276.  
  277.  
  278. * Insert an element before the current item.
  279. FUNCTION ins_func
  280. PARAM cur_elem
  281. PRIVATE new_list[LEN(sel_list) + 1]
  282.  
  283. * Insert element into new array.
  284. ACOPY(sel_list, new_list, 1, cur_elem - 1, 1)
  285. new_list[cur_elem] = space(r - l - 1)
  286. ACOPY(sel_list, new_list, cur_elem, LEN(sel_list)-cur_elem + ;
  287.    1, cur_elem + 1)
  288.  
  289. * Redimension sel_list.
  290. PUBLIC sel_list[LEN(new_list)]
  291.  
  292. * Now copy new list into it.
  293. ACOPY(new_list, sel_list)
  294.  
  295. RETURN 2                               && Redraw.
  296.  
  297.  
  298. * Edit the current item.
  299. FUNCTION change_func
  300. PARAM cur_elem
  301. SET CURSOR ON
  302.    
  303. * We must allow them to GET the width of the box.
  304. sel_list[cur_elem] = SUBSTR(sel_list[cur_elem] + space(r-l-1), ;
  305.    1, r - l - 1)
  306. @ t + rel_pos + 1, l + 1 GET sel_list[cur_elem]
  307. READ
  308.  
  309. sel_list[cur_elem] = trim(sel_list[cur_elem])
  310.  
  311. SET CURSOR OFF
  312.  
  313. RETURN 2                               && Redraw.
  314.  
  315.  
  316. * Exit the process.
  317. FUNCTION ex_func
  318. PARAM cur_elem
  319. RETURN 1                               && Abort.
  320.  
  321. * EOF: TwoMenu2.prg
  322.