home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / SAMPLE.LIF / OMENU.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  36.8 KB  |  1,473 lines

  1. /***
  2. *  Omenu.prg
  3. *  Pull-down menu system that hierachical submenus, grayed items, and
  4. *  checked items.
  5. *
  6. *  Copyright (c) 1990 Nantucket Corp.  All rights reserved
  7. *
  8. *  Notes:  Compile with RMAKE OMENU.RMK
  9. *          See Omenu.doc for usage information; Odemo1.prg and Odemo2.prg
  10. *          for usage examples.
  11. *
  12. */
  13.  
  14. // Public functions
  15.  
  16. //  BarActivate( <hBar>, [<nKey>] ) --> nMenuChoice
  17. //  Activate bar menu as primary task (nothing else active)
  18.  
  19. //  BarDeInstall( <hBar> ) --> hBar
  20. //  Uninstall menubar from SET KEY handler
  21.  
  22. //  BarDisplay( <hBar> ) --> hBar
  23. //  Display a menubar to the screen
  24.  
  25. //  BarInstall( <hBar> ) --> hBar
  26. //  Install a menubar into the SET KEY handler
  27.  
  28. //  BarMenuChoice( <hBar>, [<nChoice>] ) --> nChoice
  29. // 
  30.  
  31. //  BarNew( <cColor>, <nBorder> ) --> hBar
  32. //  Create a new menubar and return a handle to it
  33.  
  34. //  MenuAdd( <hBar>, <hMenu> ) --> hBar
  35. //  Add a menu to menubar
  36.  
  37. //  MenuDisplay( <hMenu> ) --> hMenu
  38. //  Display a menu to the screen
  39.  
  40. //  MenuNew( <cTitle> ) --> hMenuHandle
  41. //  Create a new menu and return a new handle to it
  42.  
  43. //  PostExitBlock( [<bBlock>] ) --> bOldBlock
  44. //  Post a code block to execute when a function is terminated
  45.  
  46. //  PromptAction( <hMenu>, <nID>, <bBlock> ) --> hMenu
  47. //  Change the menu action block
  48.  
  49. //  PromptAdd( <hMenu>, <nID>, <cText>, <bBlock> ) --> hMenu
  50. //  Add a prompt to the menu
  51.  
  52. //  PromptAddLine( <hMenu> ) --> hMenu
  53. //  Add a line separator between prompts
  54.  
  55. //  PromptAddSub( <hMenu>, <nID>, <hSubMenu> ) --> hMenu
  56. //  Add a hierarchical submenu to an existing menu
  57.  
  58. //  PromptAddToggle( <hMenu>, <nID>, <cText>, <bBlock> ) --> hMenu
  59. //
  60. //  Has to be separate from PromptAdd() because of needing to add <bBlock> to
  61. //  key event array
  62.  
  63. //  PromptCheck( <hMenu>, <nID> ) --> hMenu
  64. //  Mark a menu prompt with a check mark
  65.  
  66. //  PromptEnable( <hMenu>, <nID> ) --> hMenu
  67. //  Ungray a menu prompt
  68.  
  69. //  PromptGray( <hMenu>, <nID> ) --> hMenu
  70. //  Gray a menu prompt
  71.  
  72. //  PromptIsChecked( <hMenu>, <nID> ) --> lChecked
  73. //  Determine if a menu prompt is checked
  74.  
  75. //  PromptIsEnabled( <hMenu>, <nID> ) --> lEnabled
  76. //  Determine if a menu prompt is active
  77.  
  78. //  PromptQuickKey( <hBar>, <hMenu>, <nID>, <nKey> ) --> hMenu
  79. //  Assign nKey to nID
  80.  
  81. //  PromptUnCheck( <hMenu>, <nID> ) --> hMenu
  82. //  Uncheck menu prompt
  83.  
  84. // Includes
  85. #include "Omenu.ch"
  86. #include "Inkey.ch"
  87. #include "Array.ch"
  88. #include "Error.ch"
  89.  
  90. // Default colors for menus
  91. #define OM_DEFBW   "N/W,W+/W,W+/N,N/W,W/N"
  92. #define OM_DEFCLR  "N/BG,R/BG,W+/R,W/BG,W/R"
  93.  
  94. // Color Positions/Prompt Status
  95. #define OM_NORM    1             // Normal
  96. #define OM_LETTER  2             // Letter 
  97. #define OM_NORMHI  3             // Highlighted normal
  98. #define OM_GRAY    4             // Inactive
  99. #define OM_GRAYHI  5             // Highlighted inactive
  100.  
  101. // Status (numbers have no meaning)
  102. #define OM_EXIT    -1101
  103. #define OM_BAROUT  -1102
  104. #define OM_BARIN   -1103
  105. #define OM_BARLT   -1104
  106. #define OM_BARRT   -1105
  107. #define OM_ESC     -1106
  108.  
  109. // Default border setting
  110. #define OM_DEFBORD OM_SINGLE
  111.  
  112. // Amount of spaces to "pad" around menu Prompts
  113. #define OM_PAD     2
  114.  
  115. // Hotkey indicator
  116. #define OM_HKCHAR "~" 
  117.  
  118. // Line for menus
  119. #define OM_LINECHR    CHR(196)
  120. #define OM_LTSGLLINE  CHR(195) 
  121. #define OM_RTSGLLINE  CHR(180)
  122. #define OM_LTDBLLINE  CHR(199)
  123. #define OM_RTDBLLINE  CHR(182)
  124.  
  125. #define OM_CHKCHAR    CHR(251)   // Checked indicator
  126. #define OM_SUBCHAR    CHR(16)    // Submenu indicator
  127.  
  128. // Positions in Bar Array Header
  129. #define BA_LEN     8             // Length of array
  130.  
  131. #define BA_OUTKEYS 1             // Global Keys (keys accessed from 
  132.                                  // outside menu)
  133. #define BA_INKEYS  2             // Local Keys (keys accessed from inside menu)
  134. #define BA_CHOICE  3
  135. #define BA_MENUS   4
  136. #define BA_COLOR   5
  137. #define BA_BORDER  6
  138. #define BA_LASTREQ 7
  139. #define BA_MCHOICE 8             // Last Menu Choice
  140.  
  141. //.Positions in Menu Array Header
  142. #define MA_LEN     17            // Length of array
  143.  
  144. #define MA_ROW     1
  145. #define MA_COL     2
  146. #define MA_LASTROW 3
  147. #define MA_LASTCOL 4
  148. #define MA_WIDTH   5
  149. #define MA_KEYS    6
  150. #define MA_CHOICE  7
  151. #define MA_ITEMS   8
  152. #define MA_TITLE   9
  153. #define MA_TTLROW  10
  154. #define MA_TTLCOL  11
  155. #define MA_HOTKEY  12            // Key that is "underlined" in title
  156. #define MA_KEYPOS  13            // Where that key is
  157. #define MA_BLOCK   14            // Block to execute
  158. #define MA_LASTREQ 15
  159. #define MA_OWNER   16            // What bar owns me?
  160. #define MA_SAVESCR 17            // Keep track of what I am covering
  161.  
  162. // Positions in Prompt Array
  163. #define IA_LEN       11          // Length of this array
  164.  
  165. #define IA_ROW       1
  166. #define IA_COL       2
  167. #define IA_TEXT      3
  168. #define IA_ID        4   
  169. #define IA_ACTIVE    5
  170. #define IA_CHECKED   6
  171. #define IA_SUBMENU   7           // Is the the title of a submenu
  172. #define IA_HOTKEY    8           // Key that is "underlined"
  173. #define IA_KEYPOS    9           // Where that key is
  174. #define IA_BLOCK     10          // Block to execute
  175. #define IA_2NDBLOCK  11          // Secondary Block to execute (from IA_BLOCK)
  176.  
  177. // Global holders 
  178. STATIC saBar := {}
  179. STATIC saMenu := {}
  180. STATIC sbExitBlock := NIL
  181. STATIC shCurrBar := NIL
  182.  
  183. /***
  184. *  NilScan()
  185. *  Temporary fix for ASCAN()
  186. *
  187. */
  188. STATIC FUNCTION NilScan( aArray )
  189.    LOCAL x := 1
  190.  
  191.    DO WHILE ( x <= LEN(aArray) ) .AND. ( aArray[x] != NIL )
  192.       x++
  193.    ENDDO
  194.  
  195.    RETURN( IIF( x > LEN(aArray), 0, x ) )
  196.  
  197.  
  198. /***
  199. *  ATrueDel()
  200. *
  201. */
  202. STATIC FUNCTION ATrueDel( aArray, nElement )
  203.  
  204.    ADEL( aArray, nElement )
  205.    ASIZE( aArray, LEN( aArray ) - 1 )
  206.  
  207.    RETURN( aArray )
  208.  
  209.  
  210. /***
  211. *  PromptFind()
  212. *
  213. */
  214. STATIC FUNCTION PromptFind( hMenu, nID )
  215.    RETURN( ASCAN( saMenu[hMenu][MA_ITEMS], {|aPrompt| aPrompt[IA_ID] == nID} ) )
  216.  
  217.  
  218. /***
  219. *  ForceExit() --> NIL
  220. *  Execute ExitBlock to allow exit from reads, etc.
  221. *
  222. */
  223. STATIC FUNCTION ForceExit( hMenu )
  224.  
  225.    IF sbExitBlock != NIL
  226.       EVAL( sbExitBlock )
  227.    ENDIF
  228.  
  229.    RETURN( NIL )
  230.  
  231.  
  232. /***
  233. *  BarDispPrompt( <hBar>, <nItem> ) --> hBar
  234. *  Display prompt in proper color string for status
  235. *
  236. */
  237. STATIC FUNCTION BarDispPrompt( hBar, nItem )
  238.    LOCAL cSaveColor
  239.    LOCAL nSaveRow, nSaveCol
  240.    LOCAL aMenu
  241.    LOCAL cText
  242.    LOCAL nStatus, lLetter := .F.
  243.  
  244.    cSaveColor := SETCOLOR()
  245.    nSaveRow   := ROW()
  246.    nSaveCol   := COL()
  247.  
  248.    aMenu := saMenu[ saBar[hBar][BA_MENUS][nItem] ] 
  249.    cText := aMenu[MA_TITLE]
  250.  
  251.    IF BarChoice(hBar) == nItem
  252.       nStatus := OM_NORMHI
  253.    ELSE
  254.       nStatus := OM_NORM
  255.       lLetter := .T.
  256.    ENDIF
  257.  
  258.    // Establish base text first and write letter over if necessary
  259.    SETCOLOR( saBar[hBar][BA_COLOR][nStatus] )
  260.    @ aMenu[MA_TTLROW], aMenu[MA_TTLCOL] SAY cText
  261.  
  262.    IF lLetter
  263.       // Write over hotkey letter with letter in appropriate color
  264.       SETCOLOR( saBar[hBar][BA_COLOR][OM_LETTER] )
  265.       @ aMenu[MA_TTLROW], (aMenu[MA_TTLCOL] + aMenu[MA_KEYPOS] - 1) SAY aMenu[MA_HOTKEY]
  266.    ENDIF
  267.  
  268.    SETCOLOR( cSaveColor )
  269.    SETPOS( nSaveRow, nSaveCol )
  270.    
  271.    RETURN( hBar )
  272.  
  273.  
  274. /***
  275. *  MenuDispPrompt( <hMenu>, <nItem> ) --> hMenu
  276. *  Display prompt in proper color string for status
  277. *
  278. */
  279. STATIC FUNCTION MenuDispPrompt( hMenu, nItem )
  280.    LOCAL cSaveColor
  281.    LOCAL nSaveRow, nSaveCol
  282.    LOCAL nRow, nCol
  283.    LOCAL hBar
  284.    LOCAL aItem
  285.    LOCAL cText
  286.    LOCAL nStatus, lLetter := .F.
  287.  
  288.    cSaveColor := SETCOLOR()
  289.    nSaveRow   := ROW()
  290.    nSaveCol   := COL()
  291.  
  292.    hBar  := saMenu[hMenu][MA_OWNER]
  293.    aItem := saMenu[hMenu][MA_ITEMS][nItem] 
  294.  
  295.    // Temporary hold row and column so they can be adjusted
  296.    nRow  := aItem[IA_ROW]
  297.    nCol  := aItem[IA_COL]
  298.  
  299.    // Special handling for lines
  300.    IF ItemIsLine( hMenu, nItem )
  301.       cText := REPLICATE( OM_LINECHR, saMenu[hMenu][MA_WIDTH] )
  302.  
  303.       nCol--
  304.       DO CASE
  305.       CASE saBar[hBar][BA_BORDER] == OM_SINGLE
  306.          cText := OM_LTSGLLINE + cText + OM_RTSGLLINE
  307.       CASE saBar[hBar][BA_BORDER] == OM_DOUBLE
  308.          cText := OM_LTDBLLINE + cText + OM_RTDBLLINE
  309.       OTHERWISE
  310.          cText := OM_LINECHR + cText + OM_LINECHR
  311.       ENDCASE
  312.       // Border is in letter color
  313.       nStatus := OM_LETTER
  314.    ELSE
  315.       cText := PADR( aItem[IA_TEXT], saMenu[hMenu][MA_WIDTH] )
  316.  
  317.       IF aItem[IA_CHECKED]
  318.          cText := STUFF(cText, 1, LEN(OM_CHKCHAR), OM_CHKCHAR)
  319.       ENDIF
  320.  
  321.       IF aItem[IA_SUBMENU] != NIL
  322.          cText := STUFF(cText, 1, LEN(OM_SUBCHAR), OM_SUBCHAR)
  323.       ENDIF
  324.  
  325.       IF MenuChoice(hMenu) == nItem
  326.          IF aItem[IA_ACTIVE]
  327.             nStatus := OM_NORMHI
  328.          ELSE
  329.             nStatus := OM_GRAYHI
  330.          ENDIF
  331.       ELSE
  332.          IF aItem[IA_ACTIVE]
  333.             nStatus := OM_NORM
  334.             lLetter := .T.
  335.          ELSE
  336.             nStatus := OM_GRAY
  337.          ENDIF
  338.       ENDIF
  339.    ENDIF
  340.  
  341.    // establish base text first and write letter over if necessary
  342.    SETCOLOR( saBar[hBar][BA_COLOR][nStatus] )
  343.    @ nRow, nCol SAY cText
  344.  
  345.    IF lLetter
  346.       // Write over hotkey letter with letter in appropriate color
  347.       SETCOLOR( saBar[hBar][BA_COLOR][OM_LETTER] )
  348.       @ aItem[IA_ROW], (aItem[IA_COL] + aItem[IA_KEYPOS] - 1) SAY aItem[IA_HOTKEY]
  349.    ENDIF
  350.  
  351.    SETCOLOR( cSaveColor )
  352.    SETPOS( nSaveRow, nSaveCol )
  353.    
  354.    RETURN( hMenu )
  355.  
  356.  
  357. /***
  358. *  BarOutKeys( <hBar> ) --> aArray
  359. *
  360. */
  361. STATIC FUNCTION BarOutKeys( hBar )
  362.    LOCAL aArray := {}
  363.  
  364.    AADD( aArray, { K_F10, {|hBar| BarSetItem( hBar, 1 ), BarLastReq( hBar, OM_BARIN ) }, hBar } )
  365.  
  366.    RETURN( aArray )
  367.  
  368.  
  369. /***
  370. *  BarInKeys( <hBar> ) --> aArray
  371. *
  372. */
  373. STATIC FUNCTION BarInKeys( hBar )
  374.    LOCAL aArray := {}
  375.  
  376.    AADD( aArray, { K_LEFT,  {|hBar| BarLeft(hBar) }, hBar } )
  377.    AADD( aArray, { K_RIGHT, {|hBar| BarRight(hBar) }, hBar } )
  378.    AADD( aArray, { K_ENTER, {|hBar| BarExecute(hBar) }, hBar } )
  379.    AADD( aArray, { K_ESC,   {|hBar| BarSetItem(hBar, NIL), BarLastReq( hBar, OM_BAROUT ) }, hBar } )
  380.    AADD( aArray, { NIL,     {|nKey| IF( SET(_SET_BELL), QQOUT(CHR(7)), NIL ) } } )
  381.  
  382.    RETURN( aArray )
  383.  
  384.  
  385. /***
  386. *  MenuKeys( <hMenu> ) --> aArray
  387. *
  388. */
  389. STATIC FUNCTION MenuKeys( hMenu ) 
  390.    LOCAL aArray := {}
  391.  
  392.    AADD( aArray, { K_UP,    {|hMenu| MenuUp( hMenu ) }, hMenu } )
  393.    AADD( aArray, { K_DOWN,  {|hMenu| MenuDown( hMenu ) }, hMenu } )
  394.    AADD( aArray, { K_ENTER, {|hMenu| MenuExecute( hMenu ) }, hMenu } )
  395.    AADD( aArray, { K_LEFT,  {|hMenu| BarLastReq( saMenu[hMenu][MA_OWNER], OM_BARLT ) }, hMenu } )
  396.    AADD( aArray, { K_RIGHT, {|hMenu| BarLastReq( saMenu[hMenu][MA_OWNER], OM_BARRT ) }, hMenu } )
  397.    AADD( aArray, { K_ESC,   {|hMenu| MenuSetItem(hMenu, NIL ), ;
  398.                                      BarSetItem( saMenu[hMenu][MA_OWNER], NIL ), ;
  399.                                      BarLastReq( saMenu[hMenu][MA_OWNER], OM_EXIT ) }, hMenu } )
  400.    AADD( aArray, { NIL,     {|nKey| IF( SET(_SET_BELL), QQOUT(CHR(7)), NIL ) } } )
  401.  
  402.    RETURN( aArray )
  403.  
  404.  
  405. /***
  406. *  BarChoice( <hBar> ) --> nChoice
  407. *
  408. */
  409. STATIC FUNCTION BarChoice( hBar )
  410.    RETURN( saBar[hBar][BA_CHOICE] )
  411.  
  412.  
  413. /***
  414. *  BarLeft( <hBar> ) --> hBar
  415. *
  416. */
  417. STATIC FUNCTION BarLeft( hBar )
  418.  
  419.    IF BarChoice( hBar ) == 1
  420.       IF SET(_SET_WRAP)
  421.          BarSetItem( hBar, LEN(saBar[hBar][BA_MENUS]) )
  422.       ENDIF
  423.    ELSE
  424.       BarSetItem( hBar, BarChoice( hBar ) - 1 )
  425.    ENDIF
  426.  
  427.    RETURN( hBar )
  428.  
  429.  
  430. /***
  431. *  BarRight( <hBar> ) --> hBar
  432. *
  433. */
  434. STATIC FUNCTION BarRight( hBar )
  435.  
  436.    IF BarChoice( hBar ) == LEN(saBar[hBar][BA_MENUS])
  437.       IF SET(_SET_WRAP)
  438.          BarSetItem( hBar, 1 )
  439.       ENDIF
  440.    ELSE
  441.       BarSetItem( hBar, BarChoice( hBar ) + 1 )
  442.    ENDIF
  443.  
  444.    RETURN( hBar )
  445.  
  446.  
  447. /***
  448. *  BarActOn( <nKey> ) --> NIL
  449. *
  450. */
  451. STATIC FUNCTION BarActon( nKey )
  452.  
  453.    // Requires that currbar be set correctly
  454.    BarActivate( shCurrBar, nKey )
  455.  
  456.    RETURN( NIL )
  457.  
  458.  
  459. /***
  460. *  BarExecute( <hBar> ) --> hBar
  461. *
  462. */
  463. STATIC FUNCTION BarExecute( hBar )
  464.    LOCAL hMenu
  465.  
  466.    hMenu := saBar[hBar][BA_MENUS][BarChoice( hBar )]
  467.    EVAL( saMenu[hMenu][MA_BLOCK], hMenu )
  468.  
  469.    RETURN( hBar )
  470.  
  471.  
  472. /***
  473. *  BarAbort( <hBar> ) --> hBar
  474. *
  475. */
  476. STATIC FUNCTION BarAbort( hBar )
  477.  
  478.    BarLastReq( hBar, OM_EXIT )
  479.  
  480.    RETURN( BarSetItem( hBar, NIL ) )
  481.  
  482.  
  483. /***
  484. *  BarExit( <hBar> ) --> hBar
  485. *
  486. */
  487. STATIC FUNCTION BarExit( hBar )
  488.  
  489.    BarLastReq( hBar, OM_EXIT )
  490.  
  491.    RETURN( hBar )
  492.  
  493.  
  494. /***
  495. *  BarLastRequest( <hBar>, [<nReq>] ) --> nRequest
  496. *
  497. */
  498. STATIC FUNCTION BarLastRequest( hBar, nReq )
  499.  
  500.    IF nReq != NIL
  501.       saBar[hBar][BA_LASTREQ] := nReq
  502.    ENDIF
  503.  
  504.    RETURN( saBar[hBar][BA_LASTREQ] )
  505.  
  506.  
  507. /***
  508. *  BarSetItem( <hBar>, <nItem> ) --> hBar
  509. *
  510. */
  511. STATIC FUNCTION BarSetItem( hBar, nItem )
  512.    LOCAL aMenu
  513.    LOCAL nOldItem := saBar[hBar][BA_CHOICE]
  514.  
  515.    IF nItem != nOldItem
  516.       saBar[hBar][BA_CHOICE] := nItem
  517.  
  518.       IF nOldItem != NIL
  519.          // Redisplay old item unhighlighted
  520.          BarDispPrompt( hBar, nOldItem )
  521.       ENDIF            
  522.  
  523.       IF nItem != NIL
  524.          // Redisplay item highlighted
  525.          BarDispPrompt( hBar, nItem )
  526.       ENDIF
  527.    ENDIF
  528.  
  529.    RETURN( hBar )
  530.  
  531.  
  532. /***
  533. *  MenuLastRequest( <hMenu>, [<nReq>] ) --> nRequest
  534. *
  535. */
  536. STATIC FUNCTION MenuLastRequest( hMenu, nReq )
  537.  
  538.    IF nReq != NIL
  539.       saMenu[hMenu][MA_LASTREQ] := nReq
  540.    ENDIF
  541.  
  542.    RETURN( saMenu[hMenu][MA_LASTREQ] )
  543.  
  544.  
  545. /***
  546. *  MenuSetItem( <hMenu>, <nItem> ) --> hMenu
  547. *
  548. */
  549. STATIC FUNCTION MenuSetItem( hMenu, nItem )
  550.    LOCAL aItem
  551.    LOCAL nOldItem := saMenu[hMenu][MA_CHOICE]
  552.  
  553.    IF nItem != nOldItem
  554.       saMenu[hMenu][MA_CHOICE] := nItem
  555.  
  556.       IF nOldItem != NIL
  557.          // Redisplay old item unhighlighted
  558.          MenuDispPrompt( hMenu, nOldItem )
  559.       ENDIF            
  560.  
  561.       IF nItem != NIL
  562.          // Redisplay item highlighted
  563.          MenuDispPrompt( hMenu, nItem )
  564.       ENDIF
  565.    ENDIF
  566.  
  567.    RETURN( hMenu )                          
  568.  
  569.  
  570. /***
  571. *  MenuChoice( <hMenu> ) --> nChoice
  572. *
  573. */
  574. STATIC FUNCTION MenuChoice( hMenu )
  575.    RETURN( saMenu[hMenu][MA_CHOICE] )
  576.  
  577.  
  578. /***
  579. *  MenuUp( <hMenu> ) --> hMenu
  580. *
  581. */
  582. STATIC FUNCTION MenuUp( hMenu )
  583.    LOCAL nChoice 
  584.  
  585.    nChoice := MenuChoice( hMenu )
  586.    IF nChoice == 1
  587.       IF SET(_SET_WRAP)
  588.          MenuSetItem( hMenu, LEN(saMenu[hMenu][MA_ITEMS]) )
  589.       ENDIF
  590.    ELSE
  591.       nChoice--
  592.       DO WHILE ( ItemIsLine( hMenu, nChoice ) )
  593.          nChoice--
  594.       ENDDO
  595.       MenuSetItem( hMenu, nChoice )
  596.    ENDIF
  597.  
  598.    RETURN( hMenu )
  599.  
  600.  
  601. /***
  602. *  MenuDown( <hMenu> ) --> hMenu
  603. *
  604. */
  605. STATIC FUNCTION MenuDown( hMenu )
  606.    LOCAL nChoice
  607.  
  608.    nChoice := MenuChoice( hMenu )
  609.    IF nChoice == LEN(saMenu[hMenu][MA_ITEMS])
  610.       IF SET(_SET_WRAP)
  611.          MenuSetItem( hMenu, 1 )
  612.       ENDIF
  613.    ELSE
  614.       nChoice++
  615.       DO WHILE ( ItemIsLine( hMenu, nChoice ) )
  616.          nChoice++
  617.       ENDDO
  618.       MenuSetItem( hMenu, nChoice )
  619.    ENDIF
  620.  
  621.    RETURN( hMenu )
  622.  
  623.  
  624. /***
  625. *  MenuErase( <hMenu> ) --> hMenu
  626. *
  627. */
  628. STATIC FUNCTION MenuErase( hMenu )
  629.  
  630.    RESTSCREEN(saMenu[hMenu][MA_ROW], saMenu[hMenu][MA_COL], ;
  631.               saMenu[hMenu][MA_LASTROW], saMenu[hMenu][MA_LASTCOL], ;
  632.               saMenu[hMenu][MA_SAVESCR]);
  633.  
  634.    saMenu[hMenu][MA_SAVESCR] := ""  // Free up memory used
  635.    RETURN hMenu
  636.  
  637.  
  638. /***
  639. *  MenuExecute( <hMenu> ) --> hMenu
  640. *
  641. */
  642. STATIC FUNCTION MenuExecute( hMenu )
  643.    LOCAL hBar
  644.    LOCAL aItem
  645.  
  646.    hBar  := saMenu[hMenu][MA_OWNER]
  647.    aItem := saMenu[hMenu][MA_ITEMS][MenuChoice(hMenu)]
  648.  
  649.    IF aItem[IA_ACTIVE]
  650.       IF aItem[IA_BLOCK] == NIL
  651.          ForceExit(hMenu)
  652.          BarMenuChoice( hBar, aItem[IA_ID] )
  653.       ELSE
  654.          EVAL( aItem[IA_BLOCK], hMenu, aItem[IA_ID], aItem[IA_2NDBLOCK] )
  655.       ENDIF
  656.       BarLastReq( hBar, OM_EXIT )
  657.       BarSetItem( hBar, NIL )
  658.    ENDIF
  659.  
  660.    RETURN( hMenu )
  661.  
  662.  
  663. /***
  664. *  MenuActivate( <hMenu> ) --> hMenu
  665. *  Activate Menu menu as primary task (nothing else active)
  666. *
  667. */
  668. STATIC FUNCTION MenuActivate( hMenu )
  669.    LOCAL aActiveKeys
  670.    LOCAL nKey
  671.    LOCAL uResult
  672.    LOCAL nSaveCurs
  673.  
  674.    // Initialize
  675.    saMenu[hMenu][MA_CHOICE] := 1
  676.    BarLastReq( saMenu[hMenu][MA_OWNER], OM_BARIN )
  677.  
  678.    // Draw Menu
  679.    MenuDisplay( hMenu )
  680.  
  681.    nSaveCurs := SET(_SET_CURSOR)
  682.  
  683.    // Check to see if cursor in menu area. If so, turn it off
  684.    IF (ROW() >= saMenu[hMenu][MA_ROW]) .AND. ;
  685.       (ROW() <= saMenu[hMenu][MA_LASTROW]) .AND. ;
  686.       (COL() >= saMenu[hMenu][MA_COL]) .AND. ;
  687.       (COL() <= saMenu[hMenu][MA_LASTCOL])
  688.  
  689.       SET(_SET_CURSOR, 0)
  690.    ENDIF
  691.  
  692.  
  693.    // Handle keystrokes
  694.    DO WHILE BarLastReq( saMenu[hMenu][MA_OWNER] ) == OM_BARIN
  695.       nKey := INKEY(0)
  696.  
  697.       uResult := DoKeyEvents( saMenu[hMenu][MA_KEYS], nKey )
  698.    ENDDO
  699.  
  700.    // Restore Image that was under menu
  701.    MenuErase( hMenu )
  702.    SET(_SET_CURSOR, nSaveCurs)
  703.  
  704.    RETURN( hMenu )
  705.  
  706.  
  707. /***
  708. *  MenuSubActivate( <hMenu>, <nID> ) --> hMenu
  709. *  Activate Submenu menu as primary task (nothing else active)
  710. *
  711. */
  712. STATIC FUNCTION MenuSubActivate( hMenu, nID )
  713.    LOCAL nPrompt, aPrompt
  714.    LOCAL hSub
  715.  
  716.    IF ( (nPrompt := PromptFind( hMenu, nID )) > 0 )
  717.       aPrompt := saMenu[hMenu][MA_ITEMS][nPrompt]
  718.       hSub := aPrompt[IA_SUBMENU]
  719.       saMenu[hSub][MA_ROW] := aPrompt[IA_ROW]
  720.  
  721.       // Draw with small overlap
  722.       saMenu[hSub][MA_COL] := saMenu[hMenu][MA_LASTCOL] - 1
  723.  
  724.       // Same bar "owns" both menus
  725.       // Can't set this earlier because don't what bar owns it
  726.       saMenu[hSub][MA_OWNER] := saMenu[hMenu][MA_OWNER]
  727.  
  728.       MenuActivate( hSub )
  729.    ENDIF
  730.  
  731.    RETURN( hMenu )
  732.  
  733. /***
  734. *  ItemIsLine()
  735. *
  736. */
  737. STATIC FUNCTION ItemIsLine( hMenu, nItem )
  738.    RETURN( saMenu[hMenu][MA_ITEMS][nItem][IA_TEXT] == OM_LINECHR )
  739.  
  740. /***
  741. *  CheckIt()
  742. *  Used only by PromptAddToggle()
  743. *
  744. */
  745. STATIC FUNCTION CheckIt( hMenu, nID, bBlock )
  746.    LOCAL lChecked 
  747.    
  748.    IF (lChecked := PromptIsChecked(hMenu, nID))
  749.       PromptUnCheck(hMenu, nID)
  750.    ELSE
  751.       PromptCheck(hMenu, nID)
  752.    ENDIF
  753.  
  754.    IF bBlock != NIL
  755.       EVAL( bBlock, !lChecked )
  756.    ENDIF
  757.  
  758.    RETURN( hMenu )
  759.  
  760.  
  761. /***
  762. *  DoKeyEvents( <aKeys>, <nKey> ) ---> lKeyFound
  763. *
  764. *  Execute block associated with nKey if one exists and return .T.
  765. *  otherwise return .F.
  766. *
  767. *  aKeys is an array of arrays: { nKey, bBlock, [uParam list] }
  768. *
  769. */
  770. STATIC FUNCTION DoKeyEvents( aKeys, nKey )
  771.    LOCAL nCurrEvent
  772.    LOCAL lExit   := .F.
  773.    LOCAL lFound  := .F.
  774.  
  775.    // Force uppercase
  776.    IF nKey >= ASC('a') .and. nKey <= ASC('z')
  777.       nKey := ASC(UPPER(CHR(nKey)))
  778.    ENDIF
  779.  
  780.    IF (nCurrEvent := ASCAN( aKeys, {|x| x[1] == nKey} )) == 0
  781.       // Not any defined key so find NIL and execute it
  782.       nCurrEvent := 0
  783.       DO WHILE ( .NOT. lFound ) .AND. ( nCurrEvent < LEN( aKeys ) )
  784.          nCurrEvent++
  785.          IF aKeys[nCurrEvent, 1] == NIL
  786.             lFound := .T.
  787.          ENDIF
  788.       ENDDO
  789.       lExit :=  (!lFound)
  790.    ENDIF
  791.    IF .NOT. lExit
  792.  
  793.       // Handle up to five parameters
  794.       DO CASE
  795.       CASE LEN(aKeys[nCurrEvent]) == 2       /* 0 parameters */
  796.          EVAL( aKeys[nCurrEvent, 2], nKey )
  797.  
  798.       CASE LEN(aKeys[nCurrEvent]) == 3       /* 1 parameter  */
  799.          EVAL( aKeys[nCurrEvent, 2], aKeys[nCurrEvent, 3] )
  800.  
  801.       CASE LEN(aKeys[nCurrEvent]) == 4       /* 2 parameters */
  802.          EVAL( aKeys[nCurrEvent, 2], aKeys[nCurrEvent, 3], ;
  803.                                      aKeys[nCurrEvent, 4])
  804.  
  805.       CASE LEN(aKeys[nCurrEvent]) == 5       /* 3 parameters */
  806.          EVAL( aKeys[nCurrEvent, 2], aKeys[nCurrEvent, 3], ;
  807.                                      aKeys[nCurrEvent, 4], ;
  808.                                      aKeys[nCurrEvent, 5])
  809.  
  810.       CASE LEN(aKeys[nCurrEvent]) == 6       /* 4 parameters */
  811.          EVAL( aKeys[nCurrEvent, 2], aKeys[nCurrEvent, 3], ;
  812.                                      aKeys[nCurrEvent, 4], ;
  813.                                      aKeys[nCurrEvent, 5], ;
  814.                                      aKeys[nCurrEvent, 6])
  815.  
  816.       OTHERWISE
  817.          EVAL( aKeys[nCurrEvent, 2], aKeys[nCurrEvent, 3], ;
  818.                                      aKeys[nCurrEvent, 4], ;
  819.                                      aKeys[nCurrEvent, 5], ;
  820.                                      aKeys[nCurrEvent, 6], ;
  821.                                      aKeys[nCurrEvent, 7])
  822.  
  823.       ENDCASE
  824.  
  825.    ENDIF
  826.      
  827.    RETURN( !lExit )
  828.  
  829.  
  830. /***
  831. *  LetterAsAltKey( <nKey> ) ---> nAltKey
  832. *
  833. */
  834. STATIC FUNCTION LetterAsAltKey( nKey )
  835.    LOCAL nAltKey
  836.    // Conversion table
  837.    STATIC saRegAltKeys := { { 65, K_ALT_A }, ;
  838.                            { 66, K_ALT_B }, ;
  839.                            { 67, K_ALT_C }, ;
  840.                            { 68, K_ALT_D }, ;
  841.                            { 69, K_ALT_E }, ;
  842.                            { 70, K_ALT_F }, ;
  843.                            { 71, K_ALT_G }, ;
  844.                            { 72, K_ALT_H }, ;
  845.                            { 73, K_ALT_I }, ;
  846.                            { 74, K_ALT_J }, ;
  847.                            { 75, K_ALT_K }, ;
  848.                            { 76, K_ALT_L }, ;
  849.                            { 77, K_ALT_M }, ;
  850.                            { 78, K_ALT_N }, ;
  851.                            { 79, K_ALT_O }, ;
  852.                            { 80, K_ALT_P }, ;
  853.                            { 81, K_ALT_Q }, ;
  854.                            { 82, K_ALT_R }, ;
  855.                            { 83, K_ALT_S }, ;
  856.                            { 84, K_ALT_T }, ;
  857.                            { 85, K_ALT_U }, ;
  858.                            { 86, K_ALT_V }, ;
  859.                            { 87, K_ALT_W }, ;
  860.                            { 88, K_ALT_X }, ;
  861.                            { 89, K_ALT_Y }, ;
  862.                            { 90, K_ALT_Z } }
  863.  
  864.  
  865.    nKey    := ASC( UPPER( CHR(nKey) ) )  // Make sure it is uppercase
  866.    nAltKey := ASCAN( saRegAltKeys, {|x| x[1] == nKey} )
  867.  
  868.    RETURN( IIF( nAltKey > 0, saRegAltKeys[nAltKey, 2], 0 ) )
  869.  
  870.  
  871. /***
  872. *  PauseKey( <nSecs> ) --> nKey
  873. *  Similar to inkey(), except services SET KEYs
  874. *
  875. */
  876. STATIC FUNCTION PauseKey( nSecs )
  877.    LOCAL nKey
  878.    LOCAL bKeyBlock
  879.  
  880.    nKey := INKEY( nSecs )
  881.  
  882.    DO WHILE ( (bKeyBlock := SETKEY(nKey)) != NIL )
  883.       EVAL(bKeyBlock, PROCNAME(2), PROCLINE(2))
  884.       nKey := INKEY( nSecs )
  885.    ENDDO
  886.  
  887.    RETURN( nKey )
  888.  
  889. /***
  890. *  BarActivate( <hBar>, [<nKey>] ) --> nMenuChoice
  891. *  Activate bar menu as primary task (nothing else active)
  892. *
  893. */
  894. FUNCTION BarActivate( hBar, nKey )
  895.    LOCAL aActiveKeys
  896.    LOCAL nResult
  897.  
  898.    // Handle keystrokes
  899.    IF nKey != NIL
  900.       aActiveKeys := saBar[hBar][BA_OUTKEYS]
  901.       IF !DoKeyEvents( aActiveKeys, nKey )
  902.          BarLastReq( hBar, OM_EXIT )
  903.       ENDIF
  904.    ELSE
  905.       // Draw bar
  906.       BarDisplay( hBar )
  907.  
  908.       // Initialize
  909.       BarSetItem( hBar, NIL )
  910.       BarLastReq( hBar, OM_BAROUT )
  911.    ENDIF
  912.    DO WHILE BarLastReq( hBar ) != OM_EXIT
  913.       DO CASE
  914.       CASE BarLastReq( hBar ) == OM_BAROUT
  915.          aActiveKeys := saBar[hBar][BA_OUTKEYS]
  916.          nKey := INKEY(0)
  917.          DoKeyEvents( aActiveKeys, nKey )
  918.  
  919.       CASE BarLastReq( hBar ) == OM_BARIN
  920.          aActiveKeys := saBar[hBar][BA_INKEYS]
  921.          nKey := INKEY(0)
  922.          DoKeyEvents( aActiveKeys, nKey )
  923.  
  924.       CASE BarLastReq( hBar ) == OM_BARRT
  925.          BarLastReq( hBar, OM_BARIN )
  926.          BarRight( hBar )
  927.          BarExecute( hBar )
  928.  
  929.       CASE BarLastReq( hBar ) == OM_BARLT
  930.          BarLastReq( hBar, OM_BARIN )
  931.          BarLeft( hBar )
  932.          BarExecute( hBar )
  933.  
  934.       ENDCASE
  935.    ENDDO
  936.  
  937.    RETURN( BarMenuChoice( hBar ) )
  938.  
  939. /***
  940. *  BarDeInstall( <hBar> ) --> hBar
  941. *  Uninstall menubar from SET KEY handler
  942. *
  943. */
  944. FUNCTION BarDeInstall( hBar )
  945.    LOCAL i
  946.    LOCAL aKeys := saBar[hBar][BA_OUTKEYS]
  947.  
  948.    FOR i := 1 TO LEN( aKeys )
  949.       SETKEY( aKeys[i][1], NIL )
  950.    NEXT
  951.  
  952.    shCurrBar := NIL
  953.  
  954.    RETURN hBar
  955.  
  956. /***
  957. *  BarDisplay( <hBar> ) --> hBar
  958. *  Display a menubar to the screen
  959. *
  960. */
  961. FUNCTION BarDisplay( hBar )
  962.    LOCAL i
  963.    LOCAL nLen
  964.    LOCAL nCol := 1, nRow := 0
  965.    LOCAL aMenu
  966.    LOCAL cSaveColor, nSaveRow, nSaveCol
  967.  
  968.    nSaveRow   := ROW()
  969.    nSaveCol   := COL()
  970.    cSaveColor := SETCOLOR( saBar[hBar][BA_COLOR][OM_NORM] )
  971.  
  972.    @ nRow, 0 CLEAR TO nRow, MAXCOL()
  973.  
  974.    nLen := LEN(saBar[hBar][BA_MENUS])
  975.    FOR i := 1 TO nLen
  976.       // Put referential nature of arrays to good use
  977.       aMenu := saMenu[ saBar[hBar][BA_MENUS][i] ]
  978.  
  979.       // Make sure column will fit
  980.       IF ( nCol + LEN(aMenu[MA_TITLE]) ) > MAXCOL()
  981.          // Establish new row for menus
  982.          nRow++
  983.          nCol := 1
  984.          @ nRow, 0 CLEAR TO nRow, MAXCOL()
  985.       ENDIF
  986.  
  987.       aMenu[MA_TTLROW] := nRow
  988.       aMenu[MA_TTLCOL] := nCol
  989.       aMenu[MA_ROW]    := nRow + 1
  990.       aMenu[MA_COL]    := nCol - 1
  991.  
  992.       BarDispPrompt( hBar, i )
  993.       
  994.       nCol += LEN(aMenu[MA_TITLE])
  995.    NEXT
  996.    SETPOS(nSaveRow, nSaveCol)
  997.    SETCOLOR( cSaveColor )
  998.  
  999.    RETURN( hBar )
  1000.  
  1001. /***
  1002. *  BarInstall( <hBar> ) --> hBar
  1003. *  Install a menubar into the SET KEY handler
  1004. *
  1005. */
  1006. FUNCTION BarInstall( hBar )
  1007.    LOCAL i
  1008.    LOCAL aKeys := saBar[hBar][BA_OUTKEYS]
  1009.  
  1010.    FOR i := 1 TO LEN( aKeys )
  1011.       SETKEY( aKeys[i][1], {|| BarActOn(LASTKEY())} )
  1012.    NEXT
  1013.  
  1014.    // Set bar as current bar
  1015.    shCurrBar := hBar
  1016.  
  1017.    RETURN hBar
  1018.  
  1019. /***
  1020. *  BarMenuChoice( <hBar>, [<nChoice>] ) --> nChoice
  1021. *  
  1022. */
  1023. FUNCTION BarMenuChoice( hBar, nChoice )
  1024.  
  1025.    IF nChoice != NIL
  1026.       saBar[hBar][BA_MCHOICE] := nChoice
  1027.    ENDIF
  1028.  
  1029.    RETURN( saBar[hBar][BA_MCHOICE] )
  1030.  
  1031. /***
  1032. *  BarNew( <cColor>, <nBorder> ) --> hBar
  1033. *  Create a new menubar and return a handle to it
  1034. *
  1035. */
  1036. FUNCTION BarNew( cColor, nBorder )
  1037.    LOCAL aBar[BA_LEN]
  1038.    LOCAL hBarHandle
  1039.  
  1040.    // Add bar array to global holder
  1041.    IF ( LEN(saBar) == 0 ) .OR. ( hBarHandle := (NilScan(saBar) == 0) )
  1042.       AADD( saBar, aBar )
  1043.       hBarHandle := 1
  1044.    ELSE
  1045.       saBar[hBarHandle] := aBar
  1046.    ENDIF
  1047.  
  1048.    // Fill it in through equivalent array
  1049.    aBar[BA_OUTKEYS] := BarOutKeys( hBarHandle )
  1050.    aBar[BA_INKEYS]  := BarInKeys( hBarHandle )
  1051.    aBar[BA_CHOICE]  := NIL
  1052.    aBar[BA_MCHOICE] := OM_CONT
  1053.    aBar[BA_COLOR]   := ListAsArray( IIF( cColor == NIL, ;
  1054.                                     IIF( ISCOLOR(), OM_DEFCLR, OM_DEFBW ), ;
  1055.                                     cColor ) )
  1056.    aBar[BA_BORDER]  := OM_DEFBORD
  1057.    aBar[BA_MENUS]   := {}
  1058.  
  1059.    RETURN( hBarHandle )
  1060.  
  1061. /***
  1062. *  MenuAdd( <hMenu> ) --> hBar
  1063. *  Add a menu to menubar
  1064. *
  1065. */
  1066. FUNCTION MenuAdd( hBar, hMenu )
  1067.  
  1068.    saMenu[hMenu][MA_OWNER] := hBar
  1069.  
  1070.    AADD( saBar[hBar][BA_MENUS], hMenu )
  1071.  
  1072.    // Add Alt Key sequence to "out" keys
  1073.    AADD( saBar[hBar][BA_OUTKEYS], ;
  1074.          { LetterAsAltKey(ASC(saMenu[hMenu][MA_HOTKEY])), ;
  1075.            {|hBar, nItem| BarSetItem(hBar, nItem), ;
  1076.                           BarLastReq(hBar, OM_BARIN), ;
  1077.                           BarExecute(hBar) }, ;
  1078.            hBar, ;
  1079.            LEN(saBar[hBar][BA_MENUS]);
  1080.          } )
  1081.  
  1082.    // Add key to "in" keys (after F10 is hit)
  1083.    AADD( saBar[hBar][BA_INKEYS], ;
  1084.          { ASC(saMenu[hMenu][MA_HOTKEY]), ;
  1085.            {|hBar, nItem| BarSetItem(hBar, nItem), ;
  1086.                           BarLastReq(hBar, OM_BARIN), ;
  1087.                           BarExecute(hBar) }, ;
  1088.            hBar, ;
  1089.            LEN(saBar[hBar][BA_MENUS]);
  1090.          } )
  1091.    RETURN( hBar )
  1092.  
  1093. /***
  1094. *  MenuDisplay( <hMenu> ) --> hMenu
  1095. *  Display a menu to the screen
  1096. *
  1097. */
  1098. FUNCTION MenuDisplay( hMenu )
  1099.    LOCAL i
  1100.    LOCAL hBar
  1101.    LOCAL nLen
  1102.    LOCAL aItem, aLongItem
  1103.    LOCAL nRow, nCol, nLastRow, nLastCol
  1104.    LOCAL cSaveColor, nSaveRow, nSaveCol
  1105.  
  1106.    hBar      := saMenu[hMenu][MA_OWNER]
  1107.    aItem     := saMenu[hMenu][MA_ITEMS]
  1108.    aLongItem := ACOMP( aItem, {|x,y| LEN(x[IA_TEXT]) > LEN(y[IA_TEXT])} )
  1109.  
  1110.    saMenu[hMenu][MA_WIDTH] := MAX( LEN( aLongItem[IA_TEXT] ), LEN( saMenu[hMenu][MA_TITLE] ) )
  1111.  
  1112.    nSaveCol := COL()
  1113.    nCol     := saMenu[hMenu][MA_COL]
  1114.    nLastCol := nCol + saMenu[hMenu][MA_WIDTH] + 1
  1115.  
  1116.    // Check to see if I have tried to go off the screen horizontally
  1117.    IF nLastCol > MAXCOL()
  1118.       nCol     := saMenu[hMenu][MA_COL] ;
  1119.                := MAXCOL() - 1 - saMenu[hMenu][MA_WIDTH]
  1120.       nLastCol := MAXCOL()
  1121.  
  1122.       IF nCol < 0
  1123.          // Error, tried to display menu that is wider than the screen
  1124.          MenuError( ME_TOOWIDE )
  1125.       ENDIF   
  1126.    ENDIF
  1127.  
  1128.    nSaveRow := ROW()
  1129.    nRow     := saMenu[hMenu][MA_ROW]
  1130.    nLastRow := nRow + LEN(aItem) + 1
  1131.  
  1132.    // Check to see if I have tried to go off the screen vertically
  1133.    IF nLastRow > MAXROW()
  1134.       nRow     := saMenu[hMenu][MA_ROW] ;
  1135.                := MAXROW() - 1 - LEN(aItem)
  1136.       nLastCol := MAXROW()
  1137.  
  1138.       IF nRow < 0
  1139.          // Error, tried to display menu that is longer than the screen
  1140.          MenuError( ME_TOOLONG )
  1141.       ENDIF   
  1142.    ENDIF
  1143.  
  1144.    saMenu[hMenu][MA_SAVESCR] := SAVESCREEN(nRow, nCol, nLastRow, nLastCol)
  1145.    saMenu[hMenu][MA_LASTROW] := nLastRow
  1146.    saMenu[hMenu][MA_LASTCOL] := nLastCol
  1147.  
  1148.    cSaveColor := SETCOLOR( saBar[hBar][BA_COLOR][OM_NORM] )
  1149.  
  1150.    @ nRow, nCol CLEAR TO nLastRow, nLastCol
  1151.  
  1152.    SETCOLOR( saBar[hBar][BA_COLOR][OM_LETTER] )
  1153.  
  1154.    DO CASE
  1155.    CASE saBar[hBar][BA_BORDER] == OM_SINGLE
  1156.        @ nRow, nCol TO nLastRow, nLastCol
  1157.    CASE saBar[hBar][BA_BORDER] == OM_DOUBLE
  1158.        @ nRow, nCol TO nLastRow, nLastCol DOUBLE
  1159.    ENDCASE
  1160.  
  1161.    SETCOLOR( cSaveColor )
  1162.  
  1163.    nLen := LEN(aItem)
  1164.    FOR i := 1 TO nLen
  1165.       aItem[i][IA_ROW] := nRow + i
  1166.       aItem[i][IA_COL] := nCol + 1
  1167.  
  1168.       MenuDispPrompt( hMenu, i )
  1169.    NEXT
  1170.    SETPOS( nSaveRow, nSaveCol )
  1171.  
  1172.    RETURN( hMenu )
  1173.  
  1174. /***
  1175. *  MenuNew( <cTitle> ) --> hMenuHandle
  1176. *  Create a new menu and return a new handle to it
  1177. *
  1178. */
  1179. FUNCTION MenuNew( cTitle )
  1180.    LOCAL aMenu[MA_LEN]
  1181.    LOCAL hMenuHandle
  1182.  
  1183.    cTitle := " " + cTitle + " "  // Pad out correctly
  1184.  
  1185.    // Add menu array to global holder
  1186.    IF ( LEN(saMenu) == 0 ) .OR. ( hMenuHandle := (NilScan(saMenu) == 0) )
  1187.       AADD( saMenu, aMenu )
  1188.       hMenuHandle := LEN( saMenu )
  1189.    ELSE
  1190.       saMenu[hMenuHandle] := aMenu
  1191.    ENDIF
  1192.  
  1193.    // Setup header information
  1194.    aMenu[MA_ROW]    := 0
  1195.    aMenu[MA_COL]    := 0
  1196.    aMenu[MA_WIDTH]  := 0
  1197.    aMenu[MA_KEYS]   := MenuKeys( hMenuHandle )
  1198.    aMenu[MA_ITEMS]  := {}
  1199.    aMenu[MA_TITLE]  := STRTRAN( cTitle, OM_HKCHAR, "" )
  1200.    aMenu[MA_KEYPOS] := AT( OM_HKCHAR, cTitle )
  1201.    aMenu[MA_HOTKEY] := IIF( aMenu[MA_KEYPOS] == 0, "", ;
  1202.                             SUBSTR( cTitle, aMenu[MA_KEYPOS] + 1, 1 ) )
  1203.    aMenu[MA_BLOCK]  := {|hMenu| MenuActivate(hMenu) }
  1204.    aMenu[MA_CHOICE] := NIL
  1205.  
  1206.    RETURN( hMenuHandle )
  1207.  
  1208. /***
  1209. *  PostExitBlock( [<bBlock>] ) --> bOldBlock
  1210. *  Post a code block to execute when a function is terminated
  1211. *
  1212. */
  1213. FUNCTION PostExitBlock( bBlock )
  1214.    LOCAL bOldBlock := sbExitBlock
  1215.  
  1216.    sbExitBlock := bBlock
  1217.  
  1218.    RETURN( bOldBlock )
  1219.  
  1220. /***
  1221. *  PromptAction( <hMenu>, <nID>, <bBlock> ) --> hMenu
  1222. *  Change the menu action block
  1223. *
  1224. */
  1225. FUNCTION PromptAction( hMenu, nID, bBlock )
  1226.    LOCAL nPrompt
  1227.  
  1228.    IF ( (nPrompt := PromptFind( hMenu, nID )) > 0 )
  1229.       saMenu[hMenu][MA_ITEMS][nPrompt][IA_BLOCK] := bBlock
  1230.    ENDIF
  1231.  
  1232.    RETURN( hMenu )
  1233.  
  1234. /***
  1235. *  PromptAdd( <hMenu>, <nID>, <cText>, <bBlock> ) --> hMenu
  1236. *  Add a prompt to the menu
  1237. *
  1238. */
  1239. FUNCTION PromptAdd( hMenu, nID, cText, bBlock )
  1240.    LOCAL aPrompt[IA_LEN]
  1241.  
  1242.    cText := SPACE(OM_PAD) + cText
  1243.  
  1244.    aPrompt[IA_TEXT]    := STRTRAN( cText, OM_HKCHAR, "" )
  1245.    aPrompt[IA_ID]      := nID
  1246.    aPrompt[IA_ACTIVE]  := .T.
  1247.    aPrompt[IA_CHECKED] := .F.
  1248.    aPrompt[IA_SUBMENU] := NIL
  1249.    aPrompt[IA_KEYPOS]  := AT( OM_HKCHAR, cText )
  1250.    aPrompt[IA_HOTKEY]  := IIF( aPrompt[IA_KEYPOS] == 0, "", ;
  1251.                              SUBSTR( cText, aPrompt[IA_KEYPOS] + 1, 1 ) )
  1252.  
  1253.    // Assign Block
  1254.    aPrompt[IA_BLOCK]   := bBlock
  1255.  
  1256.    AADD( saMenu[hMenu][MA_ITEMS], aPrompt )
  1257.  
  1258.    // Add to key event array
  1259.    AADD( saMenu[hMenu][MA_KEYS], { ASC(UPPER(aPrompt[IA_HOTKEY])), ;
  1260.                     {|hMenu,nID| MenuSetItem(hMenu,PromptFind(hMenu,nID)),;
  1261.                                  MenuExecute(hMenu)}, ;
  1262.                     hMenu, nID} )
  1263.  
  1264.    RETURN( hMenu )
  1265.  
  1266. /***
  1267. *  PromptAddLine( <hMenu> ) --> hMenu
  1268. *  Add a line separator between prompts
  1269. *
  1270. */
  1271. FUNCTION PromptAddLine( hMenu )
  1272.    LOCAL aPrompt[IA_LEN]
  1273.  
  1274.    aPrompt[IA_TEXT]    := OM_LINECHR
  1275.    aPrompt[IA_ACTIVE]  := .F.
  1276.    aPrompt[IA_CHECKED] := .F.
  1277.    aPrompt[IA_SUBMENU] := NIL
  1278.  
  1279.    // Add Prompt to Menu
  1280.    AADD( saMenu[hMenu][MA_ITEMS], aPrompt )
  1281.  
  1282.    RETURN( hMenu )
  1283.  
  1284. /***
  1285. *  PromptAddSub( <hMenu>, <nID>, <hSubMenu> ) --> hMenu
  1286. *  Add a hierarchical submenu to an existing menu
  1287. *
  1288. */
  1289. FUNCTION PromptAddSub( hMenu, nID, hSubMenu )
  1290.    LOCAL aPrompt[IA_LEN]
  1291.    LOCAL cText
  1292.  
  1293.    // Minus 1 because of the space added by MenuNew()
  1294.    cText := STUFF(SPACE(OM_PAD-1) + saMenu[hSubMenu][MA_TITLE], 1, 1, OM_SUBCHAR)
  1295.  
  1296.    aPrompt[IA_TEXT]    := cText
  1297.    aPrompt[IA_ID]      := nID
  1298.    aPrompt[IA_SUBMENU] := hSubMenu
  1299.    aPrompt[IA_CHECKED] := .F.
  1300.    aPrompt[IA_ACTIVE]  := .T.
  1301.    aPrompt[IA_KEYPOS]  := saMenu[hSubMenu][MA_KEYPOS] + 1  // +1 due to extra " "
  1302.    aPrompt[IA_HOTKEY]  := saMenu[hSubMenu][MA_HOTKEY]
  1303.  
  1304.    aPrompt[IA_BLOCK]   := {|hMenu,nID| MenuSubActivate( hMenu, nID ) }
  1305.  
  1306.    AADD( saMenu[hMenu][MA_ITEMS], aPrompt )
  1307.  
  1308.    // Add key to key event array
  1309.    AADD( saMenu[hMenu][MA_KEYS], { ASC(UPPER(aPrompt[IA_HOTKEY])), ;
  1310.                     {|hMenu,nID| MenuSetItem(hMenu,PromptFind(hMenu,nID)),;
  1311.                                  MenuExecute(hMenu)}, ;
  1312.                     hMenu, nID} )
  1313.  
  1314.    RETURN( hMenu )
  1315.  
  1316. /***
  1317. *  PromptAddToggle( <hMenu>, <nID>, <cText>, <bBlock> ) --> hMenu
  1318. *
  1319. *  Has to be separate from PromptAdd because of needing to add bBlock to
  1320. *  key event array
  1321. *
  1322. */
  1323. FUNCTION PromptAddToggle( hMenu, nID, cText, bBlock )
  1324.    LOCAL aPrompt[IA_LEN]
  1325.  
  1326.    cText := SPACE(OM_PAD) + cText
  1327.  
  1328.    aPrompt[IA_TEXT]    := STRTRAN( cText, OM_HKCHAR, "" )
  1329.    aPrompt[IA_ID]      := nID
  1330.    aPrompt[IA_ACTIVE]  := .T.
  1331.    aPrompt[IA_CHECKED] := .F.
  1332.    aPrompt[IA_SUBMENU] := NIL
  1333.    aPrompt[IA_KEYPOS]  := AT( OM_HKCHAR, cText )
  1334.    aPrompt[IA_HOTKEY]  := IIF( aPrompt[IA_KEYPOS] == 0, "", ;
  1335.                              SUBSTR( cText, aPrompt[IA_KEYPOS] + 1, 1 ) )
  1336.  
  1337.    // Assign Block
  1338.    aPrompt[IA_BLOCK]    := {|hMenu, nID, bBlock| CheckIt(hMenu, nID, bBlock)}
  1339.    aPrompt[IA_2NDBLOCK] := bBlock
  1340.  
  1341.    // Add Prompt to Menu
  1342.    AADD( saMenu[hMenu][MA_ITEMS], aPrompt )
  1343.  
  1344.    // Add to key event array
  1345.    AADD( saMenu[hMenu][MA_KEYS], { ASC(UPPER(aPrompt[IA_HOTKEY])), ;
  1346.                     {|hMenu,nID| MenuSetItem(hMenu,PromptFind(hMenu,nID)),;
  1347.                                  MenuExecute(hMenu)}, ;
  1348.                     hMenu, nID} )
  1349.  
  1350.    RETURN( hMenu )
  1351.  
  1352. /***
  1353. *  PromptCheck( <hMenu>, <nID> ) --> hMenu
  1354. *  Mark a menu prompt with a check mark
  1355. *
  1356. */
  1357. FUNCTION PromptCheck( hMenu, nID )
  1358.    LOCAL nPrompt
  1359.  
  1360.    IF ( (nPrompt := PromptFind( hMenu, nID )) > 0 )
  1361.       saMenu[hMenu][MA_ITEMS][nPrompt][IA_CHECKED] := .T.
  1362.    ENDIF
  1363.  
  1364.    RETURN( hMenu )
  1365.  
  1366. /***
  1367. *  PromptEnable( <hMenu>, <nID> ) --> hMenu
  1368. *  Ungray a menu prompt
  1369. *
  1370. */
  1371. FUNCTION PromptEnable( hMenu, nID )
  1372.    LOCAL nPrompt
  1373.  
  1374.    IF ( (nPrompt := PromptFind( hMenu, nID )) > 0 )
  1375.       saMenu[hMenu][MA_ITEMS][nPrompt][IA_ACTIVE] := .T.
  1376.    ENDIF
  1377.  
  1378.    RETURN( hMenu )
  1379.  
  1380. /***
  1381. *  PromptGray( <hMenu>, <nID> ) --> hMenu
  1382. *  Gray a menu prompt
  1383. *
  1384. */
  1385. FUNCTION PromptGray( hMenu, nID )
  1386.    LOCAL nPrompt
  1387.  
  1388.    IF ( (nPrompt := PromptFind( hMenu, nID )) > 0 )
  1389.       saMenu[hMenu][MA_ITEMS][nPrompt][IA_ACTIVE] := .F.
  1390.    ENDIF
  1391.  
  1392.    RETURN( hMenu )
  1393.  
  1394. /***
  1395. *  PromptIsChecked( <hMenu>, <nID> ) --> lChecked
  1396. *  Determine if a menu prompt is checked
  1397. *
  1398. */
  1399. FUNCTION PromptIsChecked( hMenu, nID )
  1400.    LOCAL nPrompt
  1401.  
  1402.    nPrompt := PromptFind( hMenu, nID )
  1403.  
  1404.    RETURN( IIF( nPrompt == 0, .F., saMenu[hMenu][MA_ITEMS][nPrompt][IA_CHECKED] ) )
  1405.  
  1406. /***
  1407. *  PromptIsEnabled( <hMenu>, <nID> ) --> lEnabled
  1408. *  Determine if a menu prompt is active
  1409. *
  1410. */
  1411. FUNCTION PromptIsEnabled( hMenu, nID )
  1412.    LOCAL nPrompt
  1413.  
  1414.    nPrompt := PromptFind( hMenu, nID )
  1415.  
  1416.    RETURN( IIF( nPrompt == 0, .F., saMenu[hMenu][MA_ITEMS][nPrompt][IA_ACTIVE] ) )
  1417.  
  1418. /***
  1419. *  PromptQuickKey( <hBar>, <hMenu>, <nID>, <nKey> ) --> hMenu
  1420. *  Assign nKey to nID
  1421. *
  1422. */
  1423. FUNCTION PromptQuickKey( hBar, hMenu, nID, nKey )
  1424.    LOCAL nPrompt
  1425.  
  1426.    IF ( (nPrompt := PromptFind( hMenu, nID )) > 0 )
  1427.       AADD( saBar[hBar][BA_OUTKEYS], { nKey, ;
  1428.                                        {|hMenu, nID| saMenu[hMenu][MA_CHOICE] := PromptFind( hMenu, nID ), ;
  1429.                                                 MenuExecute(hMenu)}, ;
  1430.                                         hMenu, nID } )
  1431.    ENDIF
  1432.  
  1433.    RETURN (hMenu)
  1434.  
  1435. /***
  1436. *  PromptUnCheck( <hMenu>, <nID> ) --> hMenu
  1437. *  Uncheck menu prompt
  1438. *
  1439. */
  1440. FUNCTION PromptUnCheck( hMenu, nID )
  1441.    LOCAL nPrompt
  1442.  
  1443.    IF ( (nPrompt := PromptFind( hMenu, nID )) > 0 )
  1444.       saMenu[hMenu][MA_ITEMS][nPrompt][IA_CHECKED] := .F.
  1445.    ENDIF
  1446.  
  1447.    RETURN( hMenu )
  1448.  
  1449. /***
  1450. *  MenuError( nErr ) --> NIL
  1451. *  Unrecoverable menu error, report it
  1452. *
  1453. */
  1454. STATIC FUNCTION MenuError( nErr )
  1455.    LOCAL oErr
  1456.  
  1457.    oErr := ErrorNew()
  1458.  
  1459.    oErr:canDefault    := .F.
  1460.    oErr:canRetry      := .F.
  1461.    oErr:canSubstitute := .F.
  1462.  
  1463.    oErr:genCode       := EG_COMPLEXITY
  1464.    oErr:severity      := ES_ERROR
  1465.    oErr:description   := "Menu will not fit on screen"
  1466.    oErr:subCode       := nErr
  1467.    oErr:subSystem     := "OMENU"
  1468.  
  1469.    EVAL( ERRORBLOCK(), oErr )
  1470.  
  1471.    QUIT  // Should never reach this point
  1472.    RETURN NIL
  1473.