home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / pibterm / pibt41s3.arc / PIBMENUS.MOD < prev    next >
Encoding:
Text File  |  1988-02-07  |  42.0 KB  |  911 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           PIBMENUS.PAS   --- Menu Routines for Turbo Pascal          *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*                                                                      *)
  7. (*  Date:    Version 1.0: January, 1985                                 *)
  8. (*           Version 1.1: March, 1985                                   *)
  9. (*           Version 1.2: May, 1985                                     *)
  10. (*           Version 2.0: June, 1985                                    *)
  11. (*           Version 2.1: July, 1985                                    *)
  12. (*           Version 3.0: October, 1985                                 *)
  13. (*           Version 3.2: November, 1985                                *)
  14. (*           Version 4.0: March, 1986                                   *)
  15. (*           Version 4.1: February, 1987                                *)
  16. (*           Version 4.2: March, 1987                                   *)
  17. (*                                                                      *)
  18. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  19. (*                                                                      *)
  20. (*  History: These routines represent my substantial upgrading of the   *)
  21. (*           simple menu routines written by Barry Abrahamsen which     *)
  22. (*           I believe appeared originally in the TUG newsletter.       *)
  23. (*           The windowing facility provides windows similar to those   *)
  24. (*           implemented in QMODEM by John Friel III.                   *)
  25. (*                                                                      *)
  26. (*           Version 2.0 of these adds the exploding windows feature    *)
  27. (*           as well the use-selectable box-drawing characters.         *)
  28. (*           The exploding box algorithm is derived from one by         *)
  29. (*           Jim Everingham.                                            *)
  30. (*                                                                      *)
  31. (*           Note that the routines present in PIBSCREN.PAS were        *)
  32. (*           originally part of the PIBMENUS.PAS file.  With version    *)
  33. (*           2.0 of PibMenus, PIBMENUS.PAS is split into the screen-    *)
  34. (*           handling routines in PIBSCREN.PAS and the actual menu      *)
  35. (*           routines in PIBMENUS.PAS.                                  *)
  36. (*                                                                      *)
  37. (*           Suggestions for improvements or corrections are welcome.   *)
  38. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  39. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  40. (*                                                                      *)
  41. (*           If you use this code in your own programs, please be nice  *)
  42. (*           and give all of us credit.                                 *)
  43. (*                                                                      *)
  44. (*----------------------------------------------------------------------*)
  45. (*                                                                      *)
  46. (*  Needs:  These routines need the include files MINMAX.PAS,           *)
  47. (*          GLOBTYPE.PAS, ASCII.PAS, and PIBSCREN.PAS. These files      *)
  48. (*          are not included here, since Turbo Pascal regrettably does  *)
  49. (*          not allow nested includes.                                  *)
  50. (*                                                                      *)
  51. (*----------------------------------------------------------------------*)
  52. (*                                                                      *)
  53. (*  What these routines do:                                             *)
  54. (*                                                                      *)
  55. (*    These routines provide a straight-forward menu-selection          *)
  56. (*    facility, similar to that used in programs like Lotus.  A pop-up  *)
  57. (*    window holds the menu.  The menu is contained in a frame.  The    *)
  58. (*    items are displayed within the frame.  The currently selected     *)
  59. (*    item is highlighted in reverse video.  You move up and down in    *)
  60. (*    the list of menu items by using the up and down arrow keys, or    *)
  61. (*    the space bar.  To make a selection, hit the Enter (Return) key.  *)
  62. (*                                                                      *)
  63. (*    Alternatively, you may hit the first character of a menu item.    *)
  64. (*    The first menu item found with that initial letter is selected.   *)
  65. (*                                                                      *)
  66. (*    The characters comprising the menu box are user-selectable.       *)
  67. (*    In addition, menus may just "pop up" onto the screen, or may      *)
  68. (*    "explode" onto the screen.                                        *)
  69. (*                                                                      *)
  70. (*    Hitting the escape key causes a menu choice of "-1" to be         *)
  71. (*    returned to the calling routine.                                  *)
  72. (*                                                                      *)
  73. (*----------------------------------------------------------------------*)
  74. (*                                                                      *)
  75. (*  Use:                                                                *)
  76. (*                                                                      *)
  77. (*     (1)  Define a variable of type Menu_Type, say, MYMENU.           *)
  78. (*                                                                      *)
  79. (*     (2)  Define the following entries in MYMENU:                     *)
  80. (*                                                                      *)
  81. (*             Menu_Size    --- Number of entries in this menu          *)
  82. (*             Menu_Title   --- Title for the menu                      *)
  83. (*             Menu_Row     --- Row where menu should appear (upper LHC *)
  84. (*             Menu_Column  --- Column where menu should appear         *)
  85. (*             Menu_Width   --- Width of menu                           *)
  86. (*             Menu_Height  --- Height of menu                          *)
  87. (*             Menu_Default --- Ordinal of the default menu entry       *)
  88. (*             Menu_Tcolor  --- Color to display menu text              *)
  89. (*             Menu_Bcolor  --- Color for menu background               *)
  90. (*             Menu_Fcolor  --- Color for menu frame box                *)
  91. (*                                                                      *)
  92. (*     (3)  Now for each of Menu_Size Menu_Entries, define:             *)
  93. (*             Menu_Text   --- Text of menu item                        *)
  94. (*                                                                      *)
  95. (*     (4)  Optionally call  Menu_Set_Box_Chars  to define the          *)
  96. (*          characters used to form the menu box.                       *)
  97. (*                                                                      *)
  98. (*     (5)  Optionally call Menu_Set_Explode to set the menus as either *)
  99. (*          exploding or pop-up.                                        *)
  100. (*                                                                      *)
  101. (*     (6)  Optionally call Menu_Set_Beep to turn beeping on/off.       *)
  102. (*                                                                      *)
  103. (*     (7)  Call  Menu_Display_Choices  to display menu.  The default   *)
  104. (*          menu choice will be highlighted.                            *)
  105. (*                                                                      *)
  106. (*     (8)  Call  Menu_Get_Choice  to retrieve menu choice.  The up and *)
  107. (*          down arrows, and the space bar, can be used to move         *)
  108. (*          through the menu items.  Each item is highlighted in turn.  *)
  109. (*          Whichever item is highlighted when a carriage return is     *)
  110. (*          entered is returned as the chosen item.                     *)
  111. (*                                                                      *)
  112. (*----------------------------------------------------------------------*)
  113.  
  114. PROCEDURE Menu_Set_Explode( Explode_ON : BOOLEAN );
  115.  
  116. (*----------------------------------------------------------------------*)
  117. (*                                                                      *)
  118. (*     Procedure:  Menu_Set_Explode                                     *)
  119. (*                                                                      *)
  120. (*     Purpose:    Turn exploding menus on or off                       *)
  121. (*                                                                      *)
  122. (*     Calling Sequence:                                                *)
  123. (*                                                                      *)
  124. (*        Menu_Set_Explode( Explode_ON : BOOLEAN );                     *)
  125. (*                                                                      *)
  126. (*           Explode_ON --- TRUE to use exploding menus,                *)
  127. (*                          FALSE to use pop-up menus                   *)
  128. (*                                                                      *)
  129. (*     Calls:   None                                                    *)
  130. (*                                                                      *)
  131. (*----------------------------------------------------------------------*)
  132.  
  133. BEGIN (* Menu_Set_Explode *)
  134.  
  135.    Menu_Explode_Mode := Explode_ON;
  136.  
  137. END   (* Menu_Set_Explode *);
  138.  
  139. (*----------------------------------------------------------------------*)
  140. (*               Menu_Set_Beep --- Set beep mode on or off              *)
  141. (*----------------------------------------------------------------------*)
  142.  
  143. PROCEDURE Menu_Set_Beep( Beep_ON : BOOLEAN );
  144.  
  145. (*----------------------------------------------------------------------*)
  146. (*                                                                      *)
  147. (*     Procedure:  Menu_Set_Beep                                        *)
  148. (*                                                                      *)
  149. (*     Purpose:    Turn beeping (errors, etc.) on or off                *)
  150. (*                                                                      *)
  151. (*     Calling Sequence:                                                *)
  152. (*                                                                      *)
  153. (*        Menu_Set_Beep( Beep_ON : BOOLEAN );                           *)
  154. (*                                                                      *)
  155. (*           Beep_ON --- TRUE to allow beeps,                           *)
  156. (*                       FALSE to disallow beeps.                       *)
  157. (*                                                                      *)
  158. (*     Calls:   None                                                    *)
  159. (*                                                                      *)
  160. (*----------------------------------------------------------------------*)
  161.  
  162. BEGIN (* Menu_Set_Beep *)
  163.  
  164.    Menu_Beep_Mode := Beep_ON;
  165.  
  166. END   (* Menu_Set_Beep *);
  167.  
  168. (*----------------------------------------------------------------------*)
  169. (*     Menu_Set_Box_Chars --- Set box drawing characters for menus      *)
  170. (*----------------------------------------------------------------------*)
  171.  
  172. PROCEDURE Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;
  173.                               Top_Line            : CHAR;
  174.                               Top_Right_Corner    : CHAR;
  175.                               Right_Line          : CHAR;
  176.                               Bottom_Right_Corner : CHAR;
  177.                               Bottom_Line         : CHAR;
  178.                               Bottom_Left_Corner  : CHAR;
  179.                               Left_Line           : CHAR  );
  180.  
  181. (*----------------------------------------------------------------------*)
  182. (*                                                                      *)
  183. (*     Procedure:  Menu_Set_Box_Chars                                   *)
  184. (*                                                                      *)
  185. (*     Purpose:    Set box characters for drawing menu boxes            *)
  186. (*                                                                      *)
  187. (*     Calling Sequence:                                                *)
  188. (*                                                                      *)
  189. (*        Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;               *)
  190. (*                            Top_Line            : CHAR;               *)
  191. (*                            Top_Right_Corner    : CHAR;               *)
  192. (*                            Right_Line          : CHAR;               *)
  193. (*                            Bottom_Right_Corner : CHAR;               *)
  194. (*                            Bottom_Line         : CHAR;               *)
  195. (*                            Bottom_Left_Corner  : CHAR;               *)
  196. (*                            Left_Line           : CHAR  );            *)
  197. (*                                                                      *)
  198. (*           --- arguments are what their names suggest.                *)
  199. (*                                                                      *)
  200. (*                                                                      *)
  201. (*     Calls:   None                                                    *)
  202. (*                                                                      *)
  203. (*----------------------------------------------------------------------*)
  204.  
  205. BEGIN (* Menu_Set_Box_Chars *)
  206.  
  207.    Menu_Box_Chars.Top_Left_Corner     := Top_Left_Corner;
  208.    Menu_Box_Chars.Top_Line            := Top_Line;
  209.    Menu_Box_Chars.Top_Right_Corner    := Top_Right_Corner;
  210.    Menu_Box_Chars.Right_Line          := Right_Line;
  211.    Menu_Box_Chars.Bottom_Right_Corner := Bottom_Right_Corner;
  212.    Menu_Box_Chars.Bottom_Line         := Bottom_Line;
  213.    Menu_Box_Chars.Bottom_Left_Corner  := Bottom_Left_Corner;
  214.    Menu_Box_Chars.Left_Line           := Left_Line;
  215.  
  216. END   (* Menu_Set_Box_Chars *);
  217.  
  218. (*----------------------------------------------------------------------*)
  219. (*                      Draw_Box --- Draw a box                         *)
  220. (*----------------------------------------------------------------------*)
  221.  
  222. PROCEDURE Draw_Box( X1, Y1, X2, Y2 : INTEGER;
  223.                     Frame_Color    : INTEGER;
  224.                     Title_Color    : INTEGER;
  225.                     Title          : AnyStr   );
  226.  
  227. VAR
  228.    I     : INTEGER;
  229.    LT    : INTEGER;
  230.    FColor: INTEGER;
  231.  
  232. BEGIN (* Draw_Box *)
  233.  
  234.    LT     := LENGTH( Title );
  235.    FColor := Frame_Color;
  236.  
  237.    IF LT > 0 THEN
  238.       BEGIN
  239.          WriteSXY( Menu_Box_Chars.Top_Left_Corner + '[ ',
  240.                    X1, Y1, FColor );
  241.          WriteSXY( Title, X1 + 3, Y1, Title_Color );
  242.          WriteSXY( ' ]', X1 + LT + 3, Y1, FColor );
  243.       END
  244.    ELSE
  245.       WriteSXY( Menu_Box_Chars.Top_Left_Corner +
  246.                 DUPL( Menu_Box_Chars.Top_Line , 4 ), X1, Y1, FColor );
  247.  
  248.                                    (* Draw remainder of top of frame *)
  249.  
  250.    WriteSXY( Dupl( Menu_Box_Chars.Top_Line , X2 - X1 - LT - 5 ),
  251.              ( X1 + LT + 5 ), Y1, FColor );
  252.  
  253.    WriteCXY( Menu_Box_Chars.Top_Right_Corner, X2, Y1, FColor );
  254.  
  255.                                   (* Draw sides of frame *)
  256.  
  257.    FOR I := SUCC( Y1 ) TO PRED( Y2 ) DO
  258.       BEGIN
  259.          WriteCXY( Menu_Box_Chars.Left_Line,  X1, I, FColor );
  260.          WriteCXY( Menu_Box_Chars.Right_Line, X2, I, FColor );
  261.       END;
  262.                                   (* Draw bottom of frame     *)
  263.  
  264.    WriteCXY( Menu_Box_Chars.Bottom_Left_Corner, X1, Y2, FColor );
  265.  
  266.    WriteSXY( Dupl( Menu_Box_Chars.Bottom_Line , PRED( X2 - X1 ) ),
  267.              SUCC( X1 ), Y2, FColor );
  268.  
  269.    WriteCXY( Menu_Box_Chars.Bottom_Right_Corner, X2, Y2, FColor );
  270.  
  271. END   (* Draw_Box *);
  272.  
  273. (*----------------------------------------------------------------------*)
  274. (*                Draw_Menu_Frame --- Draw a Frame                      *)
  275. (*----------------------------------------------------------------------*)
  276.  
  277. PROCEDURE Draw_Menu_Frame( UpperLeftX,  UpperLeftY,
  278.                            LowerRightX, LowerRightY : INTEGER;
  279.                            Frame_Color, Title_Color,
  280.                            Text_Color               : INTEGER;
  281.                            Menu_Title: AnyStr );
  282.  
  283. (*----------------------------------------------------------------------*)
  284. (*                                                                      *)
  285. (*     Procedure:  Draw_Menu_Frame                                      *)
  286. (*                                                                      *)
  287. (*     Purpose:    Draws a titled frame using PC graphics characters    *)
  288. (*                                                                      *)
  289. (*     Calling Sequence:                                                *)
  290. (*                                                                      *)
  291. (*        Draw_Menu_Frame( UpperLeftX,  UpperLeftY,                     *)
  292. (*                         LowerRightX, LowerRightY,                    *)
  293. (*                         Frame_Color, Title_Color : INTEGER;          *)
  294. (*                         Menu_Title: AnyStr );                        *)
  295. (*                                                                      *)
  296. (*           UpperLeftX,  UpperLeftY  --- Upper left coordinates        *)
  297. (*           LowerRightX, LowerRightY --- Lower right coordinates       *)
  298. (*           Frame_Color              --- Color for frame               *)
  299. (*           Title_Color              --- Color for title text          *)
  300. (*           Text_Color               --- Color for interior text       *)
  301. (*           Menu_Title               --- Menu Title                    *)
  302. (*                                                                      *)
  303. (*     Calls:   GoToXY                                                  *)
  304. (*              Dupl                                                    *)
  305. (*              Draw_Box                                                *)
  306. (*              Do_Explosion (internal)                                 *)
  307. (*                                                                      *)
  308. (*     Remarks:                                                         *)
  309. (*                                                                      *)
  310. (*        The area inside the frame is cleared after the frame is       *)
  311. (*        drawn.  If a box without a title is desired, enter a null     *)
  312. (*        string for a title.                                           *)
  313. (*                                                                      *)
  314. (*----------------------------------------------------------------------*)
  315.  
  316. VAR
  317.    I  : INTEGER;
  318.    L  : INTEGER;
  319.    LT : INTEGER;
  320.    XM : INTEGER;
  321.    YM : INTEGER;
  322.    XS : INTEGER;
  323.    YS : INTEGER;
  324.    R  : REAL;
  325.    X1 : INTEGER;
  326.    X2 : INTEGER;
  327.    Y1 : INTEGER;
  328.    Y2 : INTEGER;
  329.    XM1: INTEGER;
  330.    YM1: INTEGER;
  331.    Knt: INTEGER;
  332.  
  333. (*----------------------------------------------------------------------*)
  334. (*               Do_Explosion --- Draw an 'exploding' box               *)
  335. (*----------------------------------------------------------------------*)
  336.  
  337. PROCEDURE Do_Explosion;
  338.  
  339. (*----------------------------------------------------------------------*)
  340. (*               --- Basic algorithm by Jim Everingham ---              *)
  341. (*----------------------------------------------------------------------*)
  342.  
  343. VAR
  344.    I: INTEGER;
  345.    
  346. BEGIN (* Do_Explosion *)
  347.  
  348.    XM     := UpperLeftX + L SHR 1;
  349.    YM     := UpperLeftY + ( LowerRightY - UpperLeftY ) SHR 1;
  350.    X1     := UpperLeftX;
  351.    X2     := LowerRightX;
  352.    Y1     := UpperLeftY;
  353.    Y2     := LowerRightY;
  354.  
  355.    XM1    := XM;
  356.    YM1    := YM;
  357.                                     (* Figure out increments for *)
  358.                                     (* increasing boz dimensions *)
  359.                                     (* to produce explosion.     *)
  360.    IF ( XM > YM ) THEN
  361.        Knt    :=  L SHR 1
  362.    ELSE
  363.        Knt    := ( Y2 - Y1 ) SHR 1;
  364.  
  365.    Y1     := PRED( Y1 );
  366.    Y2     := PRED( Y2 );
  367.  
  368.    X1     := SUCC( X1 );
  369.    X2     := PRED( X2 );
  370.                                    (* Draw series of increasing     *)
  371.                                    (* size boxes, giving appearance *)
  372.                                    (* that box "explodes" from its  *)
  373.                                    (* center.                       *)
  374.  
  375.    FOR I := 1 TO ROUND( Knt / 3 ) DO
  376.       BEGIN
  377.                                    (* Adjust sides *)
  378.  
  379.          IF ( XM > ( X1 - 2 ) ) THEN
  380.             XM := XM - 3
  381.          ELSE IF ( XM > PRED( X1 ) ) THEN
  382.             XM := XM - 2
  383.          ELSE IF ( XM > X1 ) THEN
  384.             XM := PRED( XM );
  385.  
  386.          IF ( XM1 < ( X2 + 2 ) ) THEN
  387.             XM1 := XM1 + 3
  388.          ELSE IF ( XM1 < ( X2 + 1 ) ) THEN
  389.             XM1 := XM1 + 2
  390.          ELSE IF ( XM1 < X2 ) THEN
  391.             XM1 := SUCC( XM1 );
  392.                                    (* Adjust top and bottom *)
  393.  
  394.          IF ( YM > ( Y1 + 2 ) ) THEN
  395.             YM := YM - 3
  396.          ELSE IF ( YM > ( Y1 + 1 ) ) THEN
  397.             YM := YM - 2
  398.          ELSE IF ( YM > Y1 ) THEN
  399.             YM := PRED( YM );
  400.  
  401.          IF ( YM1 < ( Y2 - 2 ) ) THEN
  402.             YM1 := YM1 + 3
  403.          ELSE IF ( YM1 < PRED( Y2 ) ) THEN
  404.             YM1 := YM1 + 2
  405.          ELSE IF ( YM1 < Y2 ) THEN
  406.             YM1 := SUCC( YM1 );
  407.                                    (* Define new window *)
  408.  
  409.          PibTerm_Window( SUCC( XM ), SUCC( YM ), XM1, YM1 );
  410.  
  411.                                    (* Clear it out      *)
  412.          Clear_Window;
  413.                                    (* Draw box          *)
  414.  
  415.          Draw_Box( SUCC( XM ), SUCC( YM ), MIN( LowerRightX , XM1 ),
  416.                    YM1, Frame_Color, Title_Color, '' );
  417.  
  418.       END (* FOR *);
  419.  
  420. END   (* Do_Explosion *);
  421.  
  422. (*----------------------------------------------------------------------*)
  423.  
  424. BEGIN (* Draw_Menu_Frame *)
  425.  
  426.    L  := LowerRightX - UpperLeftX;
  427.    LT := LENGTH( Menu_Title );
  428.                                    (* Adjust title length if necessary *)
  429.  
  430.    IF LT > ( L - 5 ) THEN Menu_Title[0] := CHR( L - 5 );
  431.  
  432.                                    (* Get explosion if requested *)
  433.  
  434.    IF Menu_Explode_Mode THEN Do_Explosion;
  435.  
  436.                                    (* Display actual menu frame       *)
  437.  
  438.    Draw_Box( UpperLeftX, UpperLeftY, LowerRightX, LowerRightY,
  439.              Frame_Color, Title_Color, Menu_Title );
  440.  
  441.                                    (* Establish scrolling window area *)
  442.  
  443.    PibTerm_Window( UpperLeftX+1, UpperLeftY+1, LowerRightX-1, LowerRightY-1 );
  444.  
  445.                                    (* Ensure proper color for text    *)
  446.    TextColor     ( Text_Color );
  447.    TextBackGround( BLACK );
  448.                                    (* Clear out the window area       *)
  449.                                    (* KLUDGE NOTE:  ClrScr doesn't    *)
  450.                                    (* seem to work correctly on mono  *)
  451.                                    (* screens with Turbo 3.0 in the   *)
  452.                                    (* context of PibTerm.             *)
  453. {
  454.    GoToXY( 1 , 1 );
  455.    ClrScr;
  456. }
  457.  
  458.    FOR I := 1 TO PRED( LowerRightY - UpperLeftY ) DO
  459.       BEGIN
  460.          GoToXY( 1 , I );
  461.          ClrEol;
  462.       END;
  463.  
  464.    GoToXY( 1 , 1 );
  465.  
  466. END   (* Draw_Menu_Frame *);
  467.  
  468. (*----------------------------------------------------------------------*)
  469. (*                Menu_Click --- Make short click noise                 *)
  470. (*----------------------------------------------------------------------*)
  471.  
  472. PROCEDURE Menu_Click;
  473.  
  474. (*----------------------------------------------------------------------*)
  475. (*                                                                      *)
  476. (*     Procedure:  Menu_Click                                           *)
  477. (*                                                                      *)
  478. (*     Purpose:    Clicks Terminal Bell                                 *)
  479. (*                                                                      *)
  480. (*     Calling Sequence:                                                *)
  481. (*                                                                      *)
  482. (*        Menu_Click;                                                   *)
  483. (*                                                                      *)
  484. (*     Calls:    Sound                                                  *)
  485. (*               Delay                                                  *)
  486. (*               NoSound                                                *)
  487. (*                                                                      *)
  488. (*----------------------------------------------------------------------*)
  489.  
  490. BEGIN (* Menu_Click *)
  491.  
  492.    IF Menu_Beep_Mode THEN
  493.       BEGIN
  494.          Sound( 2000 );
  495.          DELAY( 10 );
  496.          NoSound;
  497.       END;
  498.  
  499. END   (* Menu_Click *);
  500.  
  501. (*----------------------------------------------------------------------*)
  502. (*                Menu_Beep --- Ring Terminal Bell                      *)
  503. (*----------------------------------------------------------------------*)
  504.  
  505. PROCEDURE Menu_Beep;
  506.  
  507. (*----------------------------------------------------------------------*)
  508. (*                                                                      *)
  509. (*     Procedure:  Menu_Beep                                            *)
  510. (*                                                                      *)
  511. (*     Purpose:    Rings Terminal Bell                                  *)
  512. (*                                                                      *)
  513. (*     Calling Sequence:                                                *)
  514. (*                                                                      *)
  515. (*        Menu_Beep;                                                    *)
  516. (*                                                                      *)
  517. (*     Calls:    None                                                   *)
  518. (*                                                                      *)
  519. (*     Remarks:                                                         *)
  520. (*                                                                      *)
  521. (*        If Menu_Beep_Mode is FALSE, then '<ALERT>' is displayed in    *)
  522. (*        blinking characters on status line for 1 second               *)
  523. (*                                                                      *)
  524. (*----------------------------------------------------------------------*)
  525.  
  526. VAR
  527.    I        : INTEGER;
  528.    J        : INTEGER;
  529.    Save_C25 : PACKED ARRAY[1..7] OF CHAR;
  530.    Save_A25 : PACKED ARRAY[1..7] OF BYTE;
  531.  
  532. BEGIN (* Menu_Beep *)
  533.                                    (* Generate beep if beep mode on *)
  534.    IF Menu_Beep_Mode THEN
  535.       Sound_Bell
  536.    ELSE                            (* Else generate blinking error  *)
  537.       BEGIN
  538.                                    (* Save character, attribute *)
  539.          FOR I := 1 TO 7 DO
  540.              ReadCXY( Save_C25[I], ( 35 + I ), Max_Screen_Line, Save_A25[I] );
  541.  
  542.                                    (* Display blinking error indicator *)
  543.  
  544.          WriteSXY( '<ALERT>', 36, Max_Screen_Line, WHITE + BLINK );
  545.  
  546.          DELAY( One_Second_Delay );
  547.  
  548.                                    (* Restore previous text *)
  549.          FOR I := 1 TO 7 DO
  550.             WriteCXY( Save_C25[I], ( 35 + I ), Max_Screen_Line, Save_A25[I] );
  551.  
  552.       END;
  553.  
  554. END   (* Menu_Beep *);
  555.  
  556. (*----------------------------------------------------------------------*)
  557. (*                Menu_Turn_On --- Highlight Menu Choice                *)
  558. (*----------------------------------------------------------------------*)
  559.  
  560. PROCEDURE Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );
  561.  
  562. (*----------------------------------------------------------------------*)
  563. (*                                                                      *)
  564. (*     Procedure:  Menu_Turn_On                                         *)
  565. (*                                                                      *)
  566. (*     Purpose:    Highlight a menu item using reverse video            *)
  567. (*                                                                      *)
  568. (*     Calling Sequence:                                                *)
  569. (*                                                                      *)
  570. (*        Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );         *)
  571. (*                                                                      *)
  572. (*           Menu      : Menu containing item to highlight              *)
  573. (*           Menu_Item : Menu entry to highlight                        *)
  574. (*                                                                      *)
  575. (*     Calls:    GoToXY                                                 *)
  576. (*               RvsVideoOn                                             *)
  577. (*               RvsVideoOff                                            *)
  578. (*                                                                      *)
  579. (*----------------------------------------------------------------------*)
  580.  
  581. BEGIN (* Menu_Turn_On *)
  582.  
  583.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  584.       BEGIN
  585.  
  586.          GoToXY( Menu_Item_Column, Menu_Item_Row );
  587.  
  588.          TextColor     ( Menu.Menu_Bcolor );
  589.          TextBackGround( Menu.Menu_Tcolor );
  590.  
  591.          WRITE( Menu_Item_Text );
  592.  
  593.          TextColor     ( Menu.Menu_Tcolor );
  594.          TextBackGround( Menu.Menu_Bcolor );
  595.  
  596.       END;
  597.  
  598. END   (* Menu_Turn_On *);
  599.  
  600. (*----------------------------------------------------------------------*)
  601. (*                Menu_Turn_Off --- UnHighlight Menu Choice             *)
  602. (*----------------------------------------------------------------------*)
  603.  
  604. PROCEDURE Menu_Turn_Off( Menu: Menu_Type; Menu_Item : INTEGER );
  605.  
  606. (*----------------------------------------------------------------------*)
  607. (*                                                                      *)
  608. (*     Procedure:  Menu_Turn_Off                                        *)
  609. (*                                                                      *)
  610. (*     Purpose:    Removes highlighting from menu item                  *)
  611. (*                                                                      *)
  612. (*     Calling Sequence:                                                *)
  613. (*                                                                      *)
  614. (*        Menu_Turn_Off( Menu : Menu_Type; Menu_Item : INTEGER );       *)
  615. (*                                                                      *)
  616. (*           Menu        : Menu containing item to unhighlight          *)
  617. (*           RvsVideoOff : Menu entry to un-highlight                   *)
  618. (*                                                                      *)
  619. (*     Calls:    GoToXY                                                 *)
  620. (*                                                                      *)
  621. (*----------------------------------------------------------------------*)
  622.  
  623. BEGIN (* Menu_Turn_Off *)
  624.  
  625.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  626.       BEGIN
  627.  
  628.          GoToXY( Menu_Item_Column , Menu_Item_Row );
  629.  
  630.          TextColor     ( Menu.Menu_TColor );
  631.          TextBackGround( Menu.Menu_BColor );
  632.  
  633.          WRITE( Menu_Item_Text );
  634.  
  635.       END;
  636.  
  637. END   (* Menu_Turn_Off *);
  638.  
  639. (*----------------------------------------------------------------------*)
  640. (*                Menu_IBMCh --- Interpret IBM keyboard chars.          *)
  641. (*----------------------------------------------------------------------*)
  642.  
  643. PROCEDURE Menu_IBMCh( VAR C : CHAR );
  644.  
  645. (*----------------------------------------------------------------------*)
  646. (*                                                                      *)
  647. (*     Procedure:  Menu_IBMCh                                           *)
  648. (*                                                                      *)
  649. (*     Purpose:    Interpret IBM keyboard chars.                        *)
  650. (*                                                                      *)
  651. (*     Calling Sequence:                                                *)
  652. (*                                                                      *)
  653. (*        Menu_IBMCh( Var C : Char );                                   *)
  654. (*                                                                      *)
  655. (*           C --- On input, char following escape;                     *)
  656. (*                 on output, char revised to Wordstar command code.    *)
  657. (*                                                                      *)
  658. (*     Calls:   Read_Kbd_Old                                            *)
  659. (*                                                                      *)
  660. (*----------------------------------------------------------------------*)
  661.  
  662. BEGIN  (* Menu_IBMCh *)
  663.  
  664.    Read_Kbd_Old( C );
  665.  
  666.    CASE ORD( C ) OF
  667.  
  668.       U_Arrow : C := Up_Arrow;
  669.       D_Arrow : C := Down_Arrow;
  670.       L_Arrow : C := Left_Arrow;
  671.       R_Arrow : C := Right_Arrow;
  672.       ELSE
  673.               C := CHR( ESC );
  674.  
  675.    END;
  676.  
  677. END   (* Menu_IBMCh *);
  678.  
  679. (*----------------------------------------------------------------------*)
  680. (*                Menu_Display_Choices --- Display Menu Choices         *)
  681. (*----------------------------------------------------------------------*)
  682.  
  683. PROCEDURE Menu_Display_Choices( Menu : Menu_Type );
  684.  
  685. (*----------------------------------------------------------------------*)
  686. (*                                                                      *)
  687. (*     Procedure:  Menu_Display_Choices                                 *)
  688. (*                                                                      *)
  689. (*     Purpose:    Displays Menu Choices                                *)
  690. (*                                                                      *)
  691. (*     Calling Sequence:                                                *)
  692. (*                                                                      *)
  693. (*        Menu_Display_Choices( Menu : Menu_Type );                     *)
  694. (*                                                                      *)
  695. (*           Menu --- Menu record to be displayed.                      *)
  696. (*                                                                      *)
  697. (*     Calls:   ClsScr                                                  *)
  698. (*              GoToXY                                                  *)
  699. (*              Draw_Menu_Frame                                         *)
  700. (*              Save_Screen                                             *)
  701. (*                                                                      *)
  702. (*----------------------------------------------------------------------*)
  703.  
  704. VAR
  705.    I    : INTEGER;
  706.    J    : INTEGER;
  707.    XL   : INTEGER;
  708.    YL   : INTEGER;
  709.    XR   : INTEGER;
  710.    YR   : INTEGER;
  711.    MaxX : INTEGER;
  712.    MaxY : INTEGER;
  713.  
  714. BEGIN (* Menu_Display_Choices *)
  715.  
  716.                                    (* Establish menu size *)
  717.    XL := Menu.Menu_Column;
  718.    YL := Menu.Menu_Row;
  719.  
  720.    XR := PRED( LENGTH( Menu.Menu_Title ) + XL );
  721.    YR := YL;
  722.  
  723.    MaxX := MAX( Menu.Menu_Width , ( LENGTH( Menu.Menu_Title ) + 2 ) );
  724.    MaxY := Menu.Menu_Height;
  725.  
  726.    FOR I := 1 TO Menu.Menu_Size DO
  727.       WITH Menu.Menu_Entries[I] DO
  728.       BEGIN
  729.          IF Menu_Item_Row > MaxY THEN MaxY := Menu_Item_Row;
  730.          J := PRED( LENGTH( Menu_Item_Text ) + Menu_Item_Column );
  731.          IF J > MaxX THEN MaxX := J;
  732.       END;
  733.  
  734.    J := PRED( XL + MaxX );
  735.    IF J > XR THEN XR := J;
  736.  
  737.    J := PRED( YL + MaxY );
  738.    IF J > YR THEN YR := J;
  739.  
  740.    XL := XL - 4;
  741.    IF XL < 0 THEN XL := 0;
  742.  
  743.    YL := PRED( YL );
  744.    IF YL < 0 THEN YL := 0;
  745.  
  746.    YR := SUCC( YR );
  747.    IF YR > Max_Screen_Line THEN YR := Max_Screen_Line;
  748.  
  749.    IF XR > Max_Screen_Col THEN XR := Max_Screen_Col;
  750.  
  751.                                    (* Save current screen image *)
  752.                                    (* if not already saved      *)
  753.  
  754.    IF Current_Saved_Screen > 0 THEN
  755.       BEGIN
  756.          IF Saved_Screen_List[ Current_Saved_Screen ] <> Saved_Screen THEN
  757.             Save_Partial_Screen( Saved_Screen, XL, YL, XR, YR );
  758.       END
  759.    ELSE
  760.       Save_Partial_Screen( Saved_Screen, XL, YL, XR, YR );
  761.  
  762.                                    (* Draw the menu frame       *)
  763.  
  764.    Draw_Menu_Frame( XL, YL, XR, YR, Menu.Menu_FColor, Menu.Menu_HColor,
  765.                     Menu.Menu_TColor, Menu.Menu_Title );
  766.  
  767.                                    (* Display Menu Entries *)
  768.  
  769.    FOR I := 1 TO Menu.Menu_Size DO
  770.       WITH Menu.Menu_Entries[I] DO
  771.          BEGIN
  772.             GoToXY( Menu_Item_Column , Menu_Item_Row );
  773.             WRITE( Menu_Item_Text );
  774.          END;
  775.                                    (* Highlight Default Choice *)
  776.  
  777.    Menu_Turn_On( Menu, Menu.Menu_Default );
  778.  
  779. END   (* Menu_Display_Choices *);
  780.  
  781. (*----------------------------------------------------------------------*)
  782. (*                Menu_Get_Choice --- Get Menu Choice                   *)
  783. (*----------------------------------------------------------------------*)
  784.  
  785. FUNCTION Menu_Get_Choice( Menu: Menu_Type; Erase_After: BOOLEAN ) : INTEGER;
  786.  
  787. (*----------------------------------------------------------------------*)
  788. (*                                                                      *)
  789. (*     Function:  Menu_Get_Choice                                       *)
  790. (*                                                                      *)
  791. (*     Purpose:   Retrieves Menu Choice from current menu               *)
  792. (*                                                                      *)
  793. (*     Calling Sequence:                                                *)
  794. (*                                                                      *)
  795. (*        Ichoice := Menu_Get_Choice( Menu       : Menu_Type;           *)
  796. (*                                    Erase_After: BOOLEAN ) : INTEGER; *)
  797. (*                                                                      *)
  798. (*           Menu        --- Currently displayed menu                   *)
  799. (*           Erase_After --- TRUE to erase menu after choice found      *)
  800. (*           Ichoice     --- Returned menu item chosen                  *)
  801. (*                                                                      *)
  802. (*      Calls:   Menu_Click                                             *)
  803. (*               Menu_IBMCh                                             *)
  804. (*               Menu_Turn_Off                                          *)
  805. (*               Menu_Turn_On                                           *)
  806. (*                                                                      *)
  807. (*      Remarks:                                                        *)
  808. (*                                                                      *)
  809. (*         The current menu item is highlighted in reverse video.       *)
  810. (*         It may be chosen by hitting the return key.  Movement        *)
  811. (*         to other menu items is done using the up-arrow and           *)
  812. (*         down-arrow.                                                  *)
  813. (*                                                                      *)
  814. (*         An item may also be chosen by hitting the first character    *)
  815. (*         of that item.                                                *)
  816. (*                                                                      *)
  817. (*----------------------------------------------------------------------*)
  818.  
  819. VAR
  820.    C       : CHAR;
  821.    Current : INTEGER;
  822.    Last    : INTEGER;
  823.    I       : INTEGER;
  824.    Found   : BOOLEAN;
  825.  
  826. BEGIN  (* Menu_Get_Choice *)
  827.                                    (* Increase menu depth *)
  828.  
  829.    INC( Menu_Depth );
  830.  
  831.                                    (* Get default *)
  832.    Current := Menu.Menu_Default;
  833.  
  834.    Last    := PRED( Current );
  835.    IF Last < 1 THEN Last := Menu.Menu_Size;
  836.  
  837.    REPEAT  (* Loop until return key hit *)
  838.  
  839.                                    (* Read a character *)
  840.       Read_Kbd_Old( C );
  841.       Menu_Click;
  842.  
  843.       C := UpCase( C );
  844.                                    (* Convert character to menu code *)
  845.  
  846.       IF ( C = Ch_Esc ) AND PibTerm_KeyPressed THEN
  847.          Menu_IBMCh( C );
  848.                                    (* Process character *)
  849.       CASE C OF
  850.  
  851.          Down_Arrow,
  852.          Right_Arrow,
  853.          Space_Bar     : BEGIN (* Move down menu *)
  854.                             Last    := Current;
  855.                             INC( Current );
  856.                             IF Current > Menu.Menu_Size THEN
  857.                                Current := 1;
  858.                          END;
  859.  
  860.          Left_Arrow,
  861.          Up_Arrow      : BEGIN (* Move up menu *)
  862.                             Last    := Current;
  863.                             DEC( Current );
  864.                             IF Current < 1 THEN
  865.                                Current := Menu.Menu_Size;
  866.                          END   (* Move up menu *);
  867.  
  868.          Ch_Cr         : ;
  869.  
  870.          Ch_Esc        : Current := -1;
  871.  
  872.          ELSE
  873.  
  874.             Found := FALSE;
  875.  
  876.             FOR I := 1 TO Menu.Menu_Size DO
  877.                IF C = UpCase( Menu.Menu_Entries[I].Menu_Item_Text[1] ) THEN
  878.                   BEGIN
  879.                      Found   := TRUE;
  880.                      C       := Ch_Cr;
  881.                      Last    := Current;
  882.                      Current := I;
  883.                   END;
  884.  
  885.             IF ( NOT Found ) THEN Menu_Beep;
  886.  
  887.       END (* CASE *);
  888.                                    (* Highlight new menu choice *)
  889.  
  890.       IF C IN [ Up_Arrow, Down_Arrow, Left_Arrow, Right_Arrow,
  891.                 Space_Bar, Ch_Cr ] THEN
  892.          BEGIN
  893.             Menu_Turn_Off( Menu, Last    );
  894.             Menu_Turn_On ( Menu, Current );
  895.          END;
  896.  
  897.    UNTIL ( C = Ch_CR ) OR ( C = Ch_Esc );
  898.  
  899.                                    (* Return index of chosen value *)
  900.    Menu_Get_Choice := Current;
  901.  
  902.                                    (* Erase menu from display      *)
  903.    IF Erase_After THEN
  904.       Restore_Screen_And_Colors( Saved_Screen );
  905.  
  906.                                    (* Decrease menu depth *)
  907.  
  908.    Menu_Depth := MAX( PRED( Menu_Depth ) , 0 );
  909.  
  910. END   (* Menu_Get_Choice *);
  911.