home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / MENU.ZIP / OMENU.PRG < prev    next >
Encoding:
Text File  |  1990-05-15  |  20.9 KB  |  774 lines
  1. // Ogg's Menuing Module
  2. // (c) 1990 Nantucket Corporation
  3. //
  4. // Preliminary Version for Australian DevCon
  5. // Written by Craig Ogg
  6. //
  7.  
  8. #include "omenu.ch"
  9. #include "inkey.ch"
  10. #include "arrayfun.ch"
  11.  
  12. //....Clipper internal variables that this system depends on
  13. #define clpWRAP M->__wrap
  14.  
  15. //....Default colors for menus
  16. #define omDEFBW   "N/W,W+/W,W+/N,N/W,W/N"
  17. #define omDEFCLR  "N/BG,R/BG,W+/R,W/BG,W/R"
  18.  
  19. //....Amount of spaces to "pad" around menu items
  20. #define omPAD     2
  21.  
  22. //....Positions in Menu Array Header
  23. #define mahLEN     10 // Length of array
  24. #define mahROW     1
  25. #define mahCOL     2
  26. #define mahLENGTH  3
  27. #define mahWIDTH   4
  28. #define mahCOLOR   5
  29. #define mahBORDER  6
  30. #define mahKEYS    7
  31. #define mahIDLE    8
  32. #define mahCHOICE  9
  33. #define mahLASTREQ 10
  34.  
  35. //....Positions in Menu Array
  36. #define maLEN     9   // Length of this array
  37. #define maROW     1   
  38. #define maCOL     2
  39. #define maCHOICE  3
  40. #define maACTION  4   
  41. #define maCOLOR   5
  42. #define maACTIVE  6
  43. #define maHOTKEY  7   // Key that is "underlined"
  44. #define maKEYPOS  8   // Where that key is
  45. #define maIMAGE   9   // Image of Norm Selection
  46.  
  47. //....Psuedo-functions
  48.  
  49.  
  50. //....MENULEN:  Return length of menu
  51. //....
  52. //....menulen( <aMenu> ) ---> nLength
  53. //....
  54. FUNCTION MenuLen( aMenu ) 
  55. RETURN ( LEN( aMenu ) - 1 )
  56.  
  57.  
  58. //....ITEMNORM:  Return normal menu item color from color string
  59. //....
  60. //....itemnorm( <cColor> ) --> cColor
  61. //....
  62. STATIC FUNCTION ItemNorm( cColor )
  63.    RETURN LEFT( cColor, AT( ',', cColor ) - 1 )
  64.  
  65.  
  66. //....ITEMLETTER: Return color for hotkey from color string
  67. //....
  68. //....itemletter( <cColor> ) --> cColor
  69. //....
  70. STATIC FUNCTION ItemLetter( cColor )
  71.  
  72.    cColor := SUBSTR( cColor, AT(',',cColor)+1 )
  73.  
  74.    RETURN LEFT( cColor, AT(',',cColor)-1 )
  75.  
  76.  
  77. //....ITEMBOLD:     RETURN selected menu item color from color string
  78. //....
  79. //....itembold( cColor ) --> cColor
  80. //....
  81. STATIC FUNCTION ItemBold( cColor)
  82.  
  83.    cColor := SUBSTR( cColor, AT(',',cColor)+1 )
  84.    cColor := SUBSTR( cColor, AT(',',cColor)+1 ) // Second comma
  85.  
  86.    RETURN LEFT( cColor, AT(',',cColor)-1 )
  87.  
  88.  
  89. //....ITEMOFFNORM:  Return inactivated menu item color from color string
  90. //....
  91. //....itemoffnorm( cColor ) --> cColor
  92. //....
  93. STATIC FUNCTION itemoffnorm( cColor )
  94.  
  95.    cColor := SUBSTR( cColor, AT(',',cColor)+1 )
  96.    cColor := SUBSTR( cColor, AT(',',cColor)+1 ) // Second comma
  97.    cColor := SUBSTR( cColor, AT(',',cColor)+1 ) // Third comma
  98.  
  99.    RETURN LEFT( cColor, AT(',',cColor)-1 )
  100.  
  101.  
  102. //....ITEMOFFBOLD:  Return inactivated menu item bold color from color string
  103. //....
  104. //....itemoffbold( cColor ) --> cColor
  105. //....
  106. STATIC FUNCTION itemoffbold( cColor )
  107.    RETURN SUBSTR( cColor, RAT( ',', cColor ) + 1 )
  108.  
  109.  
  110. //....CALCTOPLEFT: Calculate upper left corner of menu from size
  111. //....
  112. //....calctopleft( <nRow>, <nCol>, 
  113. //....             <nHeight>, <nWidth>, 
  114. //....             <nJust>, <pnTop>, 
  115. //....             <pnLeft> )            ---> NIL
  116. //....
  117. //....Paramters:
  118. //....   nRow,nCol - Reference row and column
  119. //....     nHeight - Height of menu in rows
  120. //....      nWidth - Width of menu in columns
  121. //....       nJust - One of the following:
  122. //....                omCENTER - Center menu around nRow,nCol
  123. //....                 omRIGHT - Right justify menu against nRow,nCol
  124. //....                  omLEFT - Left justify menu against nRow,nCol
  125. //....       pnTop - Resulting top coordinate, must be passed by reference
  126. //....      pnLeft - Resulting left coordinate, must be passed by reference
  127. //....
  128. STATIC FUNCTION calctopleft( nRow, nCol, nHeight, nWidth, nJust, pnTop, pnLeft )
  129.  
  130.    DO CASE
  131.       CASE nJust == omLEFT
  132.          pnTop := nRow
  133.          pnLeft := nCol
  134.       CASE nJust == omRIGHT
  135.          pnTop := nRow
  136.          pnLeft := ( nCol - nWidth ) + 1
  137.       CASE nJust == omCENTER
  138.          pnTop := nRow - INT( nHeight / 2 )
  139.          pnLeft := nCol - INT( nWidth / 2 )
  140.       OTHERWISE
  141.          pnTop := nRow
  142.          pnLeft := nCol
  143.    ENDCASE
  144.  
  145.    IF pnTop < 1
  146.       pnTop := 1
  147.    ENDIF
  148.  
  149.    IF pnLeft < 0
  150.       pnLeft := 0
  151.    ENDIF
  152.  
  153.    RETURN( NIL )
  154.  
  155.  
  156. //....ADDDEFAULTKEYS : Add default keys to the Key Handler Array
  157. //....
  158. //....adddefaultkeys( <aKeyArray> ) --> aKeyArray
  159. //....
  160. //....Paramters:
  161. //....   aKeyArray : Key Handler Array to make copy of and add default
  162. //....               keys to
  163. //....
  164. STATIC FUNCTION adddefaultkeys( aKeyArray )
  165.  
  166.    LOCAL aKey := {}, i
  167.  
  168.    //....Done this way to handle 0 length key arrays
  169.    //....Replace with   asize()  when asize works
  170.  
  171.    IF LEN(aKeyArray) > 0
  172.       aKey := ARRAY( LEN( aKeyArray ) )
  173.       ACOPY( aKeyArray, aKey )
  174.    ENDIF
  175.  
  176.    AADD( aKey, { K_UP, {|aMenu,nKey| MenuUp( aMenu )} } )
  177.    AADD( aKey, { K_DN, {|aMenu,nKey| MenuDown( aMenu )} } )
  178.    AADD( aKey, { K_HOME, {|aMenu,nKey| ItemMark( aMenu, 1 )} } )
  179.    AADD( aKey, { K_CTRLPGUP, {|aMenu,nKey| ItemMark( aMenu, 1 )} } )
  180.    AADD( aKey, { K_END, {|aMenu,nKey| ItemMark( aMenu, MenuLen(aMenu) )} } )
  181.    AADD( aKey, { K_CTRLPGDN, {|aMenu,nKey| ItemMark( aMenu, MenuLen(aMenu) )} } )
  182.    AADD( aKey, { K_ESC, {|aMenu,nKey| MenuExit( aMenu )} } )
  183.    AADD( aKey, { K_   RETURN, {|aMenu,nKey| MenuDoAction( aMenu )} } )
  184.  
  185.    RETURN aKey
  186.  
  187.  
  188. //....MENUCREATE: Create menu "object"
  189. //....
  190. //....MenuCreate( <nRow>, <nCol>, <nJust>, [<cMenuColor>], [<nBorder>], ;
  191. //....             <aChoices>, [<aKeys>], [<aIdle>] ) ---> aMenu
  192. //....                                                    
  193. //....Parameters:
  194. //....     
  195. //....      nRow - Row coordinate
  196. //....      nCol - Column coordinate
  197. //....     nJust - One of the following:
  198. //....              omCENTER - Center menu around nRow,nCol
  199. //....               omRIGHT - Right justify menu against nRow,nCol
  200. //....                omLEFT - Left justify menu against nRow,nCol
  201. //....   nBorder - One of the following:
  202. //....              omDOUBLE - Double line border
  203. //....              omSINGLE - Single line border
  204. //....                omNONE - No line around border
  205. //....  aChoices - An array of arrays of type { cChoice, bAction, cColor, lActive }
  206. //....     aKeys - An array of arrays of type { nKey, bAction }
  207. //....     aIdle - An array of arrays of type { nIdleSecs, bAction }
  208. //....  
  209. //....   RETURNs:
  210. //....  
  211. //....    aMenu - A menu "object"
  212. //....
  213. FUNCTION MenuCreate( nRow, nCol, nJust, cMenuColor, nBorder, aChoices, aKeys, aIdle )
  214.  
  215.    LOCAL aMenu := { NIL }, aElement, aText := {}
  216.    LOCAL nMaxlen := 0, nTop, nLeft
  217.    LOCAL cChoice
  218.    LOCAL nChoice
  219.  
  220.    //.... create array of menu choice text
  221.    AEVAL( aChoices, {|x| AADD( aText, x[1] )} )
  222.  
  223.    //.... determine length of longest choice
  224.    nMaxlen := LEN( acomp( aText, acMAXLEN ) ) - 1
  225.  
  226.    calctopleft( nRow, nCol, LEN( aText ) + 2, nMaxlen + 4, ;
  227.                 nJust, @nTop, @nLeft )
  228.  
  229.    //.... first element of aMenu is reserved for "header"
  230.    aMenu[1] := ARRAY( mahLEN )
  231.  
  232.    //.... sort idle events in descending order
  233.    IF aIdle == NIL
  234.       aIdle := {}
  235.    ENDIF
  236.  
  237.    //.... setup header information
  238.    aMenu[1, mahROW]    := nTop
  239.    aMenu[1, mahCOL]    := nLeft
  240.    aMenu[1, mahLENGTH] := LEN( aText ) + 2
  241.    aMenu[1, mahWIDTH]  := nMaxlen + IIF( nBorder == omNONE, omPAD * 2, ;
  242.                                                    ( omPAD * 2 ) + 2 )
  243.    aMenu[1, mahCOLOR]  := IIF( cMenuColor != NIL, itemnorm( cMenuColor ), ;
  244.                                IIF( ISCOLOR(), itemnorm( omDEFCLR ), ;
  245.                                                itemnorm( omDEFBW ) ) )
  246.    aMenu[1, mahBORDER] := IIF( nBorder != NIL, nBorder, omNONE )
  247.    aMenu[1, mahKEYS]   := IIF( aKeys == NIL, AddDefaultKeys( {} ), ;
  248.                                              AddDefaultKeys( aKeys ) )
  249.    aMenu[1, mahIDLE]   := aIdle
  250.    
  251.    //.... fill in the choices
  252.    nRow := nTop + 1
  253.    nCol := nLeft + IIF( nBorder == omNONE, 0, 1 )
  254.    FOR nChoice := 1 TO LEN( aText )
  255.       //....completely define one menu choice
  256.       aElement := ARRAY( maLEN )
  257.  
  258.       aElement[maROW] := nRow++
  259.       aElement[maCOL] := nCol
  260.  
  261.       IF aText[nChoice] == '-'
  262.          //....force hotkey indicator
  263.          aElement[maKEYPOS] := 0
  264.          aElement[maHOTKEY] := ''
  265.  
  266.          aElement[maCHOICE] := aText[nChoice]
  267.       ELSE
  268.          cChoice := SPACE( omPAD ) + aText[nChoice]
  269.  
  270.          //....find hotkey indicator
  271.          aElement[maKEYPOS] := AT( '~', cChoice )
  272.          aElement[maHOTKEY] := SUBSTR( cChoice, aElement[maKEYPOS] + 1, 1 )
  273.  
  274.          aElement[maCHOICE] := SPACE( omPAD ) + ;
  275.                         PAD( STRTRAN( aText[nChoice], '~', '' ), nMaxlen ) + ;
  276.                              SPACE( omPAD )
  277.       ENDIF
  278.  
  279.       aElement[maACTION] := IIF( aChoices[nChoice, 2] == NIL, ;
  280.                                  {|menu| MenuExit(menu)}, ;
  281.                                  aChoices[nChoice, 2] )
  282.  
  283.       IF aChoices[nChoice, 3] != NIL
  284.          aElement[maCOLOR] := aChoices[nChoice, 3]
  285.       ELSE
  286.          IF cMenuColor != NIL
  287.             //....use menu color if item color not given
  288.             aElement[maCOLOR] := cMenuColor
  289.          ELSE
  290.             //....use default color setting if neither given
  291.             aElement[maCOLOR] := IIF( ISCOLOR(), omDEFCLR, omDEFBW )
  292.          ENDIF
  293.       ENDIF
  294.  
  295.       //....make option active if not specified
  296.       aElement[maACTIVE] := iif( aChoices[nChoice,4] != NIL, ;
  297.                                  aChoices[nChoice, 4], ;
  298.                                  .T. )
  299.       AADD( aMenu, aElement )
  300.    NEXT  
  301.  
  302.    RETURN aMenu
  303.  
  304.  
  305. //....ITEMISLINE: Is item a line?
  306. //....
  307. //....ItemIsLine( <aMenu>, [<nChoice>] ) ---> lLine
  308. //....
  309. FUNCTION ItemIsLine( aMenu, nChoice )
  310.  
  311.    IF nChoice == NIL
  312.       nChoice := MenuChoice( aMenu )
  313.    ENDIF
  314.  
  315.    RETURN( aMenu[ nChoice + 1, maCHOICE ] == '-' )
  316.  
  317.  
  318. //....ITEMISACTIVE: Is item active
  319. //....
  320. //....ItemIsActive( <aMenu>, [<nChoice>] ) ---> lActive
  321. //....
  322. FUNCTION ItemIsActive( aMenu, nChoice )
  323.  
  324.    IF nChoice == NIL
  325.       nChoice := MenuChoice( aMenu )
  326.    ENDIF
  327.  
  328.    RETURN( aMenu[ nChoice + 1, maACTIVE ] )
  329.  
  330.  
  331. //....ITEMOFF: Make item inactive
  332. //....
  333. //....ItemOff( <aMenu>, [<nChoice>] ) ---> aMenu
  334. //....
  335. FUNCTION ItemOff( aMenu, nChoice )
  336.  
  337.    IF nChoice == NIL
  338.       nChoice := MenuChoice( aMenu )
  339.    ENDIF
  340.  
  341.    //....Set item to unselectable
  342.    aMenu[ nChoice + 1, maACTIVE ] := .F.
  343.  
  344.    ItemShow( aMenu, nChoice )
  345.  
  346.    RETURN aMenu
  347.  
  348.  
  349. //....ITEMON: Make item active
  350. //....
  351. //....ItemOn( <aMenu>, [<nChoice>] ) ---> aMenu
  352. //....
  353. FUNCTION ItemOn( aMenu, nChoice )
  354.  
  355.    IF nChoice == NIL
  356.       nChoice := MenuChoice( aMenu )
  357.    ENDIF
  358.  
  359.    //....Set item to selectable
  360.    aMenu[ nChoice + 1, maACTIVE ] := .T.
  361.  
  362.    ItemShow( aMenu, nChoice )
  363.  
  364.    RETURN aMenu
  365.  
  366.  
  367. //....ITEMSHOW: Show choice in specified color setting
  368. //....
  369. //....ItemShow( <aMenu>, [<nChoice>] ) ---> aMenu
  370. //....
  371. FUNCTION ItemShow( aMenu, nChoice )
  372.  
  373.    LOCAL nRow, nCol
  374.    LOCAL cOldColor
  375.  
  376.    cOldColor := SETCOLOR()
  377.  
  378.    IF nChoice == NIL
  379.       nChoice := MenuChoice( aMenu )
  380.    ENDIF
  381.  
  382.    nRow := aMenu[nChoice + 1,maROW]
  383.    nCol := aMenu[nChoice + 1,maCOL]
  384.  
  385.    DO CASE
  386.      CASE ItemIsLine( aMenu, nChoice )
  387.         //....Line all the way across
  388.         SETCOLOR( aMenu[1, mahCOLOR] )
  389.  
  390.         DO CASE
  391.           CASE aMenu[1, mahBORDER] == omNONE
  392.              @ nRow, aMenu[1, mahCOL] SAY REPLICATE( '─', aMenu[1, mahWIDTH] )
  393.  
  394.           CASE aMenu[1, mahBORDER] == omSINGLE
  395.              @ nRow, aMenu[1, mahCOL] SAY REPLICATE( '─', aMenu[1, mahWIDTH] )
  396.              @ nRow, aMenu[1, mahCOL] SAY '├'
  397.              @ nRow, ( aMenu[1, mahCOL] + aMenu[1, mahWIDTH] - 1 ) SAY '┤'
  398.  
  399.           CASE aMenu[1, mahBORDER] == omDOUBLE
  400.              @ nRow, aMenu[1, mahCOL] SAY REPLICATE( '─', aMenu[1, mahWIDTH] )
  401.              @ nRow, aMenu[1, mahCOL] SAY '╟'
  402.              @ nRow, ( aMenu[1, mahCOL] + aMenu[1, mahWIDTH] - 1 ) SAY '╢'
  403.  
  404.         ENDCASE
  405.  
  406.      CASE nChoice == MenuChoice( aMenu )
  407.         //....Item is current choice
  408.         //....Show item in bold color
  409.         IF ItemIsActive( aMenu, nChoice )
  410.            SETCOLOR( itembold( aMenu[nChoice + 1,maCOLOR] ) )
  411.         ELSE
  412.            SETCOLOR( itemoffbold( aMenu[nChoice + 1,maCOLOR] ) )
  413.         ENDIF
  414.         @ nRow, nCol SAY aMenu[nChoice + 1,maCHOICE]
  415.   
  416.      CASE (.NOT. ItemIsActive( aMenu, nChoice ))
  417.         //....Item not selectable
  418.         //....Show item in inactive color
  419.         SETCOLOR( itemoffnorm( aMenu[nChoice + 1,maCOLOR] ) )
  420.         @ nRow, nCol SAY aMenu[nChoice + 1,maCHOICE]
  421.     
  422.      OTHERWISE
  423.         //....Normal menu item  
  424.       
  425.         IF aMenu[ nChoice + 1, maIMAGE] == NIL
  426.            //....Show item in normal color
  427.            SETCOLOR( itemnorm( aMenu[nChoice + 1,maCOLOR] ) )
  428.            @ nRow, nCol SAY aMenu[nChoice + 1,maCHOICE]
  429.         
  430.            //....Write over hotkey letter with letter in appropriate color
  431.            SETCOLOR( itemletter( aMenu[nChoice + 1,maCOLOR] ) )
  432.            @ nRow, (nCol+aMenu[nChoice + 1,maKEYPOS]-1) SAY aMenu[nChoice + 1,maHOTKEY]
  433.         
  434.            aMenu[nChoice + 1,maIMAGE] := SAVESCREEN( nRow, nCol, ;
  435.                        nRow, nCol + LEN( aMenu[nChoice + 1,maCHOICE] ) - 1 ) 
  436.         ELSE
  437.            RESTSCREEN( nRow, nCol, ;
  438.                        nRow, nCol + LEN( aMenu[nChoice + 1,maCHOICE] ) - 1, ;
  439.                        aMenu[nChoice + 1, maIMAGE ] )
  440.         ENDIF
  441.         
  442.    ENDCASE
  443.  
  444.    SETCOLOR(cOldColor)
  445.  
  446.    RETURN aMenu
  447.  
  448.  
  449. //....ItemMark: Set choice to current choice and highlight it
  450. //....
  451. //....ItemMark( <aMenu>, <nChoice> ) ---> aMenu
  452. //....
  453. FUNCTION ItemMark( aMenu, nChoice )
  454.  
  455.    LOCAL nRow, nCol, nOldChoice
  456.    LOCAL cOldColor
  457.  
  458.    nOldChoice := MenuChoice( aMenu )
  459.  
  460.    //....Set item to current item
  461.    aMenu[ 1, mahCHOICE ] := nChoice
  462.  
  463.    IF nOldChoice != NIL
  464.       ItemShow( aMenu, nOldChoice )
  465.    ENDIF
  466.  
  467.    ItemShow( aMenu, nChoice )
  468.  
  469.    RETURN aMenu
  470.  
  471.  
  472. //....DRAWOUTLINE: Draw outline of menu w/ appropriate border
  473. //....
  474. //....drawoutline( <aMenu> ) ---> aMenu
  475. //....
  476. STATIC FUNCTION DrawOutline( aMenu )
  477.  
  478.    LOCAL cOldColor
  479.    LOCAL nRow, nCol, nEndRow, nEndCol
  480.  
  481.    cOldColor := SETCOLOR()
  482.    nRow := aMenu[ 1, mahROW ]
  483.    nCol := aMenu[ 1, mahCOL ]
  484.    nEndRow := nRow + aMenu[ 1, mahLENGTH ] - 1
  485.    nEndCol := nCol + aMenu[ 1, mahWIDTH ] - 1
  486.  
  487.    SETCOLOR( aMenu[ 1, mahCOLOR ] )
  488.  
  489.    @ nRow, nCol CLEAR TO nEndRow, nEndCol
  490.  
  491.    DO CASE
  492.       CASE aMenu[ 1, mahBORDER ] == omSINGLE
  493.          @ nRow, nCol TO nEndRow, nEndCol
  494.       CASE aMenu[ 1, mahBORDER ] == omDOUBLE
  495.          @ nRow, nCol TO nEndRow, nEndCol DOUBLE
  496.    ENDCASE
  497.  
  498.    RETURN aMenu
  499.  
  500.  
  501. //....MENUSETREQ: Set last action
  502. //....
  503. //....MenuSetReq( <aMenu>, <nAction> ) ---> aMenu
  504. //....
  505. FUNCTION MenuSetReq( aMenu, nAction )
  506.  
  507.    aMenu[ 1, mahLASTREQ ] := nAction
  508.  
  509.    RETURN aMenu
  510.  
  511.  
  512. //....MENUEXIT:  Exit Menu
  513. //....
  514. //....MenuExit( <aMenu> ) ---> aMenu
  515. //....
  516. FUNCTION MenuExit( aMenu ) 
  517.  
  518.    MenuSetReq( aMenu, omEXIT )
  519.  
  520.    RETURN( aMenu )
  521.  
  522.  
  523. //....MENUABORT:  Exit Menu and clear choice
  524. //....
  525. //....MenuAbort( <aMenu> ) ---> aMenu
  526. //....
  527. FUNCTION MenuAbort( aMenu ) 
  528.  
  529.    aMenu[1, mahCHOICE] := 0
  530.    MenuSetReq( aMenu, omEXIT )
  531.  
  532.    RETURN( aMenu )
  533.  
  534.  
  535. //....MenuLastReq:    RETURN last action
  536. //....
  537. //....MenuLastReq( <aMenu> ) ---> nAction
  538. //....
  539. STATIC FUNCTION MenuLastReq( aMenu )
  540.    RETURN( aMenu[ 1, mahLASTREQ ] )
  541.  
  542.  
  543. //....MENUCHOICE:    RETURN current choice
  544. //....
  545. //....menuchoice( <aMenu> ) ---> nChoice
  546. //....
  547. FUNCTION MenuChoice( aMenu )
  548.    RETURN( aMenu[ 1, mahCHOICE ] )
  549.  
  550.  
  551. //....DOIDLEEVENTS: Do Idle events, called once every second
  552. //....
  553. //....DoIdleEvents( aMenu, nSecsElapsed ) ---> aMenu
  554. //....
  555. //....NOTE: An event will be called every MOD of its elapsed value
  556. //....
  557. //....Only one event will be called per pass, if there is more than one
  558. //....the first one will be called
  559. //....
  560. STATIC FUNCTION doidleevents( aMenu, nSecsElapsed )
  561.  
  562.    LOCAL aIdleEvents := aMenu[ 1, mahIDLE ]
  563.    LOCAL i := 1, nNumEvents
  564.    LOCAL lExit := .F. 
  565.  
  566.    #ifdef DEBUG
  567.       @ 20,0
  568.       @ 20,0 say 'Idle: ' + ltrim(str(nSecsElapsed))
  569.    #endif
  570.  
  571.    IF (nNumEvents := len(aIdleEvents)) == 0
  572.       lExit := .T.
  573.    ENDIF
  574.  
  575.    DO WHILE (.NOT. lExit) .AND. i <= nNumEvents
  576.       IF (nSecsElapsed % aIdleEvents[i, 1]) == 0
  577.          #ifdef DEBUG
  578.             ?? ' Matched Event: ' + ltrim(str(i))
  579.          #endif
  580.  
  581.          lExit = .T.
  582.  
  583.          SET CURSOR ON
  584.          EVAL( aIdleEvents[i,2], aMenu, nSecsElapsed )
  585.          SET CURSOR OFF
  586.       ENDIF
  587.       i++
  588.    ENDDO
  589.      
  590.    RETURN( aMenu )
  591.  
  592.  
  593. //....DOKEYEVENTS: Do Key events, called once every time a key is hit
  594. //....
  595. //....DoKeyEvents( aMenu, nKey ) ---> aMenu
  596. //....
  597. //....NOTE: If key multiply defined, it will only be called once, and an
  598. //....      event with a key value of NIL will be called if no other
  599. //....      events match.
  600. //....
  601. STATIC FUNCTION dokeyevents( aMenu, nKey )
  602.  
  603.    LOCAL aKeyEvents := aMenu[ 1, mahKEYS ]
  604.    LOCAL nCurrEvent, nChoice
  605.    LOCAL lExit := .F.
  606.  
  607.    //....Check for Menu Item Keys first
  608.    nChoice := ASCAN( aMenu, ;
  609.             {|x| IIF(x[maCHOICE] == '-', .F., IIF(x[maACTIVE], ;
  610.                     (UPPER(x[maHOTKEY]) == UPPER(CHR(nKey))), .F.) )}, 2 )
  611.    IF nChoice != 0
  612.       ItemMark( aMenu, nChoice - 1 )
  613.       MenuDoAction( aMenu )
  614.    ELSE
  615.       //....If not one of the hotkeys, handle regular key events
  616.       IF (nCurrEvent := ASCAN( aKeyEvents, {|x| x[1] == nKey} )) == 0
  617.          //....Not any defined key so find NIL and execute it
  618.          //....Replace with ascan when ascan will find NILs
  619.          nCurrEvent := 1
  620.          DO WHILE ( .NOT. lExit ) .AND. ( nCurrEvent <= LEN( aKeyEvents ) )
  621.             IF aKeyEvents[ nCurrEvent, 1 ] == NIL
  622.                SET CURSOR ON
  623.                EVAL( aKeyEvents[nCurrEvent,2], aMenu, nKey )
  624.                SET CURSOR OFF
  625.  
  626.                lExit := .T.
  627.             ENDIF
  628.  
  629.             nCurrEvent++
  630.          ENDDO
  631.       ELSE
  632.          SET CURSOR ON
  633.          EVAL( aKeyEvents[nCurrEvent,2], aMenu, nKey )
  634.          SET CURSOR OFF
  635.       ENDIF
  636.    ENDIF
  637.      
  638.    RETURN( aMenu )
  639.  
  640.  
  641. //....MENUDOACTION: Do code block associated with current choice
  642. //....
  643. //....MenuDoAction( <aMenu> ) ---> aMenu
  644. //....
  645. FUNCTION MenuDoAction( aMenu )
  646.  
  647.    IF ItemIsActive( aMenu, MenuChoice( aMenu ) )
  648.       EVAL( aMenu[MenuChoice( aMenu )+1,maACTION], aMenu )
  649.    ENDIF
  650.  
  651.    RETURN( aMenu )
  652.  
  653.  
  654. //....MENUACTIVATE: Display and "turn on" menu
  655. //....
  656. //....MenuActivate( <aMenu>, [<nChoice>] ) ---> aMenu
  657. //....
  658. FUNCTION MenuActivate( aMenu, nChoice )
  659.  
  660.    LOCAL nCurrTime, nLastTime, nCtrlTime, nKey
  661.    LOCAL cScreen
  662.    LOCAL i
  663.  
  664.    IF nChoice == NIL
  665.       nChoice := 1
  666.    ENDIF
  667.  
  668.    SAVE SCREEN TO cScreen
  669.    SET CURSOR OFF
  670.  
  671.    aMenu[1,mahCHOICE] := NIL
  672.    drawoutline( aMenu )
  673.    FOR i := 1 TO menulen( aMenu )
  674.       ItemShow( aMenu, i )
  675.    NEXT
  676.    ItemMark( aMenu, nChoice )
  677.  
  678.    nCtrlTime := nLastTime := INT( SECONDS() )
  679.    MenuSetReq( aMenu, omCONT )
  680.  
  681.    DO WHILE MenuLastReq( aMenu ) == omCONT
  682.       nKey = INKEY()
  683.       IF nKey != 0
  684.          DoKeyEvents( aMenu, nKey )
  685.  
  686.          //....Reset idle time counter
  687.          nCtrlTime := nLastTime := INT( SECONDS() )
  688.       ENDIF
  689.  
  690.       IF MenuLastReq( aMenu ) == omCONT
  691.          //....Handle Idle Events
  692.  
  693.          //....Make sure that we are getting EXACTLY one second resolution
  694.          //....so that no events are skipped and we don't check for idle
  695.          //....events too often
  696.          nCurrTime := INT( SECONDS() )
  697.          IF nCurrTime >= (nCtrlTime+1)
  698.             nCurrTime := (nCtrlTime+1)
  699.  
  700.             DoIdleEvents( aMenu, nCurrTime-nLastTime )
  701.  
  702.             //....Move forward one second
  703.             nCtrlTime := nCurrTime
  704.          ENDIF
  705.       ENDIF
  706.    ENDDO
  707.  
  708.    RESTORE SCREEN FROM cScreen
  709.    SET CURSOR ON
  710.  
  711.    RETURN( aMenu )
  712.  
  713.  
  714. //....MENUDOWN: Move to next option down the list
  715. //....
  716. //....MenuDown( <aMenu> ) ---> aMenu
  717. //....
  718. FUNCTION MENUDOWN( aMenu )
  719.  
  720.    LOCAL nOldChoice := MenuChoice( aMenu )
  721.    LOCAL nNewChoice
  722.  
  723.    SET CURSOR OFF
  724.  
  725.    nNewChoice := nOldChoice + 1
  726.  
  727.    IF MenuChoice( aMenu ) == menulen( aMenu )
  728.       IF clpWRAP
  729.          ItemMark( aMenu, 1 )
  730.          ItemShow( aMenu, nOldChoice )
  731.       ENDIF
  732.    ELSE
  733.       DO WHILE ItemIsLine( aMenu, nNewChoice )
  734.          nNewChoice++
  735.       ENDDO
  736.       ItemMark( aMenu, nNewChoice )
  737.       ItemShow( aMenu, nOldChoice )
  738.    ENDIF
  739.  
  740.    SET CURSOR ON
  741.  
  742.    RETURN( aMenu )
  743.  
  744.  
  745. //....MENUUP: Move to next option up the list
  746. //....
  747. //....menuup( <aMenu> ) ---> aMenu
  748. //....
  749. FUNCTION MENUUP( aMenu )
  750.  
  751.    LOCAL nOldChoice := MenuChoice( aMenu )
  752.    LOCAL nNewChoice
  753.  
  754.    SET CURSOR OFF
  755.  
  756.    nNewChoice := nOldChoice - 1
  757.  
  758.    IF MenuChoice( aMenu ) == 1
  759.       IF clpWRAP
  760.          ItemMark( aMenu, menulen( aMenu ) )
  761.          ItemShow( aMenu, nOldChoice )
  762.       ENDIF
  763.    ELSE
  764.       DO WHILE ItemIsLine( aMenu, nNewChoice )
  765.          nNewChoice--
  766.       ENDDO
  767.       ItemMark( aMenu, nNewChoice )
  768.       ItemShow( aMenu, nOldChoice )
  769.    ENDIF
  770.  
  771.    SET CURSOR ON
  772.  
  773.    RETURN( aMenu )
  774.