Metropoli BBS
VIEWER: pphc.pas MODE: TEXT (CP437)
{$A+,B-,D+,E+,F-,G-,I-,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
program help_compiler;

  function upper(const s : string) : string;

    var i : integer;
        hs : string;

    begin
       hs:='';
       for i:=1 to length(s) do
  	 hs:=hs+upcase(s[i]);
       upper:=hs;
    end;

  type
     pstring = ^tstring;

     ptopicrecord = ttopicrecord;

     ttopicrecord = record
        name : pstring;
        startpos : longint;
        next : ptopicrecord;
     end;

  var
     last,topics : ptopicrecord;
     output : file;

  procedure error(const s : string);

    begin
       writeln(s);
       halt(1);
    end;

  procedure parse(const name : string;firstpass : boolean);

    var
       input : text;
       c : char;

    function readstring : string;

      var
         s : string;

      begin
         s:='';
         if ioresult<>0 then
           error('Unerwartetes Dateiende');
         while (((ord(c)>=ord('A')) and (ord(c)<=ord('Z')) or
               (((ord(c)>=ord('a')) and (ord(c)<=ord('z')) or (c='_') do
           begin
              s:=s+c;
              read(input,c);
              if ioresult<>0 then
                error('Unerwartetes Dateiende');
           end;
         readstring:=s;
      end;

    procedure skipspace;

      begin
         while (c=' ') or (c=#9) or (c=#13) or (c=#10) do
           read(input,c);
      end;

  var
     s : string;
     p : ptopicrecord;

  begin
     assign(input,name);
     reset(input);
     if ioresult<>0 then
       error('Eingabedatei '+name+' nicht gefunden');
     read(t,c);
     while true do
       begin
          if eof(input) then
            break;
          if firstpass then
            begin
               if c='\' then
                 begin
                    read(input,c);
                    s:=upper(readstring);
                    if s='TOPIC' then
                      begin
                         skipspace;
                         new(p);
                         p^.next:=nil;
                         s:=upper(readstring);
                         getmem(p^.name,length(s)+1);
                         p^.name^:=s;
                         if topics=nil then
                           topics:=p
                         else
                           last^.next:=p;
                         last:=p;
                      end
                    else if s='INPUT' then
                      begin
                         skipspace;
                         parse(upper(readstring),true);
                      end;
                 end;
            end
          else
            begin
               if c='\' then
                 begin
                    read(input,c);
                    s:=upper(readstring);
                    if s='TOPIC' then
                      begin
                         skipspace;
                         p:=topics;
                         s:=upper(readstring);
                         { es müßte eigentlich jedes Thema vorhanden sein }
                         while p^.name^<>s do
                           p:=p^.next;
                         p^.startpos:=filepos(output);
                      end
                    else if s='INPUT' then
                      begin
                         skipspace;
                         parse(upper(readstring),true);
                      end;
            end;
       end;
     close(input);
  end;

var
   l : longint;
   p : ptopicrecord;

  begin
     writeln('FPK-Helpcompiler Version 0.1   Copyright (c) 1994,95 by FP Klämpfl');
     if paramcount<>2 then
       error('PPHC <Eingabedatei> <Ausgabedatei');
     topics:=nil;
     last:=nil;
     parse(upper(paramstr(1),true);
     assign(output,paramstr(2));
     rewrite(output,1);
     if ioresult<>0 then
       error('Fehler beim Schreiben der Ausgabedatei');
     l:=0;
     p:=topics;
     while p^.next<>nil do
       begin
          inc(l);
          p:=p^.next;
       end;
     seek(output,20+l*4);
     if ioresult<>0 then
       error('Fehler beim Schreiben der Ausgabedatei');
     parse(upper(paramstr(1),false);
     seek(output,16);
     p:=topics;
     while p<>nil do
       begin
          blockwrite(output,p^.startpos,4);
          if ioresult<>0 then
            error('Fehler beim Schreiben der Ausgabedatei');
          p:=p^.next;
       end;
     if ioresult<>0 then
       error('Fehler beim Schreiben der Ausgabedatei');
     close(output);
     if ioresult<>0 then
       error('Fehler beim Schreiben der Ausgabedatei');
  end.
[ RETURN TO DIRECTORY ]