Power-Programmierung/CD1.mdf/pascal/library/dos/nicol/sti_help/makehelp.pas

Pascal/Delphi Source File | 1991-07-28 | 19.6 KB | 596 lines

program makehelp;
{$I-}
uses
  STI_STRN;

Const
  DEBUG_GETSYM            = FALSE;

  MAXHELPITEMS            = 1024;
  MAXREFS                 = 128;

  HIGHLIGHTSYM            = '$';
  ESCAPECHAR              = '\';
  NEWPAGEVAL              = 0;
  HBEGIN                  = 1;
  HEND                    = 2;


  EOFSYM                  = 0;
  TITLE                   = 1;
  VERSION                 = 2;
  SIZE                    = 3;
  TEXTCOLOR               = 4;
  FRAMECOLOR              = 5;
  HIGHLIGHTCOLOR          = 6;
  TITLECOLOR              = 7;
  CASESENSE               = 8;
  ENCRYPT                 = 9;
  FRAMETYPE               = 10;
  HELPITEM                = 11;
  TEXT                    = 12;
  NEWPAGE                 = 13;
  ENDTEXT                 = 14;
  REFER                   = 15;
  ENDHELPITEM             = 16;
  ENDSYM                  = 17;
  BLACK                   = 18;
  BLUE                    = 19;
  RED                     = 20;
  GREEN                   = 21;
  CYAN                    = 22;
  YELLOW                  = 23;
  MAGENTA                 = 24;
  WHITE                   = 25;
  BLACKREVERSE            = 26;
  BLUEREVERSE             = 27;
  REDREVERSE              = 28;
  GREENREVERSE            = 29;
  CYANREVERSE             = 30;
  YELLOWREVERSE           = 31;
  MAGENTAREVERSE          = 32;
  WHITEREVERSE            = 33;
  NOBORDER                = 34;
  SPACES                  = 35;
  SINGLELINE              = 36;
  ROUNDCORNERSINGLE       = 37;
  BIGBLOCK                = 38;
  THICKTOPTHINSIDES       = 39;
  THICKDIAGONALCORNER     = 40;

Type
  HelpIdent = record
                Name  : string[32];
                Value : word;
              end;
  HeadType  = record
                Name      : string;
                VMin      : byte;
                VMax      : byte;
                X1,X2     : byte;
                Y1,Y2     : byte;
                TextCol   : byte;
                FrameCol  : byte;
                HighCol   : byte;
                TitleCol  : byte;
                CaseSense : byte;
                FrameType : byte;
                Encrypt   : byte;
                MaxRefI   : word;
                NoRefs    : word;
              end;
  HelpItemT = record
                HelpID    : word;
                TextLen   : word;
                Refs      : array[1..MAXREFS] of word;
              end;


Var
  InFile       : file of char;
  Inch         : char;
  OutFile      : file;

  HelpIDTable  : array[1..MAXHELPITEMS] of ^HelpIdent;
  NumHelpItems : word;
  Header       : HeadType;
  HelpItemBuff : HelpItemT;

{---------------------------------------------------------------------------}

