home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FFSPAS.ZIP / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  29.2 KB  |  759 lines
  1. PROGRAM democolor;
  2.  
  3. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4. {                              - COLOR & CALC -                            }
  5. {--------------------------------------------------------------------------}
  6. {                         Version 1.0    02/01/90                          }
  7. {--------------------------------------------------------------------------}
  8. {  The TPU source code as shareware is available from:                     }
  9. {                                                                          }
  10. {                        The Final Frontier BBS                            }
  11. {                        1200, 2400, 9600 Baud                             }
  12. {                            (518) 761-0869                                }
  13. {--------------------------------------------------------------------------}
  14. { Written By : William W. Miller, Jr.  Final Frontier Software             }
  15. {              524 Rock Avenue         All rights reserved                 }
  16. {              Chestertown, NY 12817                                       }
  17. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  18.  
  19.  
  20. USES
  21.     globals, crt, dos, fastttt5, winttt5, keyttt5, strnttt5,
  22.     nestttt5, iottt5, miscttt5, readttt5, dirttt5, color55,
  23.     calc55;
  24.  
  25.    { Note : variables defined in GLOBALS.PAS/TPU }
  26.    { Program works with mouse OR keyboard }
  27.  
  28. CONST
  29.    timedelay : INTEGER = 8000;
  30. VAR
  31.    foreground : INTEGER;
  32.    background : INTEGER;
  33.  
  34.    PROCEDURE setup_menus;
  35.    BEGIN
  36.       initialize_menu(mainmenu, ' COLOR Demo ', 0, 0);
  37.       initialize_menu(filemenu, ' File Management Menu ', 0, 0);
  38.       initialize_menu(windowmenu, ' Windows Management Menu ', 0, 0);
  39.       initialize_menu(blockmenu, ' Block Menu ', 0, 0);
  40.       initialize_menu(searchmenu, ' Search Document Menu ', 0, 0);
  41.       initialize_menu(editmenu, ' Edit Document Menu ', 0, 0);
  42.       initialize_menu(optionsmenu, ' Options Menu ', 0, 0);
  43.       initialize_menu(printmenu, ' Print Document Menu ', 0, 0);
  44.       initialize_menu(macromenu, ' Macro Menu ', 0, 0);
  45.       initialize_menu(colormenu, ' Colors Menu ', 0, 0);
  46.       initialize_menu(nestcolor, ' Nested Menu Color ', 0, 0);
  47.       initialize_menu(dircolor, ' Directory Manager Colors ', 0, 0);
  48.       initialize_menu(filemrgmenu, ' File Manager ', 0, 0);
  49.    END;
  50.  
  51.    PROCEDURE define_mainmenu;
  52.    BEGIN
  53.       add_topic(mainmenu, ' File Management Menu ', TRUE, #0, 0, @filemenu);
  54.       add_topic(mainmenu, ' Windows Management Menu ', TRUE, #0, 0, @windowmenu);
  55.       add_topic(mainmenu, ' Block Menu ', TRUE, #0, 0, @blockmenu);
  56.       add_topic(mainmenu, ' Search Document Menu ', TRUE, #0, 0, @searchmenu);
  57.       add_topic(mainmenu, ' Edit Document Menu ', TRUE, #0, 0, @editmenu);
  58.       add_topic(mainmenu, ' Options Menu ', TRUE, #0, 0, @optionsmenu);
  59.       add_topic(mainmenu, ' Print Document Menu ', TRUE, #0, 0, @printmenu);
  60.       add_topic(mainmenu, ' Macros Menu', TRUE, #0, 0, @macromenu);
  61.       add_topic(mainmenu, '-', FALSE, #0, 0, NIL);
  62.       add_topic(mainmenu, ' Colors Menu  Alt-C', TRUE, #174, 0, @colormenu);
  63.       add_topic(mainmenu, '-', FALSE, #0, 0, NIL);
  64.       add_topic(mainmenu, ' cAlendar', TRUE, #0, 807, NIL);
  65.       add_topic(mainmenu, ' calcUlator   Alt-U', TRUE, #150, 1500, NIL);
  66.       add_topic(mainmenu, ' Return       Alt-R', TRUE, #147, 116, NIL);
  67.       add_topic(mainmenu, ' Quit         Alt-X', TRUE, #173, 999, NIL);
  68.    END;
  69.  
  70.    PROCEDURE define_filemenu;
  71.    BEGIN
  72.       nttt.allowesc := TRUE;
  73.       add_topic(filemenu, 'File Manager', TRUE, #0, 0, @filemrgmenu);
  74.       add_topic(filemenu, 'Load', TRUE, #0, 0, NIL);
  75.       add_topic(filemenu, 'Save', TRUE, #0, 0, NIL);
  76.       add_topic(filemenu, 'Read', TRUE, #0, 0, NIL);
  77.       add_topic(filemenu, 'Change Name', FALSE, #0, 0, NIL);
  78.       add_topic(filemenu, 'Write Block', FALSE, #0, 0, NIL);
  79.       add_topic(filemenu, 'OS Shell', FALSE, #0, 0, NIL);
  80.       add_topic(filemenu, 'Global', FALSE, #0, 0, NIL);
  81.       add_topic(filemenu, '-', FALSE, #0, 0, NIL);
  82.       add_topic(filemenu, 'ESC-Return', FALSE, #27, 0, NIL);
  83.    END;
  84.  
  85.    PROCEDURE define_windowmenu;
  86.    BEGIN
  87.       nttt.allowesc := TRUE;
  88.       add_topic(windowmenu, 'Close', TRUE, #0, 0, NIL);
  89.       add_topic(windowmenu, 'Grow', TRUE, #0, 0, NIL);
  90.       add_topic(windowmenu, 'Split', TRUE, #0, 0, NIL);
  91.       add_topic(windowmenu, 'Next', FALSE, #0, 0, NIL);
  92.       add_topic(windowmenu, 'Previous', FALSE, #0, 0, NIL);
  93.       add_topic(windowmenu, 'Shrink', FALSE, #0, 0, NIL);
  94.       add_topic(windowmenu, 'Zoom', FALSE, #0, 0, NIL);
  95.       add_topic(windowmenu, '-', FALSE, #0, 0, NIL);
  96.       add_topic(windowmenu, 'ESC-Return', FALSE, #27, 0, NIL);
  97.    END;
  98.  
  99.    PROCEDURE define_blockmenu;
  100.    BEGIN
  101.       nttt.allowesc := TRUE;
  102.       add_topic(blockmenu, 'mark block Begin', TRUE, #0, 0, NIL);
  103.       add_topic(blockmenu, 'mark block End', TRUE, #0, 0, NIL);
  104.       add_topic(blockmenu, 'Copy Block', TRUE, #0, 0, NIL);
  105.       add_topic(blockmenu, 'Move Block', TRUE, #0, 0, NIL);
  106.       add_topic(blockmenu, 'Delete Block', FALSE, #0, 0, NIL);
  107.       add_topic(blockmenu, 'Unmark Block', FALSE, #0, 0, NIL);
  108.       add_topic(blockmenu, 'Mark Line', TRUE, #0, 0, NIL);
  109.       add_topic(blockmenu, '-', FALSE, #0, 0, NIL);
  110.       add_topic(blockmenu, 'ESC-Return', FALSE, #27, 0, NIL);
  111.    END;
  112.  
  113.    PROCEDURE define_searchmenu;
  114.    BEGIN
  115.       nttt.allowesc := TRUE;
  116.       add_topic(searchmenu, 'Find', TRUE, #0, 0, NIL);
  117.       add_topic(searchmenu, 'Replace', TRUE, #0, 0, NIL);
  118.       add_topic(searchmenu, 'Search Again', TRUE, #0, 0, NIL);
  119.       add_topic(searchmenu, '-', FALSE, #0, 0, NIL);
  120.       add_topic(searchmenu, 'ESC-Return', FALSE, #27, 0, NIL);
  121.    END;
  122.  
  123.    PROCEDURE define_editmenu;
  124.    BEGIN
  125.       nttt.allowesc := TRUE;
  126.       add_topic(editmenu, 'Add Line', TRUE, #0, 0, NIL);
  127.       add_topic(editmenu, 'Delete Line', TRUE, #0, 0, NIL);
  128.       add_topic(editmenu, 'delete to End of Line', TRUE, #0, 0, NIL);
  129.       add_topic(editmenu, 'Insert Line', TRUE, #0, 0, NIL);
  130.       add_topic(editmenu, 'Join Line', FALSE, #0, 0, NIL);
  131.       add_topic(editmenu, 'Split Line', TRUE, #0, 0, NIL);
  132.       add_topic(editmenu, 'Undelete Line', TRUE, #0, 0, NIL);
  133.       add_topic(editmenu, '-', FALSE, #0, 0, NIL);
  134.       add_topic(editmenu, 'ESC-Return', FALSE, #27, 0, NIL);
  135.    END;
  136.  
  137.    PROCEDURE define_optionsmenu;
  138.    BEGIN
  139.       nttt.allowesc := TRUE;
  140.       add_topic(optionsmenu, 'set Auto Indent Off', TRUE, #0, 0, NIL);
  141.       add_topic(optionsmenu, 'set Insert Off', TRUE, #0, 0, NIL);
  142.       add_topic(optionsmenu, 'set Work Wrap Off', TRUE, #0, 0, NIL);
  143.       add_topic(optionsmenu, 'set Print Tab Width', TRUE, #0, 0, NIL);
  144.       add_topic(optionsmenu, 'set Center Tab', FALSE, #0, 0, NIL);
  145.       add_topic(optionsmenu, 'set Left Margin', TRUE, #0, 0, NIL);
  146.       add_topic(optionsmenu, 'set right Margin', TRUE, #0, 0, NIL);
  147.       add_topic(optionsmenu, 'set BackUps Off', TRUE, #0, 0, NIL);
  148.       add_topic(optionsmenu, 'set Default Colors', TRUE, #0, 0, NIL);
  149.       add_topic(optionsmenu, '-', FALSE, #0, 0, NIL);
  150.       add_topic(optionsmenu, 'ESC-Return', FALSE, #27, 0, NIL);
  151.    END;
  152.  
  153.    PROCEDURE define_printmenu;
  154.    BEGIN
  155.       nttt.allowesc := TRUE;
  156.       add_topic(printmenu, 'print All', TRUE, #0, 0, NIL);
  157.       add_topic(printmenu, 'print Block', TRUE, #0, 0, NIL);
  158.       add_topic(printmenu, 'print Line', TRUE, #0, 0, NIL);
  159.       add_topic(printmenu, 'Form Feed', TRUE, #0, 0, NIL);
  160.       add_topic(printmenu, 'set Page Size', FALSE, #0, 0, NIL);
  161.       add_topic(printmenu, 'Initialize Printer', TRUE, #0, 0, NIL);
  162.       add_topic(printmenu, '-', FALSE, #0, 0, NIL);
  163.       add_topic(printmenu, 'ESC-Return', FALSE, #27, 0, NIL);
  164.    END;
  165.  
  166.    PROCEDURE define_macromenu;
  167.    BEGIN
  168.       nttt.allowesc := TRUE;
  169.       add_topic(macromenu, 'Macro Record', TRUE, #0, 0, NIL);
  170.       add_topic(macromenu, 'Read Macro', TRUE, #0, 0, NIL);
  171.       add_topic(macromenu, 'Write Macro', TRUE, #0, 0, NIL);
  172.       add_topic(macromenu, '-', FALSE, #0, 0, NIL);
  173.       add_topic(macromenu, 'ESC-Return', FALSE, #27, 0, NIL);
  174.    END;
  175.  
  176.    PROCEDURE define_colormenu;
  177.    BEGIN
  178.       nttt.allowesc := TRUE;
  179.       add_topic(colormenu, 'Main Screen Colors', TRUE, #0, 801, NIL);
  180.       add_topic(colormenu, 'Ruler Color', TRUE, #0, 312, NIL);
  181.       add_topic(colormenu, 'Menu Colors', TRUE, #0, 0, @nestcolor); {Nest Colors}
  182.       add_topic(colormenu, 'Directory Colors', TRUE, #0, 314, @dircolor);
  183.       add_topic(colormenu, 'Input Screen Colors', TRUE, #0, 313, NIL);
  184.       add_topic(colormenu, 'Display Screen Colors', TRUE, #0, 314, NIL);
  185.       add_topic(colormenu, '-', FALSE, #0, 0, NIL);
  186.       add_topic(colormenu, 'ESC-Return', TRUE, #27, 116, NIL);
  187.       add_topic(colormenu, 'Quit', TRUE, #173, 999, NIL);
  188.    END;
  189.  
  190.    PROCEDURE define_nestcolor;
  191.    BEGIN
  192.       nttt.allowesc := TRUE;
  193.       add_topic(nestcolor, 'main Screen', TRUE, #0, 801, NIL);
  194.       add_topic(nestcolor, 'menu Box', TRUE, #0, 802, NIL);
  195.       add_topic(nestcolor, 'First Capital Letter', TRUE, #0, 803, NIL);
  196.       add_topic(nestcolor, 'Normal Menu Topics', TRUE, #0, 804, NIL);
  197.       add_topic(nestcolor, 'Selected Menu Topics', TRUE, #0, 805, NIL);
  198.       add_topic(nestcolor, 'Non-Selected Menu Topics', TRUE, #0, 806, NIL);
  199.       add_topic(nestcolor, '-', FALSE, #0, 0, NIL);
  200.       add_topic(nestcolor, 'ESC-Return', FALSE, #27, 0, NIL);
  201.    END;
  202.  
  203.    PROCEDURE define_dircolor;
  204.    BEGIN
  205.       nttt.allowesc := TRUE;
  206.       add_topic(dircolor, 'main Screen', TRUE, #0, 901, NIL);
  207.       add_topic(dircolor, 'Frame Color', TRUE, #0, 902, NIL);
  208.       add_topic(dircolor, 'Special Keys Color', TRUE, #0, 903, NIL);
  209.       add_topic(dircolor, 'Main Background Color', TRUE, #0, 904, NIL);
  210.       add_topic(dircolor, 'Normal Files Color', TRUE, #0, 905, NIL);
  211.       add_topic(dircolor, 'Directory Files', TRUE, #0, 906, NIL);
  212.       add_topic(dircolor, 'Selected File Color', TRUE, #0, 907, NIL);
  213.       add_topic(dircolor, '-', FALSE, #0, 0, NIL);
  214.       add_topic(dircolor, 'ESC-Return', FALSE, #27, 0, NIL);
  215.    END;
  216.  
  217.    PROCEDURE define_filemgrmenu;
  218.    BEGIN
  219.       nttt.allowesc := TRUE;
  220.       add_topic(filemrgmenu, 'File Manager', TRUE, #178, 1000, NIL);
  221.       add_topic(filemrgmenu, 'Print       ', TRUE, #0, 0, NIL);
  222.       add_topic(filemrgmenu, 'Save        ', TRUE, #0, 0, NIL);
  223.       add_topic(filemrgmenu, 'Get         ', TRUE, #0, 0, NIL);
  224.       add_topic(filemrgmenu, 'New         ', TRUE, #0, 0, NIL);
  225.       add_topic(filemrgmenu, 'Form Feed   ', TRUE, #0, 0, NIL);
  226.       add_topic(filemrgmenu, 'Authors     ', TRUE, #0, 0, NIL);
  227.       add_topic(filemrgmenu, 'ESC-Return  ', FALSE, #27, 0, NIL);
  228.    END;
  229.  
  230.    {$F+}
  231.    PROCEDURE dummy;
  232.    BEGIN
  233.    END;
  234.    {$F-}
  235.  
  236.    PROCEDURE false_calendar;
  237.    BEGIN
  238.       mkwin(10, 6, 50, 16, white, red, 2);
  239.       writebetween(11, 49, 8, white, red, 'SORRY');
  240.       writebetween(11, 49, 10, white, red, 'The Calendar procedure is');
  241.       writebetween(11, 49, 11, white, red, 'Not available with this');
  242.       writebetween(11, 49, 12, white, red, 'Release.  Calendar may be');
  243.       writebetween(11, 49, 13, white, red, 'released with Version 2 of');
  244.       writebetween(11, 49, 14, white, red, 'the FFSPAS procedures.');
  245.       ch := getkey;
  246.       rmwin;
  247.    END;
  248.  
  249.    {$F+}
  250.    PROCEDURE help_editkeys(VAR ch : CHAR; VAR fieldid : BYTE; VAR refresh : BYTE);
  251.    VAR c1, c2, c3 : BYTE;
  252.    BEGIN
  253.       IF colorscreen THEN
  254.          BEGIN
  255.             c1 := lightcyan; c2 := white; c3 := black;
  256.          END
  257.       ELSE
  258.          BEGIN
  259.             c1 := white; c2 := black; c3 := lightgray;
  260.          END;
  261.       allow_esc(FALSE);
  262.       allow_beep(TRUE);
  263.       IF ch <> #187 THEN
  264.          BEGIN
  265.             oncursor;
  266.             EXIT;
  267.          END;
  268.       offcursor;
  269.       mkwin(1, 1, 40, 25, c1, c3, 2);
  270.       writebetween(1, 40, 2, c2, c3, 'Editing Keys');
  271.       horizline(2, 39, 3, c1, c3, 1);
  272.       writeat(3, 5, c2, c3, 'Move Up      ' + CHR(024));
  273.       writeat(3, 6, c2, c3, 'Move Down    ' + CHR(025));
  274.       writeat(3, 7, c2, c3, 'Move Right   Ctrl -' + CHR(016) + ', Tab or Enter');
  275.       writeat(3, 8, c2, c3, 'Move Left    Ctrl ' + CHR(017) + '- or ShiftTab');
  276.       writeat(3, 9, c2, c3, 'End of line  Press [End]');
  277.       writeat(3, 10, c2, c3, 'Insert       Press [Ins] to toggle');
  278.       writeat(3, 11, c2, c3, 'Del Char     [Del]  or  [Backspace]');
  279.       writeat(3, 12, c2, c3, 'Del Field    Alt-D');
  280.       writeat(3, 13, c2, c3, 'Del Global   Alt-E');
  281.       writeat(3, 14, c2, c3, 'Update       (End Editing)  F10');
  282.       writeat(3, 15, c2, c3, 'Abort        [Esc] [Mouse Button]');
  283.       writeat(3, 17, c2, c3, 'Move between fields by moving the');
  284.       writeat(3, 18, c2, c3, 'mouse.  The left button emulates');
  285.       writeat(3, 19, c2, c3, 'the Enter key and the right button');
  286.       writeat(3, 20, c2, c3, 'the ESC key');
  287.       horizline(2, 39, 22, c1, c3, 2);
  288.       writeat(3, 23, c2, c3, 'Press ESC or a Mouse Button to,');
  289.       writeat(3, 24, c2, c3, 'return to the input screen.');
  290.       REPEAT
  291.          ch := getkey;
  292.          UNTIL (ch = #027) OR (ch = #131) OR (ch = #132) OR (ch = #133);
  293.       ch := #0;
  294.       oncursor;
  295.       rmwin;
  296.    END;
  297.    {$F-}
  298.  
  299.    {$F+}
  300.    PROCEDURE special_ins_hook(INSERT : BOOLEAN);
  301.    BEGIN
  302.       IF INSERT THEN
  303.          BEGIN
  304.             fullcursor;
  305.             writeat(57, 24, white, blue, 'INSERT');
  306.          END;
  307.       IF (NOT INSERT) THEN
  308.          BEGIN
  309.             sizecursor(scantop, scanbot);
  310.             writeat(57, 24, white, blue, '      ');
  311.          END;
  312.       END;
  313.    {$F-}
  314.  
  315.    {$F+}
  316.    PROCEDURE paint_screen;
  317.       {makes the screen look like a word processor}
  318.    BEGIN
  319.       fbox(1, 1, 80, 25, foreground, background, 1); {<=== changed from MKWIN to prevent large # open windows 11/14}
  320.       writeat(1, 25, rulerfcolor, rulerbcolor,
  321.                   padleft('  /-  Main Menu   AltC- Color Menu   AltU- Calculator   Alt-X to Quit  Ver 1.0', 80, ' '));
  322.       writeat(1, 1, rulerfcolor, rulerbcolor,
  323.               '┬┬┬┬┼┬┬┬10┬┬┬┬┼┬┬┬20┬┬┬┬┼┬┬┬30┬┬┬┬┼┬┬┬40┬┬┬┬┼┬┬┬50┬┬┬┬┼┬┬┬60┬┬┬┬┼┬┬┬70┬┬┬┬┼┬┬┬80');
  324.         plainwrite(5, 3, 'Imagine you have written a word processing program and you want to give');
  325.         plainwrite(5, 4, 'the program a full and powerful menu system complete with a calculator');
  326.     plainwrite(5, 5, 'and color support!  NOW three FFSPAS pascal units add even more POWER to');
  327.         plainwrite(5, 6, 'to your programs with easy to use CALCULATOR, COLOR control menu, and');
  328.         plainwrite(5, 7, 'CALENDAR procedures.');
  329.       plainwrite(5, 9, 'COLOR is a PASCAL procedure that display''s a menu to change screen,');
  330.       plainwrite(5, 10, 'menu, or other unit default colors.');
  331.         plainwrite(5, 12, 'CALCULATOR is a procedure to pop-up a calculator from within your');
  332.         plainwrite(5, 13, 'pascal program with ONE line of code.');
  333.       plainwrite(5, 15, 'For starters, press the F10 key or the slash key, and roam around');
  334.       plainwrite(5, 16, 'the menu a little for a demonstration of two of the FFSPAS procedures.');
  335.     plainwrite(5, 18, 'COLOR55 and CALC55 TPU''s are compatible with version 5.5 of Turbo');
  336.         plainwrite(5, 19, 'Pascal.');
  337.       plainwrite(5, 21, 'PROCEDURE - Color(forecolorsel,backcolorsel,forecolor,backcolor)');
  338.       plainwrite(5, 22, 'PROCEDURE - Calculator;');
  339.       savescreen(1);
  340.    END;         {of proc Paint_Screen}
  341.    {$F-}
  342.  
  343.    PROCEDURE quit;
  344.    BEGIN
  345.       reset_startup_mode;
  346.         mkwin(1,1,80,8,white,blue,1);
  347.     writecenter(2, white, blue, 'FFSPAS Units');
  348.         writecenter(3, white, blue, '(c) Copyright 1990 Final Frontier Software');
  349.         writecenter(4, white, blue, 'William W. Miller, Jr.');
  350.         writecenter(5, white, blue, '524 Rock Avenue, Chestertown, New York 12817');
  351.         writecenter(6, white, blue, 'Telephone (518) 494-4097');
  352.         writecenter(7, white, blue, 'Please Register Your Procedures at the Final Frontier BBS (518) 761-0869');
  353.         gotoxy(1, 9);
  354.         beep;
  355.         oncursor;
  356.       HALT(1);
  357.    END;
  358.  
  359.    {$F+}
  360.    PROCEDURE menu_hook(VAR ch : CHAR; code : INTEGER);
  361.    BEGIN
  362.         delay(10);
  363.         savescreen(1);
  364.       CASE ch OF
  365.  
  366.          #150 : BEGIN {ALT-U}
  367.                    IF moused THEN cttt.delaytime := 100;
  368.                    IF NOT moused THEN cttt.delaytime := 0;
  369.                    cttt.points := 2;
  370.                    calculator;
  371.                    assign_idle_hook(dummy);
  372.                    paint_screen;
  373.                    show_nest(mainmenu);
  374.                 END;
  375.  
  376.          #173 : BEGIN {ALT-X}
  377.                    reset_startup_mode;
  378.                    HALT;
  379.                      END;
  380.  
  381.             #174 : BEGIN {ALT-C}
  382.                          show_nest(colormenu); { BACKGROUND SCREEN VIA }
  383.                          endprogram := FALSE; { HOT KEY }
  384.                      END;
  385.  
  386.          #27, #147 : BEGIN
  387.                         restorescreen(1);
  388.                      END;
  389.          END;      {case}
  390.       END;
  391.    {$F-}
  392.  
  393.  
  394.    {$F+}
  395.    PROCEDURE menu_loop;
  396.       {THIS PROCEDURE CHECKS KEYPRESS AND MOUSE PRESS THEN TRANSFERS TO action}
  397.       {procedure FOR MENU SELECTION DETERMINATION}
  398.    VAR ch : CHAR;
  399.    BEGIN
  400.       endprogram := FALSE;
  401.       paint_screen;
  402.       delay(500);
  403.       assign_idle_hook(dummy);
  404.       REPEAT
  405.          ch := getkey;
  406.          CASE ch OF
  407.  
  408.             #132, {Mouse ESC} { <== LEAVE MENUS }
  409.             #27 : BEGIN {ESC}
  410.                      quit;
  411.                   END;
  412.  
  413.             #133, {Mouse Enter} { <== ENTER MENUS }
  414.             #47,   {/}
  415.             #178,  {ALT-M}
  416.             #196 : BEGIN ;
  417.                       show_nest(mainmenu);
  418.                       endprogram := FALSE; {F10}
  419.                    END;
  420.  
  421.             #173 : endprogram := TRUE; {ALT-X} { <== LEAVE Menu's }
  422.  
  423.             #132,
  424.             #174 : BEGIN {ALT-C} { POPUP COLOR MENU FROM }
  425.                       show_nest(colormenu); { BACKGROUND SCREEN VIA }
  426.                       endprogram := FALSE; { HOT KEY }
  427.                    END;
  428.  
  429.             #150 : BEGIN {ALT-U} { POPUP CALCULATOR }
  430.                       IF moused THEN cttt.delaytime := 100;
  431.                       IF NOT moused THEN cttt.delaytime := 0;
  432.                       cttt.points := 2;
  433.                       calculator;
  434.                       assign_idle_hook(dummy);
  435.                       paint_screen;
  436.                    END;
  437.  
  438.             #147 : endprogram := FALSE;
  439.             END;   {case}
  440.          UNTIL endprogram;
  441.       END;
  442.    {$F-}           {end Menu_loop}
  443.  
  444.    {$F+}
  445.    PROCEDURE action(VAR code : INTEGER; VAR finish : BYTE);
  446.       {THIS PROCEDURE CHECKS FOR MENU SELECTIONS}
  447.    VAR
  448.       dirf : STRING;
  449.    BEGIN
  450.         SaveScreen(1);
  451.         CASE code OF
  452.  
  453.          116 : BEGIN {Return pressed}
  454.                   IF endprogram = TRUE THEN
  455.                      BEGIN
  456.                         finish := clearall;
  457.                         quit;
  458.                      END
  459.                   ELSE IF endprogram = FALSE THEN
  460.                      BEGIN
  461.                         finish := clearall;
  462.                         restorescreen(1);
  463.                         menu_loop;
  464.                      END;
  465.                   END; {if}
  466.  
  467.          147 : BEGIN {Return to startup screen}
  468.                   finish := clearall;
  469.                END;
  470.  
  471.          173 : BEGIN {Exit Pgm}
  472.                   reset_startup_mode;
  473.                   endprogram := TRUE;
  474.                   finish := clearall;
  475.                   HALT;
  476.                END;
  477.  
  478.          312 : BEGIN {Ruler Color}
  479.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  480.                   rulerfcolor := forecolor;
  481.                   rulerbcolor := backcolor;
  482.                   forecolor := startforecolor;
  483.                   backcolor := startbackcolor;
  484.                   finish := refreshmenu;
  485.                   paint_screen;
  486.                   show_nest(mainmenu);
  487.                END;
  488.  
  489.          801 : BEGIN {screen colors}
  490.                   finish := dontclear;
  491.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  492.                   foreground := forecolor;
  493.                   background := backcolor;
  494.                   textbackground(backcolor);
  495.                   clrscr;
  496.                   paint_screen;
  497.                   finish := dontclear;
  498.                   show_nest(mainmenu);
  499.                END;
  500.  
  501.          802 : BEGIN {Nest Menu Box}
  502.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  503.                   nttt.norfcol := forecolor;
  504.                   nttt.baccol := backcolor;
  505.                   nttt.boxfcol := forecolor;
  506.                   nttt.boxbcol := backcolor;
  507.                   forecolor := startforecolor;
  508.                   backcolor := startbackcolor;
  509.                   mkwin(1, 1, 80, 25, white, black, 0);
  510.                   rmwin;
  511.                   paint_screen;
  512.                   finish := refreshmenu;
  513.                   show_nest(mainmenu);
  514.                END;
  515.  
  516.          803 : BEGIN {Nest 1st Cap colors}
  517.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  518.                   nttt.capfcol := forecolor;
  519.                   forecolor := startforecolor;
  520.                   backcolor := startbackcolor;
  521.                   mkwin(1, 1, 80, 25, white, black, 0);
  522.                   rmwin;
  523.                   paint_screen;
  524.                   finish := refreshmenu;
  525.                   show_nest(mainmenu);
  526.                END;
  527.  
  528.          804 : BEGIN {Nest Normal Menu Color}
  529.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  530.                   nttt.norfcol := forecolor;
  531.                   nttt.baccol := backcolor;
  532.                   nttt.boxfcol := forecolor;
  533.                   nttt.boxbcol := backcolor;
  534.                   forecolor := startforecolor;
  535.                   backcolor := startbackcolor;
  536.                   mkwin(1, 1, 80, 25, white, black, 0);
  537.                   rmwin;
  538.                   paint_screen;
  539.                   finish := refreshmenu;
  540.                   show_nest(mainmenu);
  541.                END;
  542.  
  543.          805 : BEGIN {Nest Selected Topics Color}
  544.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  545.                   nttt.hifcol := forecolor;
  546.                   nttt.hibcol := backcolor;
  547.                   forecolor := startforecolor;
  548.                   backcolor := startbackcolor;
  549.                   mkwin(1, 1, 80, 25, white, black, 0);
  550.                   rmwin;
  551.                   paint_screen;
  552.                   finish := refreshmenu;
  553.                   show_nest(mainmenu);
  554.                END;
  555.  
  556.          806 : BEGIN {Nest Non-selected Topics Color}
  557.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  558.                   nttt.lofcol := forecolor;
  559.                   forecolor := startforecolor;
  560.                   backcolor := startbackcolor;
  561.                   mkwin(1, 1, 80, 25, white, black, 0);
  562.                   rmwin;
  563.                   paint_screen;
  564.                   finish := refreshmenu;
  565.                   show_nest(mainmenu);
  566.                END;
  567.  
  568.          807 : BEGIN {Display a calendar}
  569.                   false_calendar;
  570.                   finish := dontclear;
  571.                   show_nest(mainmenu);
  572.                END;
  573.  
  574.          902 : BEGIN {DIRTTT Box Fore and Backround Color}
  575.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  576.                   dttt.boxfcol := forecolor;
  577.                   dttt.boxbcol := backcolor;
  578.                   forecolor := startforecolor;
  579.                   backcolor := startbackcolor;
  580.                   mkwin(1, 1, 80, 25, white, black, 0);
  581.                   rmwin;
  582.                   paint_screen;
  583.                   finish := refreshmenu;
  584.                   show_nest(mainmenu);
  585.                END;
  586.  
  587.          903 : BEGIN {DIRTTT Special Key Foreground Color}
  588.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  589.                   dttt.keyfcol := forecolor;
  590.                   forecolor := startforecolor;
  591.                   backcolor := startbackcolor;
  592.                   mkwin(1, 1, 80, 25, white, black, 0);
  593.                   rmwin;
  594.                   paint_screen;
  595.                   finish := refreshmenu;
  596.                   show_nest(mainmenu);
  597.                END;
  598.  
  599.          904 : BEGIN {DIRTTT Main Background Color}
  600.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  601.                   dttt.baccol := forecolor;
  602.                   forecolor := startforecolor;
  603.                   backcolor := startbackcolor;
  604.                   mkwin(1, 1, 80, 25, white, black, 0);
  605.                   rmwin;
  606.                   paint_screen;
  607.                   finish := refreshmenu;
  608.                   show_nest(mainmenu);
  609.                END;
  610.  
  611.          905 : BEGIN {DIRTTT Normal File Color}
  612.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  613.                   dttt.norfcol := forecolor;
  614.                   forecolor := startforecolor;
  615.                   backcolor := startbackcolor;
  616.                   mkwin(1, 1, 80, 25, white, black, 0);
  617.                   rmwin;
  618.                   paint_screen;
  619.                   finish := refreshmenu;
  620.                   show_nest(mainmenu);
  621.                END;
  622.  
  623.          906 : BEGIN {DIRTTT Foreground DIR files}
  624.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  625.                   dttt.dirfcol := forecolor;
  626.                   forecolor := startforecolor;
  627.                   backcolor := startbackcolor;
  628.                   mkwin(1, 1, 80, 25, white, black, 0);
  629.                   rmwin;
  630.                   paint_screen;
  631.                   finish := refreshmenu;
  632.                   show_nest(mainmenu);
  633.                END;
  634.  
  635.          907 : BEGIN {DIRTTT Selected file color}
  636.                   color(forecolorsel, backcolorsel, forecolor, backcolor);
  637.                   dttt.hifcol := forecolor;
  638.                   dttt.hibcol := backcolor;
  639.                   forecolor := startforecolor;
  640.                   backcolor := startbackcolor;
  641.                   mkwin(1, 1, 80, 25, white, black, 0);
  642.                   rmwin;
  643.                   paint_screen;
  644.                   finish := refreshmenu;
  645.                   show_nest(mainmenu);
  646.                END;
  647.  
  648.          999 : BEGIN {Exit Program}
  649.                   endprogram := TRUE;
  650.                   finish := clearall;
  651.                   quit;
  652.                END;
  653.  
  654.          1000 : BEGIN {Display Directory Manager}
  655.                    dirf := display_directory(mask, r);
  656.                    finish := dontclear;
  657.                 END;
  658.  
  659.          1500 : BEGIN {Calculator}
  660.                    IF moused THEN cttt.delaytime := 100;
  661.                    IF NOT moused THEN cttt.delaytime := 0;
  662.                    cttt.points := 2;
  663.                    calculator;
  664.                    assign_idle_hook(dummy);
  665.                    paint_screen;
  666.                    finish := refreshmenu;
  667.                    show_nest(mainmenu);
  668.                 END;
  669.          END;
  670.       END;
  671.    {$F-}
  672.  
  673.    PROCEDURE credit;
  674.    BEGIN
  675.       mkwin(10, 6, 50, 21, white, red, 2);
  676.       writebetween(11, 49, 8, white, red, 'FFSPAS Units');
  677.       writebetween(11, 49, 9, white, red, 'To toggle screen or menu colors');
  678.       writebetween(11, 49, 10, white, red, 'and to provide calculator support.');
  679.       writebetween(11, 49, 12, white, red, 'William W. Miller, Jr.');
  680.       writebetween(11, 49, 13, white, red, 'Brian Dunworth');
  681.       writebetween(11, 49, 14, white, red, 'The Final Frontier - A Pascal BBS');
  682.       writebetween(11, 49, 15, white, red, 'Glens Falls, N.Y. (518) 761-0869');
  683.       writebetween(11, 49, 17, white, red, 'Program review provided by');
  684.       writebetween(11, 49, 18, white, red, 'George Butts of the BufferBoard');
  685.       writebetween(11, 49, 19, white, red, 'BBS Oregon (503) 747-7636');
  686.       ch := getkey;
  687.       rmwin;
  688.    END;
  689.  
  690.  
  691.  
  692. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  693. {                                 MAIN PROGRAM                              }
  694. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  695. BEGIN
  696.    IF numon THEN set_num(FALSE);
  697.    forecolor := 15;
  698.    backcolor := 0;
  699.    foreground := 15;
  700.    background := 0;
  701.    startforecolor := 15;
  702.    startbackcolor := 0;
  703.    rulerfcolor := 15;
  704.    rulerbcolor := 4;
  705.    cleartext(1, 1, 80, 25, forecolor, backcolor);
  706.    textattr := white;
  707.    setup_menus;
  708.    define_mainmenu;
  709.    define_filemenu;
  710.    define_windowmenu;
  711.    define_blockmenu;
  712.    define_searchmenu;
  713.    define_editmenu;
  714.    define_optionsmenu;
  715.    define_printmenu;
  716.    define_macromenu;
  717.    define_colormenu;
  718.    define_nestcolor;
  719.    define_dircolor;
  720.    define_filemgrmenu;
  721.    assign_despatcher(action);
  722.    WITH nttt DO
  723.       BEGIN
  724.          x := 0;
  725.          y := 4;
  726.          allowesc := FALSE;
  727.          leftside := FALSE;
  728.          boxfcol := black;
  729.          boxbcol := lightgray;
  730.          boxtype := 1;
  731.          capfcol := white;
  732.          baccol := lightgray;
  733.          norfcol := black;
  734.          lofcol := black;
  735.          hifcol := lightgray;
  736.          hibcol := blue;
  737.          leftchar := ' ';
  738.          rightchar := ' ';
  739.          mask := '*.*';
  740.          hook := menu_hook;
  741.          END;
  742.    WITH dttt DO
  743.       BEGIN
  744.          topx := 0;
  745.          topy := 3;
  746.          rows := 11;
  747.          zoomline := 23;
  748.          boxtype := 2;
  749.          END;
  750.    findcursor(x, y, scantop, scanbot);
  751.    offcursor;
  752.    create_tables(10);
  753.    set_default_rules(erasedefault + jumpiffull);
  754.    paint_screen;
  755.    credit;
  756.    menu_loop;
  757.    quit;
  758. END.
  759.