home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_tmnu / menudcmp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-06  |  7.7 KB  |  271 lines
  1. program MenuDeCompiler;                     { menu compiler program         }
  2. {$I-}                                       { turn off I/O checking         }
  3.  
  4. Uses
  5.   STI_STRN;
  6.  
  7. Const
  8.   MAXSTRLEN = 60;
  9.  
  10. Type
  11.   Dumm = array[1..2] of byte;
  12.   Head = record
  13.            Name      : string[MAXSTRLEN];
  14.            Version   : word;
  15.            Mode      : byte;
  16.            Save      : boolean;
  17.            BackColor : byte;
  18.            InputS    : byte;
  19.            NumMenus  : word;
  20.          end;
  21.   Sel  = record
  22.            Prompt    : string[MAXSTRLEN];
  23.            Jump      : boolean;
  24.            Value     : word;
  25.          end;
  26.   Posy = record
  27.            MenuID    : word;
  28.            Position  : longint;
  29.          end;
  30.   Ent  = record
  31.            MenuID    : word;
  32.            MenuTitle : string[MAXSTRLEN];
  33.            MenuType  : byte;
  34.            BorderType: byte;
  35.            BodyCol   : byte;
  36.            BorderCol : byte;
  37.            TextCol   : byte;
  38.            HighLight : byte;
  39.            PromptCol : byte;
  40.            TitleCol  : byte;
  41.            Size      : array[1..4] of byte;
  42.            SelectNum : word;
  43.          end;
  44.  
  45. Var
  46.   InputFile   : file;                       { input file                    }
  47.   Buffer      : string;                     { parse buffer                  }
  48.   Token       : string;                     { current token                 }
  49.   Header      : Head;                       { menu file header              }
  50.   HeadWRFlag  : boolean;                    { has the header been written   }
  51.   Buff        : Posy;                       { position buffer               }
  52.   Menu        : Ent;                        { currently processed menu      }
  53.   Select      : Sel;                        { currently processed selection }
  54.  
  55. {---------------------------------------------------------------------------}
  56.  
  57. procedure Error(Message : string);
  58.  
  59. begin
  60.   writeln;
  61.   writeln('Error : ',Message);
  62.   writeln;
  63.   halt;
  64. end;
  65.  
  66. {---------------------------------------------------------------------------}
  67.  
  68. procedure Usage;
  69.  
  70. begin
  71.   writeln;
  72.   writeln('Usage : MENUDCMP <inputfile>');
  73.   writeln;
  74.   halt;
  75. end;
  76.  
  77. {---------------------------------------------------------------------------}
  78.  
  79. procedure Message;
  80.  
  81. begin
  82.   writeln(';');
  83.   writeln(';                                MENUDCMP');
  84.   writeln(';                         The STI Menu DeCompiler');
  85.   writeln(';        Copyright (C) 1990,1991,1992 By Sofware Technology International');
  86.   writeln(';                           All Rights Reserved');
  87.   writeln(';');
  88.   writeln('; DeCompiled File : ',UpCaseStr(ParamStr(1)));
  89.   writeln(';');
  90.   writeln;
  91. end;
  92.  
  93. {---------------------------------------------------------------------------}
  94.  
  95. procedure SetFiles;
  96.  
  97. begin
  98.   assign(InputFile,ParamStr(1));
  99.   reset(InputFile,1);
  100.   if IOResult <> 0 then
  101.     Error('Could not open '+UpCaseStr(ParamStr(1)));
  102. end;
  103.  
  104. {---------------------------------------------------------------------------}
  105.  
  106. procedure WriteColor(Col : byte);
  107.  
  108. begin
  109.   Case Col of
  110.     0   : write('BLACK');
  111.     1   : write('BLUE');
  112.     2   : write('GREEN');
  113.     3   : write('CYAN');
  114.     4   : write('RED');
  115.     5   : write('MAGENTA');
  116.     6   : write('YELLOW');
  117.     7   : write('WHITE');
  118.     8   : write('GREYTILED');
  119.     9   : write('BLACKREVERSE');
  120.     10  : write('BLUEREVERSE');
  121.     11  : write('GREENREVERSE');
  122.     12  : write('CYANREVERSE');
  123.     13  : write('REDREVERSE');
  124.     14  : write('MAGENTAREVERSE');
  125.     15  : write('YELLOWREVERSE');
  126.     16  : write('WHITEREVERSE');
  127.     else  write('UNKNOWN');
  128.   end;
  129. end;
  130.  
  131. {---------------------------------------------------------------------------}
  132.  
  133. procedure WriteBType(InType : byte);
  134.  
  135. begin
  136.   case InType of
  137.     0  : write('NOBORDER');
  138.     1  : write('SPACEBORDER');
  139.     2  : write('SINGLELINE');
  140.     3  : write('ROUNDCORNERSINGLE');
  141.     4  : write('BIGBLOCK');
  142.     5  : write('THICKTOPTHINSIDES');
  143.     6  : write('THICKDIAGONALCORNER');
  144.     else write('UNKNOWN');
  145.   end;{case}
  146. end;
  147.  
  148. {---------------------------------------------------------------------------}
  149.  
  150. procedure UnpackHeader;
  151.  
  152. begin
  153.   seek(InputFile,0);
  154.   BlockRead(InputFile,Header,sizeof(Head));
  155.   Header.Name[0] := char(ord(Header.Name[0])-2);
  156.   WriteLn('%MENUFILE       "',Header.Name,'"',#9#9#9,'; name of menu file');
  157.   WriteLn('%VERSION         ',lo(Header.Version),' ',hi(Header.Version),#9#9#9,'    ; version number');
  158.   Write(  '%MODE            ');
  159.   if Header.Mode = 1 then
  160.     Write('TEXT')
  161.   else
  162.     Write('GRAPHICS');
  163.   writeln(#9#9#9,'; the menu screen mode');
  164.   write(  '%SAVE            ');
  165.   if Header.Save then
  166.     write('YES')
  167.   else
  168.     write('NO');
  169.   writeln(#9#9#9,'; shall we save the screen ?');
  170.   write(  '%BACKGROUND      ');
  171.   WriteColor(Header.BackColor);
  172.   writeln(#9#9#9,'; the background color');
  173.   write(  '%INPUT           ');
  174.   Case Header.InputS of
  175.     0 : write('KEYS');
  176.     1 : write('MOUSE');
  177.     2 : write('BOTH');
  178.   end;
  179.   writeln(#9#9#9,'; style of input');
  180.   writeln('%NUMBER_MENUS    ',Header.NumMenus,#9#9#9,'; number of menus');
  181.   writeln;
  182.   writeln(';',MakeStr(77,ord('-')));
  183.   writeln(';  The actual menus begin from here');
  184.   writeln(';',MakeStr(77,ord('-')));
  185.   writeln;
  186. end;
  187.  
  188. {---------------------------------------------------------------------------}
  189.  
  190. procedure UnPackRest;
  191.  
  192. Var
  193.   Loop : word;
  194.  
  195. begin
  196.   while not(eof(InputFile)) do
  197.     begin
  198.       BlockRead(InputFile,Menu,sizeof(Ent));
  199.       writeln('%MENU            ',Menu.MenuID,'  "',Menu.MenuTitle,'"',#9#9#9,'; menu identifier');
  200.       write(  '%MENU_TYPE       ');
  201.       if Menu.MenuType = 1 then
  202.         write('BAR')
  203.       else
  204.         write('BOX');
  205.       writeln(#9#9#9,'; menu type');
  206.       write(  '%BODY_COLOR      ');
  207.       WriteColor(Menu.BodyCol);
  208.       writeln(#9#9#9,'; menu body color');
  209.       write(  '%BORDER_COLOR    ');
  210.       WriteColor(Menu.BorderCol);
  211.       writeln(#9#9#9,'; menu border color');
  212.       write(  '%TEXT_COLOR      ');
  213.       WriteColor(Menu.TextCol);
  214.       writeln(#9#9#9,'; menu text color');
  215.       write(  '%HIGHLIGHT_COLOR ');
  216.       WriteColor(Menu.HighLight);
  217.       writeln(#9#9#9,'; menu highlight color');
  218.       write(  '%PROMPT_COLOR    ');
  219.       WriteColor(Menu.PromptCol);
  220.       writeln(#9#9#9,'; menu prompt    color');
  221.       write(  '%TITLE_COLOR     ');
  222.       WriteColor(Menu.TitleCol);
  223.       writeln(#9#9#9,'; menu title     color');
  224.       write(  '%BORDER_TYPE     ');
  225.       WriteBType(Menu.BorderType);
  226.       writeln(#9#9#9,'; menu border type    ');
  227.       writeln(  '%SIZE            ',Menu.Size[1]:4,Menu.Size[2]:4,Menu.Size[3]:4,Menu.Size[4]:4,#9#9#9,'; menu size');
  228.       writeln(  '%SELECTIONS      ',Menu.SelectNum,#9#9#9,'; number of options');
  229.       for Loop := 1 to Menu.SelectNum do
  230.         begin
  231.           BlockRead(InputFile,Select,sizeof(Sel));
  232.           write(  '%SELECTION       "',Select.Prompt,'" ');
  233.           if Select.Jump then
  234.             write('GOTO')
  235.           else
  236.             write('RETURN');
  237.           writeln(' ',Select.Value,#9#9#9,'; Selection # ',Loop);
  238.         end;
  239.       writeln('%END_MENU');
  240.       writeln;
  241.       writeln(';',MakeStr(78,ord('-')));
  242.       writeln;
  243.     end;
  244. end;
  245.  
  246. {---------------------------------------------------------------------------}
  247.  
  248. procedure UnPackMenu;
  249.  
  250. begin
  251.   UnpackHeader;
  252.   BlockRead(InputFile,Buff,sizeof(Posy));
  253.   if Buff.MenuID = 1 then
  254.     Seek(InputFile,Buff.Position)
  255.   else
  256.     Error('Could not find first menu entry');
  257.   UnPackRest;
  258.   writeln('%END_MENUFILE');
  259.   close(InputFile);
  260. end;
  261.  
  262. {---------------------------------------------------------------------------}
  263.  
  264. begin
  265.   Message;
  266.   if ParamCount < 1 then
  267.     Usage;
  268.   SetFiles;
  269.   UnpackMenu;
  270. end.
  271.