procedure Abort(S : string);                {mama I'm dying....             }

begin
  writeln;                                  {whack in a return              }
  writeln;                                  {and another                    }
  writeln(S);                               {write the message              }
  close(Infile);                            {close the input                }
  Halt;                                     {then die gracefully            }
end;

{---------------------------------------------------------------------------}

function GetToken : string;                 {return a token to the caller   }

label
  jump;

var
  temp : string;                            {temporary string buffer        }

begin
  Inch := #0;                               {null input character           }
  temp := '';                               {null temp                      }

jump:
  while (Inch < #33) and not(eof(Infile))do {skip white spaces              }
    begin
      read(Infile,Inch);                    {continue reading characters    }
    end;

  if Inch = ';' then
    begin
      while(Inch <> #10) do
        read(InFile,Inch);
      goto jump;
    end;
  temp := temp+Inch;                        {build up buffer                }
  if eof(InFile) then temp := 'EOF ';       {end of file command            }
  while (Inch > #33) and not(eof(Infile)) and (Inch <> '"') do
    begin
      read(Infile,Inch);                    {get next character             }
      if Inch = '"' then                    {this is a text area            }
    begin
      while Inch <> '"' do              {loop until the next match      }
        begin
          read(Infile,Inch );           {get a character                }
          temp := temp+Inch;            {add it to temp verbatim        }
        end;
        Seek(InFile,FilePos(InFile)-1); {skip back one char             }
    end else
      if Inch <> '$' then               {this is a highlught character  }
          temp := temp+Inch;            {this is temp                   }
  end;
  if DEBUG_GETSYM then
    writeln('Symbol = ',temp);
  gettoken := copy(temp,1,length(temp)-1);  {return the token               }
end;

{---------------------------------------------------------------------------}

function GetKeyword : byte;                 {return the command type        }

var
   temp  : byte;                            {temporary storage for type     }
   token : string;                          {this is the token to match     }

begin
  temp  := 255;                             {this is the error code         }
  token := GetToken;                        {get a token                    }
  if token = 'EOF'                 then temp := 0   else
  if token = '%TITLE'              then temp := 1   else
  if token = '%VERSION'            then temp := 2   else
  if token = '%SIZE'               then temp := 3   else
  if token = '%TEXTCOLOR'          then temp := 4   else
  if token = '%FRAMECOLOR'         then temp := 5   else
  if token = '%HIGHLIGHTCOLOR'     then temp := 6   else
  if token = '%TITLECOLOR'         then temp := 7   else
  if token = '%CASESENSE'          then temp := 8   else
  if token = '%ENCRYPT'            then temp := 9   else
  if token = '%FRAMETYPE'          then temp := 10  else
  if token = '%HELPITEM'           then temp := 11  else
  if token = '%TEXT'               then temp := 12  else
  if token = '%NEWPAGE'            then temp := 13  else
  if token = '%ENDTEXT'            then temp := 14  else
  if token = '%REFER'              then temp := 15  else
  if token = '%ENDHELPITEM'        then temp := 16  else
  if token = '%END'                then temp := 17  else
  if token = 'BLACK'               then temp := 18  else
  if token = 'BLUE'                then temp := 19  else
  if token = 'RED'                 then temp := 20  else
  if token = 'GREEN'               then temp := 21  else
  if token = 'CYAN'                then temp := 22  else
  if token = 'YELLOW'              then temp := 23  else
  if token = 'MAGENTA'             then temp := 24  else
  if token = 'WHITE'               then temp := 25  else
  if token = 'BLACKREVERSE'        then temp := 26  else
  if token = 'BLUEREVERSE'         then temp := 27  else
  if token = 'REDREVERSE'          then temp := 28  else
  if token = 'GREENREVERSE'        then temp := 29  else
  if token = 'CYANREVERSE'         then temp := 30  else
  if token = 'YELLOWREVERSE'       then temp := 31  else
  if token = 'MAGENTAREVERSE'      then temp := 32  else
  if token = 'WHITEREVERSE'        then temp := 33  else
  if token = 'NOBORDER'            then temp := 34  else
  if token = 'SPACES'              then temp := 35  else
  if token = 'SINGLELINE'          then temp := 36  else
  if token = 'ROUNDCORNERSINGLE'   then temp := 37  else
  if token = 'BIGBLOCK'            then temp := 38  else
  if token = 'THICKTOPTHINSIDES'   then temp := 39  else
  if token = 'THICKDIAGONALCORNER' then temp := 40;
  GetKeyword := temp;                       {return the token type 255 = err}
end;

{---------------------------------------------------------------------------}

procedure Usage;

begin
  writeln('USAGE : makehelp infile outfile');
  halt;
end;

{---------------------------------------------------------------------------}

procedure SetFiles;

begin
  if paramcount < 2 then
    Usage;
  assign(InFile,ParamStr(1));
  reset(InFile);
  if IOResult <> 0 then
    begin
      writeln('Could not find '+ParamStr(1));
      halt;
    end;
  assign(OutFile,ParamStr(2));
  rewrite(OutFile,1);
  if IOResult <> 0 then
    begin
      writeln('Could not create '+ParamStr(2));
      halt;
    end;
end;

{---------------------------------------------------------------------------}

procedure Message;

begin
  writeln('                       STI_HELP Version 2.0');
  writeln('    Copyright (C) 1991,1992 By Software Technology International');
  writeln;
end;

{---------------------------------------------------------------------------}

procedure AddHelpID(HID : HelpIdent);

Var
  Loop : word;

begin
  for Loop := 1 to NumHelpItems do
    begin
      if HelpIDTable[Loop]^.Name = HID.Name then
        Exit;
    end;
  inc(NumHelpItems);
  if NumHelpItems > MAXHELPITEMS then
    begin
      writeln('Help Identifier Table Overflow.');
      halt;
    end;
  new(HelpIDTable[NumHelpItems]);
  HelpIDTable[NumHelpItems]^ := HID;
end;

{---------------------------------------------------------------------------}

procedure Init;

Var
  Loop : word;

begin
  NumHelpItems := 0;
  for Loop := 1 to MAXHELPITEMS do
    HelpIDTable[Loop] := NIL;
  FillChar(Header,sizeof(Header),#0);
  Header.MaxRefI := MAXREFS;
end;

{---------------------------------------------------------------------------}

procedure GetVal(S1,S2 : string; Var Variable; dtype : byte);

var
  check : integer;
  wval  : word absolute Variable;
  bval  : byte absolute Variable;

begin
  case dtype of
     1 : Val(S2,wval,check);
     2 : Val(S2,bval,check);
  end;
  if Check <> 0 then
    begin
      writeln;
      writeln('Illegal format for ',S1);
    end;
end;

{---------------------------------------------------------------------------}

procedure AssignColor(S1 : string; Var Dest : byte; From : Byte);

begin
  Dest := From;
  if not(From in[18..33]) then
    begin
      writeln;
      writeln('Illegal color for ',S1);
    end;
end;

{---------------------------------------------------------------------------}

procedure AssignFrame(S1 : string; Var Dest : byte; From : Byte);

begin
  Dest := From;
  if not(From in[34..40]) then
    begin
      writeln;
      writeln('Illegal frame type for ',S1);
    end;
end;

{---------------------------------------------------------------------------}

function GetOnOff : byte;

Var
  Dummy : string;
  Temp  : byte;

begin
  Dummy := GetToken;
  Temp  := 1;
  if Dummy = 'OFF' then
    Temp := 0
  else
    if Dummy <> 'ON' then
      begin
        writeln;
        writeln('Illegal switch in CASESENSE or ENCRYPT.');
      end;
  GetOnOff := Temp;
end;

{---------------------------------------------------------------------------}

procedure Pass1;

Var
  Keyword : byte;
  Sense   : boolean;
  HelpIDC : word;
  HelpID  : HelpIdent;

begin
  HelpIDC := 0;
  Sense   := FALSE;
  while not(eof(InFile)) do
    begin
      KeyWord := GetKeyWord;
      if Keyword = CASESENSE then
        begin
          if GetToken = 'TRUE' then
            Sense := TRUE
          else
            Sense := FALSE;
        end;
      if Keyword = HELPITEM then
        begin
          inc(HelpIDC);
          HelpID.Name  := GetToken;
          HelpID.Value := HelpIDC;
          if not(Sense) then
            HelpID.Name := UpCaseStr(HelpID.Name);
          write(#13);
          write(MakeStr(79,32));
          write(#13);
          write('Pass #1 : Processing ',HelpID.Name,#13);
          AddHelpID(HelpID);
        end;
    end;
  writeln;
end;

{---------------------------------------------------------------------------}

function FindRef(Tok : string) : word;

Var
  Loop : word;

begin
  for Loop := 1 to NumHelpItems do
    begin
      if HelpIDTable[Loop]^.Name = Tok then
        begin
          FindRef := HelpIDTable[Loop]^.Value;
          Exit;
        end;
    end;
  writeln('Reference ',Tok,' not found.');
  FindRef := 1;
end;

{---------------------------------------------------------------------------}

procedure Pass2;

var
  HeaderOut : boolean;
  Command   : byte;
  Inch2     : char;
  Check     : integer;
  Loop      : word;
  DummyJMP  : longint;
  PSave1,
  PSave2    : longint;
  RefNum    : word;
  toggle    : boolean;
  CharCount : word;

begin
  toggle        := FALSE;
  DummyJMP      := 0;
  HeaderOut     := TRUE;
  Header.NoRefs := NumHelpItems;
  Command       := 255;
  Seek(Infile,0);
  while Command <> EOFSYM do
    begin
      Command := GetKeyword;
      write('Pass #2 : Command = ',Command:4,#13);
      case Command of
        TITLE       : begin
                        Inch2 := #0;
                        while (Inch2 <> '"') do
                          Read(InFile,Inch2);
                        Read(InFile,Inch2);
                        repeat
                          begin
                            Header.Name := Header.Name + Inch2;
                            Read(InFile,Inch2);
                          end;
                        until Inch2 = '"';
                      end;
        VERSION     : begin
                        GetVal('Version MAX',GetToken,Header.VMax,2);
                        GetVal('Version MIN',GetToken,Header.VMin,2);
                      end;
        SIZE        : begin
                        GetVal('Size X1',GetToken,Header.X1,2);
                        GetVal('Size Y1',GetToken,Header.Y1,2);
                        GetVal('Size X2',GetToken,Header.X2,2);
                        GetVal('Size Y2',GetToken,Header.Y2,2);
                      end;
        TEXTCOLOR   : begin
                        Command := GetKeyword;
                        AssignColor('TEXTCOLOR',Header.TextCol,Command);
                      end;
        FRAMECOLOR  : begin
                        Command := GetKeyword;
                        AssignColor('FRAMECOLOR',Header.FrameCol,Command);
                      end;
        HIGHLIGHTCOLOR : begin
                        Command := GetKeyword;
                        AssignColor('HIGHLIGHTCOLOR',Header.HighCol,Command);
                      end;
        TITLECOLOR  : begin
                        Command := GetKeyword;
                        AssignColor('TITLECOLOR',Header.TitleCol,Command);
                      end;
        FRAMETYPE   : begin
                        Command := GetKeyword;
                        AssignFrame('FRAMETYPE',Header.FrameType,Command);
                      end;
        CASESENSE   : begin
                        Header.CaseSense := GetOnOff;
                      end;
        ENCRYPT     : begin
                        Header.Encrypt   := GetOnOff;
                      end;
        HELPITEM    : begin
                        if HeaderOut then
                          begin
                            Seek(OutFile,0);
                            blockwrite(OutFile,Header,sizeof(Header));
                            for Loop := 1 to Header.NoRefs do
                              begin
                                blockwrite(OutFile,DummyJMP,sizeof(DummyJMP));
                              end;
                            HeaderOut := False;
                          end;
                        CharCount := 0;
                        RefNum := 0;
                        FillChar(HelpItemBuff,sizeof(HelpItemBuff),#0);
                        PSave1 := FilePos(OutFile);
                        HelpItemBuff.HelpID := FindRef(GetToken);
                        blockwrite(outFile,HelpItemBuff,sizeof(HelpItemBuff));
                        Command := GetKeyWord;
                        while Command <> ENDHELPITEM do
                          begin
                            case Command of
                               REFER   : begin
                                           inc(RefNum);
                                           HelpItemBuff.Refs[RefNum] := FindRef(GetToken);
                                         end;
                               NEWPAGE : begin
                                           Inch2 := char(NEWPAGEVAL);
                                           blockwrite(OutFile,Inch2,sizeof(Inch2));
                                           inc(CharCount);
                                         end;
                               ENDTEXT : begin
                                         end;
                               TEXT    : begin
                                           Inch2 := #0;
                                           while (Inch2 <> '"') do
                                             Read(InFile,Inch2);
                                           Read(InFile,Inch2);
                                           inc(CharCount);
                                           repeat
                                             begin
                                               if Inch2 = HIGHLIGHTSYM then
                                                 begin
                                                   case toggle of
                                                     FALSE : begin
                                                               toggle := TRUE;
                                                               Inch2  := char(HBEGIN);
                                                             end;
                                                     TRUE  : begin
                                                               toggle := FALSE;
                                                               Inch2  := char(HEND);
                                                             end;
                                                   end;{case}
                                                 end;
                                               if Inch2 = ESCAPECHAR then
                                                 begin
                                                   Read(InFile,Inch2);
                                                 end;
                                               if Header.Encrypt = 1 then
                                                 Inch2 := char(ord(Inch2) xor 20);
                                               blockwrite(OutFile,Inch2,sizeof(Inch2));
                                               inc(CharCount);
                                               Read(InFile,Inch2);
                                             end;
                                           until Inch2 = '"';

                                         end;
                            end;{case}
                            Command := GetKeyword;
                          end;
                        PSave2 := FilePos(OutFile);
                        HelpItemBuff.TextLen := CharCount;
                        Seek(OutFile,sizeof(Header)+((HelpItemBuff.HelpID-1)*sizeof(DummyJMP)));
                        blockwrite(OutFile,PSave1,Sizeof(PSave1));
                        Seek(OutFile,PSave1);
                        blockwrite(OutFile,HelpItemBuff,sizeof(HelpItemBuff));
                        Seek(OutFile,PSave2);
                        PSave2 := FilePos(OutFile);
                     end;
      end;{case}
    end;
  writeln;
end;

{---------------------------------------------------------------------------}

Var
  Dummy : string;

begin
  Init;
  SetFiles;
  Message;
  Pass1;
  Pass2;
  Close(OutFile);
  Close(InFile);
end.