home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / programming / misc_programming / AGUL / AGULMENU.ADB < prev    next >
Encoding:
Text File  |  1990-10-25  |  15.7 KB  |  452 lines
  1. --        ╔═════════════════════════════════════════════════════════════╗
  2. --        ║█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█║
  3. --        ║█                                                           █║
  4. --        ║█                 Meridian Software Systems                 █║
  5. --        ║█                                                           █║
  6. --        ║█                    Copyright (C)  1990                    █║
  7. --        ║█                                                           █║
  8. --        ║█                    ALL RIGHTS RESERVED                    █║
  9. --        ║█                                                           █║
  10. --        ║█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█║
  11. --        ╚═════════════════════════════════════════════════════════════╝
  12.  
  13. --────────────────────────────────────────────────────────────────────────────
  14. --
  15. --  Unit Name :  AGULMENU  -  package body
  16. --
  17. --  Purpose of unit:  This procedure performs the menu operations for the 
  18. --                    AGUL demonstration and test program
  19. --
  20. --────────────────────────────────────────────────────────────────────────────
  21.  
  22. with COMMON_GRAPHIC_TYPES, COMMON_DISPLAY_TYPES, BOX, TTY, INTERRUPT;
  23. use  COMMON_GRAPHIC_TYPES, COMMON_DISPLAY_TYPES, BOX, TTY;
  24.  
  25. package body AGULMENU is
  26.  
  27.   REG_FILE : INTERRUPT.REGISTERS;
  28.  
  29.   --╔══════════════════════════════════════════════════════════════════════════╗
  30.  
  31.   procedure DRAW_MAIN_MENU_BOX is
  32.     LINE1 : constant string := "Ada Graphics Utility Library Demonstration Program";  -- 50 characters long
  33.     LINE2 : constant string := "Function Data Entry Menu";  -- 24 characters long
  34.     LINE3 : constant string := "Operational Information";  -- 23 characters long
  35.   begin
  36.     TTY.CLEAR_SCREEN;
  37.     REG_FILE.AX := 16#0600#;
  38.     REG_FILE.BX := 16#1000#;
  39.     REG_FILE.CX := 16#0000#;
  40.     REG_FILE.DX := 16#184F#;
  41.  
  42.     -- Call interrupt 10h
  43.     INTERRUPT.VECTOR ( ON             => 16#10# ,
  44.                REGISTER_BLOCK => REG_FILE );
  45.  
  46.     ULR := 0;
  47.     ULC := 0;
  48.     LRR := 2;
  49.     LRC := 79;
  50.     BOX.DRAW (UPPER_LEFT_ROW      => ULR,
  51.           UPPER_LEFT_COLUMN   => ULC,
  52.           LOWER_RIGHT_ROW     => LRR,
  53.           LOWER_RIGHT_COLUMN  => LRC,
  54.           KIND                => DOUBLE,
  55.           ATTRIBUTE           => BLUE_BOX,
  56.           PAGE                => 0);
  57.  
  58.     ULR := 3;
  59.     ULC := 0;
  60.     LRR := 5;
  61.     LRC := 39;
  62.     BOX.DRAW (UPPER_LEFT_ROW      => ULR,
  63.           UPPER_LEFT_COLUMN   => ULC,
  64.           LOWER_RIGHT_ROW     => LRR,
  65.           LOWER_RIGHT_COLUMN  => LRC,
  66.           KIND                => DOUBLE,
  67.           ATTRIBUTE           => BLUE_BOX,
  68.           PAGE                => 0);
  69.  
  70.     ULR := 3;
  71.     ULC := 40;
  72.     LRR := 5;
  73.     LRC := 79;
  74.     BOX.DRAW (UPPER_LEFT_ROW      => ULR,
  75.           UPPER_LEFT_COLUMN   => ULC,
  76.           LOWER_RIGHT_ROW     => LRR,
  77.           LOWER_RIGHT_COLUMN  => LRC,
  78.           KIND                => DOUBLE,
  79.           ATTRIBUTE           => CYAN_BOX,
  80.           PAGE                => 0);
  81.  
  82.     ULR := 5;
  83.     ULC := 0;
  84.     LRR := 24;
  85.     LRC := 39;
  86.     BOX.DRAW (UPPER_LEFT_ROW      => ULR,
  87.           UPPER_LEFT_COLUMN   => ULC,
  88.           LOWER_RIGHT_ROW     => LRR,
  89.           LOWER_RIGHT_COLUMN  => LRC,
  90.           KIND                => DOUBLE,
  91.           ATTRIBUTE           => BLUE_BOX,
  92.           PAGE                => 0);
  93.  
  94.     ULR := 5;
  95.     ULC := 40;
  96.     LRR := 12;
  97.     LRC := 79;
  98.     BOX.DRAW (UPPER_LEFT_ROW      => ULR,
  99.           UPPER_LEFT_COLUMN   => ULC,
  100.           LOWER_RIGHT_ROW     => LRR,
  101.           LOWER_RIGHT_COLUMN  => LRC,
  102.           KIND                => DOUBLE,
  103.           ATTRIBUTE           => CYAN_BOX,
  104.           PAGE                => 0);
  105.  
  106.     ULR := 13;
  107.     ULC := 40;
  108.     LRR := 15;
  109.     LRC := 79;
  110.     BOX.DRAW (UPPER_LEFT_ROW      => ULR,
  111.           UPPER_LEFT_COLUMN   => ULC,
  112.           LOWER_RIGHT_ROW     => LRR,
  113.           LOWER_RIGHT_COLUMN  => LRC,
  114.           KIND                => DOUBLE,
  115.           ATTRIBUTE           => GREEN_BOX,
  116.           PAGE                => 0);
  117.  
  118.     ULR := 15;
  119.     ULC := 40;
  120.     LRR := 24;
  121.     LRC := 79;
  122.     BOX.DRAW (UPPER_LEFT_ROW      => ULR,
  123.           UPPER_LEFT_COLUMN   => ULC,
  124.           LOWER_RIGHT_ROW     => LRR,
  125.           LOWER_RIGHT_COLUMN  => LRC,
  126.           KIND                => DOUBLE,
  127.           ATTRIBUTE           => GREEN_BOX,
  128.           PAGE                => 0);
  129.  
  130.     Put (1,  (40 - 25), LINE1, HELP_BC, NORM_BC, NON_BLINK);
  131.     Put (4,  41, "                                      ", ENTRY_FC, ENTRY_BC, NON_BLINK);
  132.     Put (14, 41, "                                      ", HELP_FC, HELP_BC, NON_BLINK);
  133.     Put (4,  (60 - 12), LINE2, ENTRY_FC, ENTRY_BC, NON_BLINK);
  134.     Put (14, (60 - 12), LINE3, HELP_FC, HELP_BC, NON_BLINK);
  135.   end DRAW_MAIN_MENU_BOX;
  136.  
  137.   --╚══════════════════════════════════════════════════════════════════════════╝
  138.  
  139.   --╔══════════════════════════════════════════════════════════════════════════╗
  140.  
  141.   procedure PRINT_MENU (MENU_TYPE : integer) is
  142.     LINES, ROW, COLUMN  : integer;
  143.     FC, BC              : COMMON_DISPLAY_TYPES.COLOR;
  144.   begin
  145.     case MENU_TYPE is
  146.       when 1 => 
  147.         LINES := 11;
  148.         ROW   := 7;
  149.         COLUMN := 2;
  150.         FC     := NORM_FC;
  151.         BC     := NORM_BC;
  152.  
  153.       when 2 => 
  154.         LINES := 5;
  155.         ROW   := 6;
  156.         COLUMN := 42;
  157.         FC     := ENTRY_FC;
  158.         BC     := ENTRY_BC;
  159.  
  160.       when 3 => 
  161.         LINES := 8;
  162.         ROW   := 15;
  163.         COLUMN := 42;
  164.         FC     := HELP_FC;
  165.         BC     := HELP_BC;
  166.  
  167.       when others => null;
  168.     end case;
  169.  
  170.     for COUNTER in 1 .. LINES loop
  171.       Put ((ROW + COUNTER), COLUMN, (MENU_LINE (COUNTER)), FC, BC, NON_BLINK);
  172.     end loop;
  173.   end PRINT_MENU;
  174.  
  175.   --╚══════════════════════════════════════════════════════════════════════════╝
  176.  
  177.   --╔══════════════════════════════════════════════════════════════════════════╗
  178.  
  179.   procedure CLEAR_FUNCTION_WINDOW is
  180.   begin
  181.     REG_FILE.AX := 16#0600#;
  182.     REG_FILE.BX := 16#3000#;
  183.     REG_FILE.CX := 16#0629#;
  184.     REG_FILE.DX := 16#0B4E#;
  185.  
  186.     -- Call interrupt 10h
  187.     INTERRUPT.VECTOR ( ON             => 16#10# ,
  188.                REGISTER_BLOCK => REG_FILE );
  189.   end CLEAR_FUNCTION_WINDOW;
  190.  
  191.   --╚══════════════════════════════════════════════════════════════════════════╝
  192.  
  193.   --╔══════════════════════════════════════════════════════════════════════════╗
  194.  
  195.   procedure CLEAR_INFORMATION_WINDOW is
  196.   begin
  197.     REG_FILE.AX := 16#0600#;
  198.     REG_FILE.BX := 16#2000#;
  199.     REG_FILE.CX := 16#1029#;
  200.     REG_FILE.DX := 16#174E#;
  201.  
  202.     -- Call interrupt 10h
  203.     INTERRUPT.VECTOR ( ON             => 16#10# ,
  204.                REGISTER_BLOCK => REG_FILE );
  205.   end CLEAR_INFORMATION_WINDOW;
  206.  
  207.   --╚══════════════════════════════════════════════════════════════════════════╝
  208.  
  209.   --╔══════════════════════════════════════════════════════════════════════════╗
  210.  
  211.   procedure DISPLAY_VIDEO_MODE is
  212.   begin
  213.     MENU_LINE(1)  := "        Graphic Video Modes         ";
  214.     MENU_LINE(2)  := "                                    ";
  215.     MENU_LINE(3)  := "4  CGA (320x200) | 16  EGA (640x350)";
  216.     MENU_LINE(4)  := "5  CGA (320x200) | 17  VGA (640x480)";
  217.     MENU_LINE(5)  := "6  CGA (640x200) | 17  MCGA(640x480)";
  218.     MENU_LINE(6)  := "13  EGA (320x200)| 18  VGA (640x480)";
  219.     MENU_LINE(7)  := "14  EGA (640x200)| 19  VGA (320x480)";
  220.     MENU_LINE(8)  := "15  EGA (640x350)| 19  MCGA(320x480)";
  221.  
  222.     PRINT_MENU (3);
  223.   end DISPLAY_VIDEO_MODE;
  224.  
  225.   --╚══════════════════════════════════════════════════════════════════════════╝
  226.  
  227.   --╔══════════════════════════════════════════════════════════════════════════╗
  228.  
  229.   procedure DISPLAY_COLOR is
  230.   begin
  231.     MENU_LINE(1)  := "0  -  Black    |   8  -  Grey       ";
  232.     MENU_LINE(2)  := "1  -  Blue     |   9  -  Lgt-Blue   ";
  233.     MENU_LINE(3)  := "2  -  Green    |  10  -  Lgt-Green  ";
  234.     MENU_LINE(4)  := "3  -  Cyan     |  11  -  Lgt-Cyan   ";
  235.     MENU_LINE(5)  := "4  -  Red      |  12  -  Lgt-Red    ";
  236.     MENU_LINE(6)  := "5  -  Magenta  |  13  -  Lgt-Magenta";
  237.     MENU_LINE(7)  := "6  -  Brown    |  14  -  Yellow     ";
  238.     MENU_LINE(8)  := "7  -  White    |  15  -  Brt-White  ";
  239.  
  240.     PRINT_MENU (3);
  241.   end DISPLAY_COLOR;
  242.  
  243.   --╚══════════════════════════════════════════════════════════════════════════╝
  244.  
  245.   --╔══════════════════════════════════════════════════════════════════════════╗
  246.  
  247.   procedure DISPLAY_PIXEL is
  248.   begin
  249.     MENU_LINE(1)  := "The position or coordinate requested";
  250.     MENU_LINE(2)  := "is the pixel position on the screen.";
  251.     MENU_LINE(3)  := "This relative pixel position will   ";
  252.     MENU_LINE(4)  := "vary depending on the video mode    ";
  253.     MENU_LINE(5)  := "selected.                           ";
  254.     MENU_LINE(6)  := "                                    ";
  255.     MENU_LINE(7)  := "                                    ";
  256.     MENU_LINE(8)  := "                                    ";
  257.  
  258.     PRINT_MENU (3);
  259.   end DISPLAY_PIXEL;
  260.  
  261.   --╚══════════════════════════════════════════════════════════════════════════╝
  262.  
  263.   --╔══════════════════════════════════════════════════════════════════════════╗
  264.  
  265.   procedure DISPLAY_ROW is
  266.   begin
  267.     MENU_LINE(1)  := "The row and col (column) position   ";
  268.     MENU_LINE(2)  := "requested above depends on the video";
  269.     MENU_LINE(3)  := "mode selected.  The minimum value is";
  270.     MENU_LINE(4)  := "always 0 while the maximum value for";
  271.     MENU_LINE(5)  := "the row and column is:              ";
  272.     MENU_LINE(6)  := "Mode  row  col  |   Mode  row  col  ";
  273.     MENU_LINE(7)  := "CGA    25   79  |   EGA    79   25  ";
  274.     MENU_LINE(8)  := "VGA    50   79  |   MCGA   79   50  ";
  275.  
  276.     PRINT_MENU (3);
  277.   end DISPLAY_ROW;
  278.  
  279.   --╚══════════════════════════════════════════════════════════════════════════╝
  280.  
  281.   --╔══════════════════════════════════════════════════════════════════════════╗
  282.  
  283.   procedure DISPLAY_FILE_INFO is
  284.   begin
  285.     MENU_LINE(1)  := "The maximum characters you may enter";
  286.     MENU_LINE(2)  := "for file name is 30.  The file name ";
  287.     MENU_LINE(3)  := "may contain the designated drive,   ";
  288.     MENU_LINE(4)  := "path, and file name.  For example,  ";
  289.     MENU_LINE(5)  := "                                    ";
  290.     MENU_LINE(6)  := "For current drive - myfile.scn      ";
  291.     MENU_LINE(7)  := "On another path - C:\draw\myfile.srn";
  292.     MENU_LINE(8)  := "Different drive - D:\screen\new.scn ";
  293.  
  294.     PRINT_MENU (3);
  295.   end DISPLAY_FILE_INFO ;
  296.  
  297.   --╚══════════════════════════════════════════════════════════════════════════╝
  298.  
  299.   --╔══════════════════════════════════════════════════════════════════════════╗
  300.  
  301.   procedure DISPLAY_MENU_INFO is
  302.     LINE : constant string := "   Main Demonstration Menu   ";  -- 28 characters long
  303.   begin
  304.     MENU_LINE(1)  := "[1]   DRAW Package Functions        ";
  305.     MENU_LINE(2)  := "[2]   Window Package Functions      ";
  306.     MENU_LINE(3)  := "[3]   Screen Package Functions      ";
  307.     MENU_LINE(4)  := "[4]   Select Video Mode             ";
  308.     MENU_LINE(5)  := "[5]   Run AGUL User Input Demo      ";
  309.     MENU_LINE(6)  := "[6]   -- future use --              ";
  310.     MENU_LINE(7)  := "[7]   -- future use --              ";
  311.     MENU_LINE(8)  := "[8]   Run AGUL Contineous Demo      ";
  312.     MENU_LINE(9)  := "[9]   -- future use --              ";
  313.     MENU_LINE(10) := "[0]   Exit Package Selection Menu   ";
  314.     MENU_LINE(11) := "Press <RETURN> to select Package    ";
  315.  
  316.     MENU_SELECT := 0;
  317.     Put (4, (20 - 14), LINE, NORM_FC, NORM_BC, NON_BLINK);
  318.     PRINT_MENU (1);
  319.   end DISPLAY_MENU_INFO;
  320.  
  321.   --╚══════════════════════════════════════════════════════════════════════════╝
  322.   --╔══════════════════════════════════════════════════════════════════════════╗
  323.  
  324.   procedure DRAW_MENU is
  325.     LINE : constant string := " DRAW Package Function Menu ";  -- 28 characters long
  326.   begin
  327.     MENU_LINE(1)  := "[1]   Ellipse                       ";
  328.     MENU_LINE(2)  := "[2]   Circle                        ";
  329.     MENU_LINE(3)  := "[3]   Circle_Segment                ";
  330.     MENU_LINE(4)  := "[4]   ARC                           ";
  331.     MENU_LINE(5)  := "[5]   Rectangle                     ";
  332.     MENU_LINE(6)  := "[6]   Line                          ";
  333.     MENU_LINE(7)  := "[7]   Object FillColor              ";
  334.     MENU_LINE(8)  := "[8]   Foreground Color              ";
  335.     MENU_LINE(9)  := "[9]   Background Color              ";
  336.     MENU_LINE(10) := "[0]   Exit to Package Selection Menu";
  337.     MENU_LINE(11) := "Press <RETURN> to select function   ";
  338.  
  339.     MENU_SELECT := 1;
  340.     Put (4, (20 - 14),  LINE, NORM_FC, NORM_BC, NON_BLINK);
  341.     PRINT_MENU (1);
  342.   end DRAW_MENU;
  343.  
  344.   --╚══════════════════════════════════════════════════════════════════════════╝
  345.   --╔══════════════════════════════════════════════════════════════════════════╗
  346.  
  347.   procedure WINDOW_MENU is
  348.     LINE : constant string := "WINDOW Package Function Menu";  -- 28 characters long
  349.   begin
  350.     MENU_LINE(1)  := "[1]   Select Window                 ";
  351.     MENU_LINE(2)  := "[2]   Define Windows                ";
  352.     MENU_LINE(3)  := "[3]   Select World                  ";
  353.     MENU_LINE(4)  := "[4]   Define World Coordinates      ";
  354.     MENU_LINE(5)  := "[5]   Save Window to Disk           ";
  355.     MENU_LINE(6)  := "[6]   Load Window File from Disk    ";
  356.     MENU_LINE(7)  := "[7]   Reset Window                  ";
  357.     MENU_LINE(8)  := "[8]   Reset World                   ";
  358.     MENU_LINE(9)  := "[9]   -- future use --              ";
  359.     MENU_LINE(10) := "[0]   Exit to Package Selection Menu";
  360.     MENU_LINE(11) := "Press <RETURN> to select function   ";
  361.  
  362.     MENU_SELECT := 2;
  363.     Put (4, (20 - 14),  LINE, NORM_FC, NORM_BC, non_BLINK);
  364.     PRINT_MENU (1);
  365.   end WINDOW_MENU;
  366.  
  367.   --╚══════════════════════════════════════════════════════════════════════════╝
  368.  
  369.   --╔══════════════════════════════════════════════════════════════════════════╗
  370.  
  371.   procedure SCREEN_MENU is
  372.     LINE : constant string := "SCREEN Package Function Menu";  -- 28 characters long
  373.   begin
  374.     MENU_LINE(1)  := "[1]   Video Page0                   ";
  375.     MENU_LINE(2)  := "[2]   Video Page1                   ";
  376.     MENU_LINE(3)  := "[3]   Swap Video Pages              ";
  377.     MENU_LINE(4)  := "[4]   Save Active Screen to Disk    ";
  378.     MENU_LINE(5)  := "[5]   Load File to Active Screen    ";
  379.     MENU_LINE(6)  := "[6]   Copy Video Page0 to Page1     ";
  380.     MENU_LINE(7)  := "[7]   -- future use --              ";
  381.     MENU_LINE(8)  := "[8]   -- future use --              ";
  382.     MENU_LINE(9)  := "[9]   -- future use --              ";
  383.     MENU_LINE(10) := "[0]   Exit to Package Selection Menu";
  384.     MENU_LINE(11) := "Press <RETURN> to select function   ";
  385.  
  386.     MENU_SELECT := 3;
  387.     Put (4, (20 - 14),  LINE, NORM_FC, NORM_BC, non_BLINK);
  388.     PRINT_MENU (1);
  389.   end SCREEN_MENU;
  390.  
  391.   --╚══════════════════════════════════════════════════════════════════════════╝
  392.  
  393.   --╔══════════════════════════════════════════════════════════════════════════╗
  394.  
  395.   procedure DISPLAY_MENU (MENU : integer) is
  396.   begin
  397.     case MENU is
  398.       when 0 =>
  399.     TTY.CLEAR_SCREEN;
  400.         DRAW_MAIN_MENU_BOX;
  401.         CLEAR_FUNCTION_WINDOW;
  402.         CLEAR_INFORMATION_WINDOW;
  403.         DISPLAY_MENU_INFO;
  404.  
  405.       when 1 =>
  406.     CLEAR_FUNCTION_WINDOW;
  407.         CLEAR_INFORMATION_WINDOW;
  408.         DISPLAY_MENU_INFO;
  409.  
  410.       when 2 =>
  411.     CLEAR_FUNCTION_WINDOW;
  412.         CLEAR_INFORMATION_WINDOW;
  413.         DRAW_MENU;
  414.  
  415.       when 3 =>
  416.     CLEAR_FUNCTION_WINDOW;
  417.         CLEAR_INFORMATION_WINDOW;
  418.         WINDOW_MENU;
  419.  
  420.       when 4 =>
  421.     CLEAR_FUNCTION_WINDOW;
  422.         CLEAR_INFORMATION_WINDOW;
  423.         SCREEN_MENU;
  424.  
  425.       when 5 =>
  426.     CLEAR_INFORMATION_WINDOW;
  427.  
  428.       when 6 =>
  429.     DISPLAY_VIDEO_MODE;
  430.  
  431.       when 7 =>
  432.     DISPLAY_COLOR;
  433.  
  434.       when 8 =>
  435.     DISPLAY_PIXEL;
  436.  
  437.       when 9 =>
  438.     DISPLAY_ROW;
  439.  
  440.       when 10 =>
  441.     DISPLAY_FILE_INFO;
  442.  
  443.       when others =>
  444.     null;
  445.  
  446.     end case;
  447.   end DISPLAY_MENU;
  448.  
  449.   --╚══════════════════════════════════════════════════════════════════════════╝
  450.  
  451. end AGULMENU;
  452.