home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP14.EXE / CHP1407.PRG < prev    next >
Encoding:
Text File  |  1991-06-12  |  8.2 KB  |  248 lines
  1. /*
  2.    Listing 14.7 Displaying Pull-Down Menu with PULLDOWN()
  3.    Author: Greg Lief
  4.    Excerpted from "Clipper 5: A Developer's Guide"
  5.    Copyright (c) 1991 M&T Books
  6.                       501 Galveston Drive
  7.                       Redwood City, CA 94063-4728
  8.                       (415) 366-3600
  9. */
  10.  
  11. //───── NOTE: must be compiled with /N compiler option
  12.  
  13. #include "error.ch"
  14.  
  15. static coords := {}  // must be file-wide for PULLDOWN() to work properly 
  16.  
  17. #define TEST            // remove this if you don't need the test code
  18.  
  19. //───── begin stub test program
  20.  
  21. #ifdef TEST
  22.  
  23. function main 
  24. local newhandler, oldhandler
  25. /*
  26.    establish custom error handler to handle calls to functions
  27.    that do not exist
  28. */
  29. newhandler := { | e | bogusfunc(e, oldhandler) }
  30. oldhandler := errorblock(newhandler)
  31. pulldown({ { "Data Entry", "Enter data, naturally", ; 
  32.             { { "Customers", , { || cust()    } }, ; 
  33.               { "Invoices",  , { || inv()     } }, ; 
  34.               { "Vendors",   , { || vendors() } }, ; 
  35.               { "Exit", "Return to Main Menu" } } }, ; 
  36.           { "Reports", "Share your information"  , ; 
  37.             { { "Customer List", , { || custrep()   } }, ; 
  38.               { "Past Due",      , { || pastdue()   } }, ; 
  39.               { "Weekly Sales",  , { || weeksales() } }, ; 
  40.               { "Monthly P&L",   , { || monthpl()   } }, ; 
  41.               { "Vendor List",   , { || vendorrep() } }, ; 
  42.               { "Exit", "Return to Main Menu" } } }, ; 
  43.           { "Maintenance", "Reindex files etc"   , ; 
  44.             { { "Reindex",  "Rebuild index files", { || re_ntx()   } }, ; 
  45.               { "Backup",   "Backup data files"  , { || backup()   } }, ; 
  46.               { "Compress", "Compress data files", { || compress() } }, ; 
  47.               { "Exit", "Return to Main Menu" } } }, ; 
  48.           { "Quit", "Take a siesta" } } ) 
  49. return nil 
  50.  
  51.  
  52. /*
  53.    BogusFunc(): custom error handler for bogus function calls
  54. */
  55. static function bogusfunc(e, oldhandler)
  56. if e:gencode() == EG_NOFUNC
  57.    return .t.
  58. endif
  59. return eval(oldhandler, e)
  60.  
  61.  
  62. #endif
  63.  
  64. //───── end stub test program
  65.  
  66. /* 
  67.    PULLDOWN() - display pull-down menu 
  68. */ 
  69. #include "box.ch" 
  70. #include "inkey.ch" 
  71. #define TOPROW      0 
  72. #define LEFTCOL(x)  coords[x, 1] 
  73. #define BOTROW(x)   coords[x, 2] 
  74. #define RIGHTCOL(x) coords[x, 3] 
  75.  
  76. #define OPTION(x)   prompts[x, 1] 
  77. #define MESSAGE(x)  prompts[x, 2] 
  78. #define ACTION(x)   prompts[x, 3] 
  79.  
  80. function pulldown(prompts) 
  81. local mainsel := 1, x, y, oldwrap := set(_SET_WRAP, .T.), oldmessrow, maxwidth
  82. local nprompts := len(prompts), oldleft, oldright, oldcursor := setcursor(0) 
  83. local ncol, subsel, buffer, tempsel 
  84.  
  85. //───── if no message row has been established, use bottom screen row
  86. if (oldmessrow := set(_SET_MESSAGE)) == 0 
  87.    set(_SET_MESSAGE, maxrow()) 
  88. endif 
  89. //───── loop through menu prompts array / determine coordinates for each submenu
  90. ncol := 0                     // placeholder for left column
  91. for x = 1 to nprompts 
  92.  
  93.    //───── Is there a submenu for this menu option?
  94.    //───── If so, it would contain four elements
  95.    if len(prompts[x]) > 2 .and. valtype( ACTION(x) ) == "A"
  96.  
  97.       //───── determine length of widest submenu option
  98.       maxwidth := 0
  99.       aeval(ACTION(x), { | a | maxwidth := max(maxwidth, len(a[1])) } ) 
  100.  
  101.       //───── add left and right columns and bottom row for the submenu box
  102.       //───── to COORDS array and increment left column accordingly
  103.       aadd(coords, { ncol, len(ACTION(x)) + 2, ncol + 1 + maxwidth } ) 
  104.  
  105.       //───── pad all messages in submenu so that they will occupy the
  106.       //───── entire bottom row... otherwise, messages from submenus
  107.       //───── might not erase messages from the main menu
  108.       for y = 1 to len(ACTION(x))
  109.          if ACTION(x)[y, 2] != NIL
  110.             ACTION(x)[y, 2] := padr(ACTION(x)[y, 2], maxcol())
  111.          endif
  112.       next
  113.    else
  114.  
  115.       //───── no submenu -- add current left column to COORDS array
  116.       //───── and increment left column by length of this menu option
  117.       aadd(coords, { ncol } ) 
  118.    endif 
  119.    ncol += len( OPTION(x) ) + 2 
  120.  
  121.    //───── pad all messages so that they will occupy the entire bottom row
  122.    if MESSAGE(x) != NIL 
  123.       MESSAGE(x) := padr(MESSAGE(x), maxcol())
  124.    endif
  125. next 
  126.  
  127. //───── begin loop for top-level menu
  128. do while mainsel != 0 
  129.  
  130.    //───── loop through prompts array and display each top-level prompt
  131.    for x = 1 to nprompts 
  132.  
  133.       //───── display message only if one exists
  134.       if len(prompts[x]) > 1 
  135.          @ TOPROW, LEFTCOL(x) prompt OPTION(x) message MESSAGE(x) 
  136.       else 
  137.          @ TOPROW, LEFTCOL(x) prompt OPTION(x) 
  138.       endif 
  139.    next 
  140.    menu to mainsel 
  141.    if mainsel > 0 
  142.       do case 
  143.  
  144.          //───── no submenu or action tied to this element -- force exit
  145.          case len(prompts[mainsel]) < 3 
  146.             mainsel := 0
  147.  
  148.          //───── submenu
  149.          case valtype( ACTION(mainsel) ) == "A"
  150.             /*
  151.                we must store the main selection to a temporary variable
  152.                because if we escape the submenu with a left or right 
  153.                arrow, we need to know which coordinates were used to 
  154.                draw the box around the submenu so that we can properly 
  155.                restore the screen
  156.             */
  157.             tempsel := mainsel
  158.             subsel := 1
  159.             //───── redefine left & right arrows to exit submenu
  160.             oldleft  := setkey(K_LEFT,  { | | jumpleft(@mainsel, nprompts) } )
  161.             oldright := setkey(K_RIGHT, { | | jumpright(@mainsel, nprompts) } )
  162.             buffer := savescreen(TOPROW + 1, LEFTCOL(tempsel), ;
  163.                                 BOTROW(tempsel), RIGHTCOL(tempsel)) 
  164.             @ TOPROW+1, LEFTCOL(tempsel), BOTROW(tempsel), RIGHTCOL(tempsel); 
  165.               box B_SINGLE + chr(32) 
  166.             do while subsel != 0 
  167.                setpos(TOPROW + 1, 0)
  168.                for x = 1 to len(ACTION(tempsel)) 
  169.                   //───── display message only if one exists
  170.                   if len(ACTION(tempsel)[x]) > 1 
  171.                      @ row()+1, LEFTCOL(tempsel)+1 prompt ACTION(tempsel)[x, 1]; 
  172.                                                    message ACTION(tempsel)[x, 2] 
  173.                   else 
  174.                      @ TOPROW, LEFTCOL(tempsel)+1  prompt ACTION(tempsel)[x, 1] 
  175.                   endif 
  176.                next 
  177.                menu to subsel 
  178.                if subsel > 0 
  179.                   if len(ACTION(tempsel)[subsel]) > 2 .and. ; 
  180.                             valtype(ACTION(tempsel)[subsel, 3]) == "B"
  181.                      eval( ACTION(tempsel)[subsel, 3]) 
  182.                   else 
  183.                      subsel := 0
  184.                   endif 
  185.                endif 
  186.             enddo 
  187.             restscreen(TOPROW + 1, LEFTCOL(tempsel), BOTROW(tempsel), ; 
  188.                        RIGHTCOL(tempsel), buffer) 
  189.             setkey(K_LEFT, oldleft) 
  190.             setkey(K_RIGHT, oldright) 
  191.  
  192.          //───── action block
  193.          case valtype( ACTION(mainsel) ) == "B"
  194.             eval( ACTION(mainsel) ) 
  195.  
  196.  
  197.          //───── your guess is as good as mine
  198.          otherwise
  199.             // ????
  200.  
  201.       endcase 
  202.    endif 
  203. enddo 
  204.  
  205. //───── restore previous message and wrap settings
  206. set(_SET_MESSAGE, oldmessrow) 
  207. set(_SET_WRAP, oldwrap) 
  208. setcursor(oldcursor) 
  209. return nil 
  210.  
  211.  
  212. /* 
  213.    JUMPLEFT() - make left arrow exit sub-menu 
  214. */ 
  215. static function jumpleft(main, maxprompts) 
  216. if main == 1
  217.    main := maxprompts
  218. else 
  219.    main-- 
  220. endif 
  221. /*
  222.    peek in COORDS array to see if there is a sub-menu attached to the
  223.    new top-level menu option -- if so, stuff an Enter to jump right 
  224.    into the sub-menu -- if not, leave it alone
  225. */
  226. keyboard chr(K_ESC) + if(len(coords[main]) > 1, chr(K_ENTER), '') 
  227. return nil 
  228.  
  229.  
  230. /* 
  231.    JUMPRIGHT() - make left arrow exit sub-menu 
  232. */ 
  233. static function jumpright(main, maxprompts) 
  234. if main == maxprompts
  235.    main := 1
  236. else 
  237.    main++ 
  238. endif 
  239. /*
  240.    peek in COORDS array to see if there is a sub-menu attached to the
  241.    new top-level menu option -- if so, stuff an Enter to jump right 
  242.    into the sub-menu -- if not, leave it alone
  243. */
  244. keyboard chr(K_ESC) + if(len(coords[main]) > 1, chr(K_ENTER), '') 
  245. return nil
  246.  
  247. //───── end of file CHP1407.PRG
  248.