home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / MMSRC.ZIP / INIT_MEN.PAS < prev    next >
Pascal/Delphi Source File  |  1988-12-06  |  16KB  |  427 lines
  1.   PROCEDURE Update_Menu_Env;
  2.   VAR Menu_Env : TEXT;
  3.       i : BYTE;
  4.  
  5.     FUNCTION Spell_Color (Color : INTEGER) : STRING;
  6.     BEGIN
  7.       IF Color > 15 THEN
  8.         Color := Color DIV 16;
  9.       CASE Color MOD 16 OF
  10.          0 : Spell_Color := '0 (Black)';
  11.          1 : Spell_Color := '1 (Blue)';
  12.          2 : Spell_Color := '2 (Green)';
  13.          3 : Spell_Color := '3 (Cyan)';
  14.          4 : Spell_Color := '4 (Red)';
  15.          5 : Spell_Color := '5 (Magenta)';
  16.          6 : Spell_Color := '6 (Brown)';
  17.          7 : Spell_Color := '7 (LightGray)';
  18.          8 : Spell_Color := '8 (DarkGray)';
  19.          9 : Spell_Color := '9 (LightBlue)';
  20.         10 : Spell_Color := '10 (LightGreen)';
  21.         11 : Spell_Color := '11 (LightCyan)';
  22.         12 : Spell_Color := '12 (LightRed)';
  23.         13 : Spell_Color := '13 (LightMagenta)';
  24.         14 : Spell_Color := '14 (Yellow)';
  25.         15 : Spell_Color := '15 (White)';
  26.       END;
  27.    END;
  28.  
  29.   BEGIN { Update_Menu_Env }
  30.     IF NOT Env_Changes THEN { nothing to update }
  31.       EXIT;
  32.     ASSIGN (Menu_Env,'MENUENV.DAT');
  33.     {$I-}
  34.     REWRITE (Menu_Env);
  35.     {$I+}
  36.     IO_Error := IORESULT;
  37.     IF IO_Error <> 0 THEN
  38.       BEGIN
  39.         Show_Error (IO_Error+100,10,21,fgNErr+bgNErr); { I/O ERROR }
  40.         EXIT;
  41.       END;
  42.     WRITELN (Menu_Env,'Header Toggle = ',Header_Toggle);
  43.     WRITELN (Menu_Env,'Date & Time Toggle = ',Date_Time_Toggle);
  44.     WRITELN (Menu_Env,'Help Toggle = ',Help_Toggle);
  45.  
  46.     WRITELN (Menu_Env,'Foreground Color-MAIN = ',Spell_Color(fgMain));
  47.     WRITELN (Menu_Env,'Background Color-MAIN = ',Spell_Color(bgMain));
  48.  
  49.     WRITELN (Menu_Env,'Foreground Color-COMMAND = ',Spell_Color(fgCmnd));
  50.     WRITELN (Menu_Env,'Background Color-COMMAND = ',Spell_Color(bgCmnd));
  51.  
  52.     WRITELN (Menu_Env,'Foreground Color-NAME = ',Spell_Color(fgName));
  53.     WRITELN (Menu_Env,'Background Color-NAME = ',Spell_Color(bgName));
  54.  
  55.     WRITELN (Menu_Env,'Foreground Color-OPTION HIGHLIGHTS = ',Spell_Color(fgHOpt));
  56.     WRITELN (Menu_Env,'Background Color-OPTION HIGHLIGHTS = ',Spell_Color(bgHOpt));
  57.  
  58.     WRITELN (Menu_Env,'Foreground Color-OPTION SELECT KEYS = ',Spell_Color(fgSlct));
  59.     WRITELN (Menu_Env,'Background Color-OPTION SELECT KEYS = ',Spell_Color(bgSlct));
  60.  
  61.     WRITELN (Menu_Env,'Foreground Color-HELP = ',Spell_Color(fgHelp));
  62.     WRITELN (Menu_Env,'Background Color-HELP = ',Spell_Color(bgHelp));
  63.  
  64.     WRITELN (Menu_Env,'Foreground Color-ERRORS = ',Spell_Color(fgNErr));
  65.     WRITELN (Menu_Env,'Background Color-ERRORS = ',Spell_Color(bgNErr));
  66.  
  67.     WRITELN (Menu_Env,'Foreground Color-NOTES = ',Spell_Color(fgNote));
  68.     WRITELN (Menu_Env,'Background Color-NOTES = ',Spell_Color(bgNote));
  69.  
  70.     WRITELN (Menu_Env,'Foreground Color-FATAL ERRORS = ',Spell_Color(fgFErr));
  71.     WRITELN (Menu_Env,'Background Color-FATAL ERRORS = ',Spell_Color(bgFErr));
  72.  
  73.     WRITELN (Menu_Env,'Foreground Color-WARNINGS = ',Spell_Color(fgWarn));
  74.     WRITELN (Menu_Env,'Background Color-WARNINGS = ',Spell_Color(bgWarn));
  75.  
  76.     WRITELN (Menu_Env,'Foreground Color-INPUT FIELDS = ',Spell_Color(fgInpt));
  77.     WRITELN (Menu_Env,'Background Color-INPUT FIELDS = ',Spell_Color(bgInpt));
  78.  
  79.     FOR i := 1 TO 16 DO
  80.       BEGIN
  81.         WRITELN (Menu_Env,'Foreground Color-MENU BOX ',i,' = ',Spell_Color(fgMenu[i]));
  82.         WRITELN (Menu_Env,'Background Color-MENU BOX ',i,' = ',Spell_Color(bgMenu[i]));
  83.         WRITELN (Menu_Env,'Foreground Color-MENU ',i,' TITLE = ',Spell_Color(fgTitl[i]));
  84.         WRITELN (Menu_Env,'Background Color-MENU ',i,' TITLE = ',Spell_Color(bgTitl[i]));
  85.       END;
  86.     {$I-}
  87.     CLOSE (Menu_Env);
  88.     {$I+}
  89.   END;
  90.  
  91.   PROCEDURE Init_Menu_Manager;
  92.   VAR i : BYTE;
  93.  
  94.     PROCEDURE Get_Environment_Variables;
  95.     VAR Menu_Env : TEXT;
  96.         Opened : BOOLEAN;
  97.         i : BYTE;
  98.  
  99.       FUNCTION CSI (s : STRING) : INTEGER;
  100.       VAR i : INTEGER;
  101.           t : STRING;
  102.       BEGIN
  103.         t := '';
  104.         FOR i := 1 TO LENGTH(s) DO
  105.           IF s[i] IN ['0'..'9'] THEN
  106.             t := CONCAT(t,s[i]);
  107.         IF t = '' THEN
  108.           t := '0';
  109.         VAL (t,i,IO_Error);
  110.         CSI := i;
  111.       END;
  112.  
  113.       PROCEDURE Get_Boolean_Toggle (VAR Toggle : BOOLEAN);
  114.       VAR Line : STRING;
  115.       BEGIN
  116.         Line := '';
  117.         IF NOT EOF(Menu_Env) THEN
  118.           {$I-}
  119.           READLN (Menu_Env,Line);
  120.           {$I+}
  121.         IF POS('TRUE',Upper_Case(Line)) > 0 THEN
  122.           Toggle := TRUE
  123.         ELSE
  124.           Toggle := FALSE;
  125.       END;
  126.  
  127.       PROCEDURE Get_ForeGround_Color (VAR Color : BYTE);
  128.       VAR Line : STRING;
  129.           i : BYTE;
  130.       BEGIN
  131.         Line := '';
  132.         IF NOT EOF(Menu_Env) THEN
  133.           {$I-}
  134.           READLN (Menu_Env,Line);
  135.           {$I+}
  136.         i := Scan(Line,Forwards,EQ,'=');
  137.         IF i < LENGTH(Line) THEN
  138.           DELETE (Line,1,i);
  139.         Color := CSI(Line);
  140.       END;
  141.  
  142.       PROCEDURE Get_BackGround_Color (VAR Color : BYTE);
  143.       VAR Line : STRING;
  144.           i : BYTE;
  145.       BEGIN
  146.         Line := '';
  147.         IF NOT EOF(Menu_Env) THEN
  148.           {$I-}
  149.           READLN (Menu_Env,Line);
  150.           {$I+}
  151.         i := Scan(Line,Forwards,EQ,'=');
  152.         IF i < LENGTH(Line) THEN
  153.           DELETE (Line,1,i);
  154.         Color := CSI(Line) * 16;
  155.       END;
  156.  
  157.     BEGIN { Get_Environment_Variables }
  158.       ASSIGN (Menu_Env,'MENUENV.DAT');
  159.       Opened := FALSE;
  160.       REPEAT
  161.         {$I-}
  162.         RESET (Menu_Env);
  163.         {$I+}
  164.         IO_Error := IORESULT;
  165.         IF IO_Error = 0 THEN
  166.           Opened := TRUE
  167.         ELSE
  168.           IF IO_Error = 2 THEN { file doesn't exist - create it }
  169.             BEGIN
  170.               {$I-}
  171.               REWRITE (Menu_Env);
  172.               {$I+}
  173.               IO_Error := IORESULT;
  174.               IF IO_Error > 0 THEN { have a real problem here... }
  175.                 BEGIN
  176.                   Sound_Bell;
  177.                   WRITELN;
  178.                   WRITELN ('+=====================================+');
  179.                   WRITELN ('|<<<<<<<<<<<<<<<<ERROR>>>>>>>>>>>>>>>>|');
  180.                   WRITELN ('|                                     |');
  181.                   WRITELN ('| "Menu Manager" detected the follow- |');
  182.                   WRITELN ('| ing UNRECOVERABLE error on the RE-  |');
  183.                   WRITELN ('| WRITE of the file "MENUENV.DAT":    |');
  184.                   WRITELN ('|                                     |');
  185.                   WRITELN ('| IORESULT = ',IO_Error:5,'                        |');
  186.                   WRITELN ('|                                     |');
  187.                   WRITELN ('+======================================+');
  188.                   HALT;
  189.                 END;
  190.               {$I-}
  191.               CLOSE (Menu_Env);
  192.               {$I+}
  193.  
  194.               Header_Toggle := TRUE;
  195.               Date_Time_Toggle := TRUE;
  196.               Help_Toggle := TRUE;
  197.               IF VideoMode = 3 THEN { using a color monitor }
  198.                 BEGIN
  199.                   fgMain := White;          { 15 }
  200.                   bgMain := Cyan * 16;      {  3 }
  201.                   fgCmnd := LightCyan;      { 11 }
  202.                   bgCmnd := Blue * 16;      {  1 }
  203.                   fgName := White;          { 15 }
  204.                   bgName := Brown * 16;     {  6 }
  205.                   fgHOpt := White;          { 15 }
  206.                   bgHOpt := Black * 16;     {  0 }
  207.                   fgSlct := White;          { 15 }
  208.                   bgSlct := Red * 16;       {  4 }
  209.                   fgHelp := White;          { 15 }
  210.                   bgHelp := Green * 16;     {  2 }
  211.                   fgNErr := LightCyan;      { 11 }
  212.                   bgNErr := Red * 16;       {  4 }
  213.                   fgNote := Yellow;         { 14 }
  214.                   bgNote := Blue * 16;      {  1 }
  215.                   fgFErr := LightRed;       { 12 }
  216.                   bgFErr := Black;          {  0 }
  217.                   fgWarn := LightGreen;     { 10 }
  218.                   bgWarn := Brown * 16;     {  6 }
  219.                   fgInpt := LightCyan;      { 11 }
  220.                   bgInpt := LightGray * 16; {  7 }
  221.                   FOR i := 1 TO 16 DO
  222.                     BEGIN
  223.                       fgMenu[i] := (i + 13) MOD 16;
  224.                       bgMenu[i] := ((i + 4) MOD 8) * 16;
  225.                       fgTitl[i] := (i + 14) MOD 16;
  226.                       bgTitl[i] := ((i + 3) MOD 8) * 16;
  227.                     END;
  228.                 END
  229.               ELSE { using a black & white monitor }
  230.                 BEGIN
  231.                   fgMain := White;          { 15 }
  232.                   bgMain := Black;          {  0 }
  233.                   fgCmnd := Black;          {  0 }
  234.                   bgCmnd := LightGray * 16; {  7 }
  235.                   fgName := Black;          {  0 }
  236.                   bgName := Blue;           {  1 - produces underline }
  237.                   fgHOpt := White;          { 15 }
  238.                   bgHOpt := Black;          {  0 }
  239.                   fgSlct := DarkGray;       {  8 }
  240.                   bgSlct := LightGray * 16; {  7 }
  241.                   fgHelp := Black;          {  0 }
  242.                   bgHelp := LightGray * 16; {  7 }
  243.                   fgNErr := Black;          {  0 }
  244.                   bgNErr := LightGray * 16; {  7 }
  245.                   fgNote := Black;          {  0 }
  246.                   bgNote := LightGray * 16; {  7 }
  247.                   fgFErr := Black;          {  0 }
  248.                   bgFErr := LightGray * 16; {  7 }
  249.                   fgWarn := Black;          {  0 }
  250.                   bgWarn := LightGray * 16; {  7 }
  251.                   fgInpt := LightGray;      {  7 }
  252.                   bgInpt := Black;          {  0 }
  253.                   FOR i := 1 TO 16 DO
  254.                     BEGIN
  255.                       fgMenu[i] := Black;
  256.                       bgMenu[i] := LightGray * 16;
  257.                       fgTitl[i] := Black;
  258.                       bgTitl[i] := Blue;
  259.                     END;
  260.                 END;
  261.               Env_Changes := TRUE;
  262.               Update_Menu_Env;
  263.             END
  264.           ELSE { have a real probelm here... }
  265.             BEGIN
  266.               Sound_Bell;
  267.               WRITELN;
  268.               WRITELN ('+=====================================+');
  269.               WRITELN ('|<<<<<<<<<<<<<<<<ERROR>>>>>>>>>>>>>>>>|');
  270.               WRITELN ('|                                     |');
  271.               WRITELN ('| "Menu Manager" detected the follow- |');
  272.               WRITELN ('| ing UNRECOVERABLE error on the RE-  |');
  273.               WRITELN ('| SET of the file "MENUENV.DAT":      |');
  274.               WRITELN ('|                                     |');
  275.               WRITELN ('| IORESULT = ',IO_Error:5,'                        |');
  276.               WRITELN ('|                                     |');
  277.               WRITELN ('+======================================+');
  278.               HALT;
  279.             END;
  280.       UNTIL Opened;
  281.  
  282.       Get_Boolean_Toggle (Header_Toggle);
  283.       Get_Boolean_Toggle (Date_Time_Toggle);
  284.       Get_Boolean_Toggle (Help_Toggle);
  285.  
  286.       Get_ForeGround_Color (fgMain);
  287.       Get_BackGround_Color (bgMain);
  288.  
  289.       Get_ForeGround_Color (fgCmnd);
  290.       Get_BackGround_Color (bgCmnd);
  291.  
  292.       Get_ForeGround_Color (fgName);
  293.       Get_BackGround_Color (bgName);
  294.  
  295.       Get_ForeGround_Color (fgHOpt);
  296.       Get_BackGround_Color (bgHOpt);
  297.  
  298.       Get_ForeGround_Color (fgSlct);
  299.       Get_BackGround_Color (bgSlct);
  300.  
  301.       Get_ForeGround_Color (fgHelp);
  302.       Get_BackGround_Color (bgHelp);
  303.  
  304.       Get_ForeGround_Color (fgNErr);
  305.       Get_BackGround_Color (bgNErr);
  306.  
  307.       Get_ForeGround_Color (fgNote);
  308.       Get_BackGround_Color (bgNote);
  309.  
  310.       Get_ForeGround_Color (fgFErr);
  311.       Get_BackGround_Color (bgFErr);
  312.  
  313.       Get_ForeGround_Color (fgWarn);
  314.       Get_BackGround_Color (bgWarn);
  315.  
  316.       Get_ForeGround_Color (fgInpt);
  317.       Get_BackGround_Color (bgInpt);
  318.  
  319.       FOR i := 1 TO 16 DO
  320.         BEGIN
  321.           Get_ForeGround_Color (fgMenu[i]);
  322.           Get_BackGround_Color (bgMenu[i]);
  323.           Get_ForeGround_Color (fgTitl[i]);
  324.           Get_BackGround_Color (bgTitl[i]);
  325.         END;
  326.  
  327.       {$I-}
  328.       CLOSE (Menu_Env);
  329.       {$I+}
  330.     END;
  331.  
  332.   BEGIN
  333.     IF NOT(VideoMode IN [2,3,7]) THEN
  334.       BEGIN
  335.         Sound_Bell;
  336.         WRITELN;
  337.         WRITELN ('+=====================================+');
  338.         WRITELN ('|<<<<<<<<<<<<<<<<ERROR>>>>>>>>>>>>>>>>|');
  339.         WRITELN ('|                                     |');
  340.         WRITELN ('| "Menu Manager" will only work in    |');
  341.         WRITELN ('| the following TEXT (non-graphics)   |');
  342.         WRITELN ('| modes:                              |');
  343.         WRITELN ('|                                     |');
  344.         WRITELN ('|   2 - BW80 - 80x25 Black & White    |');
  345.         WRITELN ('|   3 - CO80 - 80x25 Color            |');
  346.         WRITELN ('|   7 - MONO - 80x25 Black & White    |');
  347.         WRITELN ('|                                     |');
  348.         WRITELN ('| "Menu Manager" detected MODE: ',VideoMode:2,'    |');
  349.         WRITELN ('|                                     |');
  350.         WRITELN ('| Use the DOS "MODE" command to set   |');
  351.         WRITELN ('| an appropriate mode.                |');
  352.         WRITELN ('|                                     |');
  353.         WRITELN ('+=====================================+');
  354.         HALT;
  355.       END;
  356.  
  357.     GetSubModelID;
  358.     CASE SystemID OF
  359.       $F8 : CASE SubModelID OF
  360.               $00 : Config := 'IBM PS/2 Model 80 (16 MHz)';
  361.               $01 : Config := 'IBM PS/2 Model 80 (20 MHz)';
  362.               $09 : Config := 'IBM PS/2 Model 70 (16 MHz)';
  363.               ELSE
  364.                 Config := CONCAT('IBM PS/2 386 Type ',CIS(SubModelID));
  365.             END;
  366.       $F9 : Config := 'IBM PC Convertible';
  367.       $FA : CASE SubModelID OF
  368.               $00 : Config := 'IBM PS/2 Model 30';
  369.               $01 : Config := 'IBM PS/2 Model 25';
  370.               ELSE
  371.                 Config := CONCAT('IBM PS/2 MCGA Type ',CIS(SubModelID));
  372.             END;
  373.       $FB : Config := 'IBM PC XT (256/640)';
  374.       $FC : CASE SubModelID OF
  375.               $00 : Config := 'IBM PC AT (6 MHz) / Compatible';
  376.               $01 : Config := 'IBM PC AT (8 MHz) / Compatible';
  377.               $02 : Config := 'IBM PC XT (286) / Compatbile';
  378.               $04 : Config := 'IBM PS/2 Model 50';
  379.               $05 : Config := 'IBM PS/2 Model 60';
  380.               ELSE
  381.                 Config := CONCAT('IBM PS/2 VGA Type ',CIS(SubModelID));
  382.             END;
  383.       $FD : Config := 'IBM PCjr';
  384.       $FE : Config := 'IBM PC XT / All Compatibles';
  385.       $FF : Config := 'IBM PC';
  386.       ELSE
  387.         Config := CONCAT('UNKNOWN HARDWARE TYPE ',CIS(SystemID));
  388.     END;
  389.  
  390.     IF Have3270 THEN
  391.       CASE ActiveDispDev3270 OF
  392.         $00 : Config2 := '5151 or 5272 Display & Adapter';
  393.         $01 : Config2 := '3295 Display & Adapter';
  394.         $02 : Config2 := '5151 or 5272, Adapter, XGA Graphics';
  395.         $03 : Config2 := '5279 Display, 3270 PC G Adapter';
  396.         $04 : Config2 := '5379 C01 Display,3270 PC GX Adapter';
  397.         $05 : Config2 := '5379 M01 Display,3270 PC GX Adapter';
  398.         $FF : Config2 := 'NOT A 3270 PC DISPLAY & ADAPTER';
  399.         ELSE
  400.           Config2 := CONCAT('UNKNOWN DISPLAY TYPE ',CIS(ActiveDispDev3270));
  401.       END
  402.     ELSE
  403.       CASE ActiveDispDev OF
  404.         $00 : Config2 := 'NO DISPLAY';
  405.         $01 : Config2 := 'MDA With 5151 Monochrome';
  406.         $02 : Config2 := 'CGA With 5153/4 Color';
  407.         $03 : Config2 := 'EGA With 5153/4 Color';
  408.         $04 : Config2 := 'EGA With 515x Color/Monochrome';
  409.         $05 : Config2 := 'PGC With 5175 Color';
  410.         $06 : Config2 := 'VGA With Analog Color/Monochrome';
  411.         $07 : Config2 := 'VGA With Analog Color';
  412.         $08 : Config2 := 'MCGA With Analog Color/Monochrome';
  413.         $09 : Config2 := 'MCGA With Analog Color';
  414.         ELSE
  415.           Config2 := CONCAT('UNKNOWN DISPLAY TYPE ',CIS(ActiveDispDev));
  416.       END;
  417.  
  418.     Config3 := CONCAT(CIS(CRTcols),' columns -by- ',CIS(CRTrows),' rows');
  419.  
  420.     Get_Environment_Variables;
  421.  
  422.     { set global change parameters }
  423.     Changes := FALSE;
  424.     Env_Changes := FALSE;
  425.   END;
  426.  
  427.