Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/tiff/pcl.pas

Pascal/Delphi Source File | 1990-06-27 | 20.8 KB | 745 lines

program PCL_Interpreter;
(* Konvertiert PCL-Druckdateien nach TIFF *)
{$A+,B-,D-,E+,F-,I+,L-,N+,O-,R-,S-,V-}
{$M 32768,0,655360}
{$UNDEF ANALYSE}         (* "DEFINE" für Analyse *)

uses crt, dos, Aus_TIFF; (* oder Aus_CRT statt Aus_TIFF *)

const ESC            = #27;
      Zoll           = 2.54;
      DPI_300        = 1.0 / 300.0;
      An             = true;
      Aus            = not An;
      Prim_Schrift   = true;
      Sek_Schrift    = not Prim_Schrift;
      Aktiviert      = true;
      DeAktiviert    = not Aktiviert;
      MaxStack       = 20;

type StackTyp        = array[1..20] of record X,Y : integer; end;

var PCL_Datei        : text;
    DatName          : PathStr;
    Zeichen          : char;
    Sequenz          : string;
    TextZeile        : string;
    Faktor_V         : integer;
    Val_Result       : integer;

    (* Puffer enthält die Grafikdaten beim Pixeldruck *)
    Puffer           : BufferTyp;
    PufferCnt        : integer;
    XY_Stack         : StackTyp;
    StackCnt         : integer;

    (* Jetzt folgen die relevanten Druck-Kenndaten *)
    RasterDruck      : boolean;
    RasterRand       : integer;
    RasterAuf        : integer;
    Kopf_Pos_X       : integer; (* in 300 DPI-Pixeln *)
    Kopf_Pos_Y       : integer; (* in 300 DPI-Pixeln *)
    CursorSpalte     : integer;
    CursorZeile      : integer;
    SchriftZahl      : integer;
    ZeilenUmbruch    : boolean;
    ZeichenCode      : byte;
    ZeichenArt       : byte;
    SeitenLaenge     : real;
    SeitenBreite     : real;
    ObererRand       : real;
    UntererRand      : real;
    LinkerRand       : real;
    RechterRand      : real;
    ZeilenAbstand    : real;
    ZeichenAbstand   : real;
    FuellM_H         : integer;
    FuellM_V         : integer;
    FuellM_Art       : byte;
(*$IFDEF ANALYSE*)
    DiagLst          : text;
(*$ELSE*)
    Ausgabe_Inited   : boolean;
(*$ENDIF*)


procedure Ausgabe(Str1,Str2 : string);
begin
(*$IFDEF ANALYSE*)
  writeln(DiagLst,Str1,' ',Str2);
  writeln(Str1,' ',Str2);
(*$ENDIF*)
end;

procedure StandardWerte;
(* Standardbesetzung der Kennwerte *)
begin
  Ausgabe('Rücksetzen auf Standardwerte','');
  PufferCnt := 0;
  StackCnt := 0;
  RasterDruck := false;
  RasterRand := 0;
  RasterAuf := 300;
  Kopf_Pos_X := 0;
  Kopf_Pos_Y := 0;
  SchriftZahl := 0;
  ZeichenCode := 0;
  ZeichenArt  := 0;
  FuellM_H := 0;
  FuellM_V := 0;
  FuellM_Art := 0;
  SeitenLaenge := 29.7 / Zoll;
  SeitenBreite := 21.0 / Zoll;
  ObererRand := 0.5;
  UntererRand := 0.5;
  LinkerRand := 0;
  RechterRand := 0;
  ZeilenAbstand := 1.0 / 6.0;
  ZeichenAbstand := 1.0 / 12.0;
  CursorSpalte := 0;
  CursorZeile := 0;
  ZeilenUmbruch := Deaktiviert;
end;

procedure LiesSequenz(var Seq : string);
(* Liest eine Befehlssequenz aus der Datei *)
begin
  FillChar(Seq,SizeOf(string),0);
  if EoF(PCL_Datei) then Zeichen := ' '
  else
  repeat
    read(PCL_Datei,Zeichen);
    if Zeichen > ESC then Seq := Seq + Zeichen;
  until ((Zeichen >= 'A') and (Zeichen <= 'Z'))
  or (Zeichen <= ESC) or EoF(PCL_Datei);
end;

procedure LiesZeile(var Zeile : string);
(* Liest eine normale Textzeile *)
begin
  FillChar(Zeile,SizeOf(string),0);
  Zeichen := ' ';
  if not EoF(PCL_Datei) then
  repeat
    read(PCL_Datei,Zeichen);
    if Zeichen > ESC then Zeile := Zeile + Zeichen;
  until (Zeichen <= ESC) or EoF(PCL_Datei);
end;

procedure Analyse(var Seq : string);
(* Hauptprozedur - analysiert eine Sequenz *)
type Vorzeichen = (Plus,Minus,Ohne);
var Seq_Pos  : integer;
    FunktStr : string[2];
    FunktLen : integer;
    NumWert  : real;
    Vorzeich : Vorzeichen;

 procedure Push_Cursor(X_Param,Y_Param : integer);
 begin
   if StackCnt < 20 then
   begin
     inc(StackCnt);
     XY_Stack[StackCnt].X := X_Param;
     XY_Stack[StackCnt].Y := Y_Param;
   end
   else Fehler('CursorStack-Überlauf ','');
 end;

 procedure Pop_Cursor(var X_Param,Y_Param : integer);
 begin
   if StackCnt > 0 then
   begin
     X_Param := XY_Stack[StackCnt].X;
     Y_Param := XY_Stack[StackCnt].Y;
     dec(StackCnt);
   end
   else Fehler('CursorStack ist leer','');
 end;

 procedure NeueSeite;
 begin
   Ausgabe('SeitenBreite ',R_to_Str(SeitenBreite));
   Ausgabe('SeitenLaenge ',R_to_Str(SeitenLaenge));
   if Ausgabe_Inited then AusgabeExit;
   Ausgabe_Inited := false; (* Eventuell neuer Dateiname? *)
 end;

 procedure ReadNum;
 (* Liest numerischen Wert - Positionszeiger steht am Anfang der
    Zahl und wird auf das erste nichtnumerische Zeichen gesetzt *)
 var NumStr  : string;
     NumCh   : char;
     ValRes  : integer;
 begin
   NumStr := '';
   Vorzeich := Ohne;
   NumCh := upcase(Seq[Seq_Pos]);
   if (NumCh = '+') or (NumCh = '-') then
   begin
     if NumCh = '+' then Vorzeich := Plus
     else Vorzeich := Minus;
     inc(Seq_Pos);
     NumCh := upcase(Seq[Seq_Pos]);
   end;
   while ((NumCh >= '0') and (NumCh <= '9'))
      or (NumCh = '.') do
   begin
     NumStr := NumStr + NumCh;
     inc(Seq_Pos);
     NumCh := upcase(Seq[Seq_Pos]);
   end;
   NumWert := 0;
   if NumStr > ' ' then
   begin
     val(NumStr,NumWert,ValRes);
     if ValRes > 0 then
     begin
       Fehler('numerisches Format ',NumStr);
       NumWert := 0;
     end;
   end;
 end;

 procedure Grafik;
 (* Behandelt Sequenzen zur Rastergrafik *)

  procedure Raster_AnAus; (* "ESC * r" *)
  begin
    inc(Seq_Pos);
    if upcase(Seq[Seq_Pos]) = 'B' then
    begin
      Ausgabe('Ende RasterGrafik','');
      RasterDruck := Aus;
    end
    else
    begin
      ReadNum;
      if (upcase(Seq[Seq_Pos]) = 'A') then
      begin
        if NumWert = 0.0 then
        begin
          RasterRand := round(DPI_300 * LinkerRand);
          RasterDruck := An;
          Ausgabe('Rasterrand = ',R_to_Str(RasterRand));
        end
        else if NumWert = 1.0 then
        begin
          RasterRand := Kopf_Pos_X;
          RasterDruck := An;
          Ausgabe('Rasterrand = ',R_to_Str(RasterRand));
        end
        else Fehler('Falscher Rasterrand ',Seq);
      end
      else Fehler('Rasterrand ',Seq);
    end;
  end;

  procedure Aufloesung; (* "ESC * t" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    if (upcase(Seq[Seq_Pos]) = 'R')
    and ((NumWert = 75.0) or (NumWert = 100.0)
         or (NumWert = 150.0) or (NumWert = 300.0)) then
    begin
      RasterAuf := round(NumWert);
      Ausgabe('RasterAuflösung ',R_to_Str(NumWert));
    end
    else Fehler('Falsche Auflösung ',Seq);
  end;

  procedure RasterZeile; (* "ESC * b" *)
  var Lauf : integer;
      R_Ch : char;
      AnzP : integer;
  begin
    inc(Seq_Pos);
    ReadNum;
    if (upcase(Seq[Seq_Pos]) = 'W')
    and (NumWert >= 0.0) then
    begin
      FillChar(Puffer,SizeOf(Puffer),0);
      PufferCnt := 0;
      for Lauf := 1 to round(NumWert) do
      begin
        read(PCL_Datei,R_Ch);
        inc(PufferCnt);
        Puffer[PufferCnt] := ord(R_Ch);
      end;
      AnzP := 300 div RasterAuf;
      Ausgabe('Rasterzeile','');
(*$IFNDEF ANALYSE*)
      if RasterDruck then
       if NumWert > 0.0 then
      begin
        if not Ausgabe_Inited then
        begin
          AusgabeInit(round(SeitenBreite * 300.0),
                      round(SeitenLaenge * 300.0),
                      DatName,AnzP,Faktor_V);
          Ausgabe_Inited := true;
        end;
        AusgabeDaten(Puffer,PufferCnt,Kopf_Pos_X,Kopf_Pos_Y);
      end;
(*$ENDIF*)
      inc(Kopf_Pos_Y,AnzP);
      Kopf_Pos_X := RasterRand;
    end
    else Fehler('Raster-Sequenz',Seq);
  end;

  procedure Cursor_300; (* "ESC * p" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    if upcase(Seq[Seq_Pos]) = 'X' then
    begin
      case Vorzeich of
       Plus  : inc(Kopf_Pos_X,round(NumWert));
       Minus : dec(Kopf_Pos_X,round(NumWert));
       Ohne  : Kopf_Pos_X := round(NumWert);
      end;
      Ausgabe('Kopf_X = ',R_to_Str(Kopf_Pos_X));
    end
    else if upcase(Seq[Seq_Pos]) = 'Y' then
    begin
      case Vorzeich of
       Plus  : inc(Kopf_Pos_Y,round(NumWert));
       Minus : dec(Kopf_Pos_Y,round(NumWert));
       Ohne  : Kopf_Pos_Y := round(NumWert);
      end;
      Ausgabe('Kopf_Y = ',R_to_Str(Kopf_Pos_Y));
    end
    else Fehler('Position',Seq);
  end;

  procedure Diverses; (* "ESC * c" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    case upcase(Seq[Seq_Pos]) of
     'D' : SchriftZahl := round(NumWert);
     'E' : ZeichenCode :=  round(NumWert);
     'F' : ZeichenArt :=  round(NumWert);
     'A' : FuellM_H := round(NumWert);
     'B' : FuellM_V := round(NumWert);
     'H' : FuellM_H := round(NumWert * 2.4);
     'V' : FuellM_V := round(NumWert * 2.4);
     'P' : FuellM_Art := 0;
     else Fehler('Diverses',Seq);
    end;
  end;

 begin (* Grafik : "ESC *" *)
   inc(Seq_Pos);
   case upcase(Seq[Seq_Pos]) of
    'R' : Raster_AnAus;
    'T' : Aufloesung;
    'B' : RasterZeile;
    'P' : Cursor_300;
    'C' : Diverses;
   end;
 end;

 procedure Positionierung;
 (* Sequenzen zur Druckkopf-Positionierung *)

  procedure SeitenAufbau; (* "ESC & l" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    case upcase(Seq[Seq_Pos]) of
     'P' : begin
             SeitenLaenge := NumWert * ZeilenAbstand;
             Ausgabe('Seitenlänge = ',R_to_Str(SeitenLaenge));
             UntererRand := 0.5;
           end;
     'E' : begin
             ObererRand := NumWert * ZeilenAbstand;
             Ausgabe('Oberer Rand = ',R_to_Str(ObererRand));
             UntererRand := 0.5;
           end;
     'F' : begin
             UntererRand := NumWert * ZeilenAbstand;
             if UntererRand = 0
             then UntererRand := 0.5
             else UntererRand := SeitenLaenge - ObererRand
                               - UntererRand;
             Ausgabe('Unterer Rand = ',R_to_Str(UntererRand));
           end;
     'D' : begin
             ZeilenAbstand := 1.0 / NumWert;
             Ausgabe('Zeilenabstand = ',R_to_Str(ZeilenAbstand));
           end;
     'C' : begin
             ZeilenAbstand := NumWert;
             Ausgabe('Zeilenabstand = ',R_to_Str(ZeilenAbstand));
           end;
     'L' : begin
             if NumWert = 1.0
             then Ausgabe('Perforationssprung aktiviert','')
             else if NumWert = 0.0
             then Ausgabe('Perforationssprung nicht aktiviert','')
             else Fehler('Perforation',Seq);
           end;
     'O' : begin
             if NumWert = 0.0
             then Ausgabe('Seite im Hochformat','')
             else if NumWert = 1.0 then
             begin
                Ausgabe('Seite im Querformat','');
                Fehler('Weitere Bearbeitung nicht möglich','');
                Halt(2);
             end
             else Fehler('Seiten-Mode',Seq);
           end;
     'X' : Ausgabe('Anzahl Kopien = ',R_to_Str(NumWert));
     'H' : begin
             Ausgabe('Neue Seite','');
             NeueSeite;
           end;
     else Fehler('Seitenaufbau',Seq);
    end;
  end;

  procedure Cursor_Etc; (* "ESC & a" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    case upcase(Seq[Seq_Pos]) of
     'C' : begin
             case Vorzeich of
              Plus  : inc(CursorSpalte,round(NumWert));
              Minus : inc(CursorSpalte,round(NumWert));
              Ohne : CursorSpalte := round(NumWert);
             end;
             Ausgabe('Cursor in Spalte ',R_to_Str(CursorSpalte));
             Kopf_Pos_X := round(CursorSpalte * ZeichenAbstand);
           end;
     'R' : begin
             CursorZeile := round(NumWert);
             Ausgabe('Cursor in Zeile ',R_to_Str(CursorZeile));
             Kopf_Pos_Y := round(DPI_300
                 * (CursorZeile * ZeilenAbstand + ObererRand));
           end;
     'H' : begin
             case Vorzeich of
              Plus  : inc(Kopf_Pos_X,round(NumWert / 2.4));
              Minus : dec(Kopf_Pos_X,round(NumWert / 2.4));
              Ohne  : Kopf_Pos_X := round(NumWert / 2.4);
             end;
             Ausgabe('Kopf_X = ',R_to_Str(Kopf_Pos_X));
           end;
     'V' : begin
             case Vorzeich of
              Plus  : inc(Kopf_Pos_Y,round(NumWert / 2.4));
              Minus : dec(Kopf_Pos_Y,round(NumWert / 2.4));
              Ohne  : Kopf_Pos_Y := round(NumWert / 2.4);
             end;
             Ausgabe('Kopf_Y = ',R_to_Str(Kopf_Pos_Y));
           end;
     'L' : begin
             LinkerRand := NumWert * ZeichenAbstand;
             Ausgabe('Linker Rand = ',R_to_Str(LinkerRand));
           end;
     'M' : begin
             RechterRand := NumWert * ZeichenAbstand;
             Ausgabe('Rechter Rand = ',R_to_Str(RechterRand));
           end;
     else Fehler('Cursor_Etc',Seq);
    end;
  end;

  procedure Druck_Schrift; (* "ESC & k" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    case upcase(Seq[Seq_Pos]) of
     'H' : begin
             ZeichenAbstand := NumWert / 120.0;
             Ausgabe('Zeichenabst. = ',R_to_Str(ZeichenAbstand));
           end;
     'G' : Ausgabe('Zeilen-Interpretation: ',R_to_Str(NumWert));
     'S' : if NumWert = 0.0 then
           begin
             ZeichenAbstand := Zoll / 10.0;
             Ausgabe('Normalschrift : Zeichenabstand = ',
                     R_to_Str(ZeichenAbstand));
           end
           else if NumWert = 2.0 then
           begin
             ZeichenAbstand := Zoll / 16.66;
             Ausgabe('Enge Schrift : Zeichenabstand = ',
                     R_to_Str(ZeichenAbstand));
           end
           else Fehler('Schriftwahl ',Seq);
     else Fehler('Druck_Schrift',Seq);
    end;
  end;

  procedure Unterstreichen; (* "ESC & d" *)
  begin
    inc(Seq_Pos);
    case upcase(Seq[Seq_Pos]) of
     'D' : Ausgabe('Automatisches Unterstreichen aktiviert','');
     '@' : Ausgabe('Automatisches Unterstreichen deaktiviert','');
     '3' : begin
             inc(Seq_Pos);
             if upcase(Seq[Seq_Pos]) = 'D'
             then Ausgabe('Variables Unterstreichen aktiviert','')
             else Fehler('V. Unterstreichen ',Seq);
           end
     else Fehler('Unterstreichen ',Seq);
    end;
  end;

  procedure Zeilen_Umbruch; (* "ESC & s" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    if upcase(Seq[Seq_Pos]) = 'C' then
    begin
      if NumWert = 0.0 then
      begin
        ZeilenUmbruch := Aktiviert;
        Ausgabe('Zeilenumbruch aktiviert','');
      end
      else
      begin
        ZeilenUmbruch := DeAktiviert;
        Ausgabe('Zeilenumbruch nicht aktiviert','');
      end;
    end
    else Fehler('Druck_Schrift',Seq);
  end;

  procedure Seite_Anzahl; (* "ESC & 1" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    if upcase(Seq[Seq_Pos]) = 'X'
    then Ausgabe('Anzahl Kopien = ',R_to_Str(NumWert))
    else if upcase(Seq[Seq_Pos]) = 'A' then
    begin (* Seitengröße *)
      case round(NumWert) of
        1 : begin (* Executive *)
              SeitenLaenge := 7.25;
              SeitenBreite := 10.5;
            end;
        2 : begin (* Letter *)
              SeitenLaenge := 8.5;
              SeitenBreite := 11.0;
            end;
        3 : begin (* Legal *)
              SeitenLaenge := 8.5;
              SeitenBreite := 14.0;
            end;
       26 : begin (* DIN A4 *)
              SeitenLaenge := 29.7 / Zoll;
              SeitenBreite := 21.0 / Zoll;
            end;
       80 : begin (* Monarch *)
              SeitenLaenge := 3.875;
              SeitenBreite := 7.5;
            end;
       81 : begin (* Commercial *)
              SeitenLaenge := 4.125;
              SeitenBreite := 9.5;
            end;
       90 : begin (* International DL *)
              SeitenLaenge := 110.0 / Zoll;
              SeitenBreite := 220.0 / Zoll;
            end;
       91 : begin (* International C5 *)
              SeitenLaenge := 162.0 / Zoll;
              SeitenBreite := 229.0 / Zoll;
            end;
       else Fehler('Papierformat',R_to_Str(NumWert));
      end;
    end
    else Fehler('Seite oder Anzahl ', Seq);
  end;

  procedure CursorStack; (* "ESC & f" *)
  begin
    inc(Seq_Pos);
    ReadNum;
    if upcase(Seq[Seq_Pos]) = 'S' then
    begin
      if NumWert = 0.0
      then Push_Cursor(Kopf_Pos_X,Kopf_Pos_Y)
      else if NumWert = 1.0
      then Pop_Cursor(Kopf_Pos_X,Kopf_Pos_Y)
      else Fehler('CursorStack ',Seq);
    end
    else Fehler('CursorStack ',Seq);
  end;

 begin (* Positionierung : "ESC &" *);
   inc(Seq_Pos);
   case upcase(Seq[Seq_Pos]) of
     'L' : SeitenAufbau;
     'A' : Cursor_Etc;
     'K' : Druck_Schrift;
     'D' : Unterstreichen;
     'S' : Zeilen_Umbruch;
     '1' : Seite_Anzahl;
     'F' : CursorStack;
   end;
 end;

 procedure SchriftArt(PrimaerSchrift : boolean);
 (* Sequenz zur Schriftwahl *)
 var Kenn_Str : string;
 begin (* SchriftArt : "(" oder ")" *)
   if PrimaerSchrift
   then Kenn_Str := 'Primärschrift'
   else Kenn_Str := 'Sekundärschrift';
   inc(Seq_Pos);
   if upcase(Seq[Seq_Pos]) = 'S' then
   begin
     inc(Seq_Pos);
     ReadNum;
     case upcase(Seq[Seq_Pos]) of
      'S' : if NumWert = 0.0 then Ausgabe(Kenn_Str,'normal')
            else if NumWert = 1.0 then Ausgabe(Kenn_Str,'kursiv')
            else Fehler(Kenn_Str,Seq);
      'B' : Ausgabe('Intensität '+ Kenn_Str,R_to_Str(NumWert));
      'T' : Ausgabe('Schrifttyp '+ Kenn_Str,R_to_Str(NumWert));
      'V' : Ausgabe('Zeichenhöhe '+ Kenn_Str,R_to_Str(NumWert));
      'H' : Ausgabe('CPI '+ Kenn_Str,R_to_Str(NumWert));
      'P' : if NumWert = 0.0 then Ausgabe(Kenn_Str,'fest')
            else if NumWert = 1.0 then Ausgabe(Kenn_Str,'prop.')
            else Fehler(Kenn_Str,Seq);
     end;
   end
   else if (Seq[Seq_Pos] >= '0') and (Seq[Seq_Pos] <= '9') then
   begin (* Schriftarten laden etc. *)
     ReadNum;
     Ausgabe('Schrift laden ',Seq);
   end
   else Fehler('Schriftart '+ Kenn_Str,Seq);
 end;

 procedure SteuerCode(Aktiv : boolean);
 (* Nur für realen Drucker interessant *)
 begin
 end;

begin (* Analyse *)
(*$IFDEF ANALYSE*)
  write(DiagLst,Seq:24,'  ');
  write(Seq:24,'  ');
(*$ENDIF*)
  Seq_Pos := 1;
  FunktStr := copy(Seq,1,2);
  case upcase(Seq[1]) of (* Unterteilung nach Funtionsgruppen *)
    '*' : Grafik;
    '&' : Positionierung;
    '(' : SchriftArt(Prim_Schrift);
    ')' : SchriftArt(Sek_Schrift);
    'Y' : SteuerCode(Aktiviert);
    'Z' : SteuerCode(DeAktiviert);
    '9' : begin
            LinkerRand := 0;
            RechterRand := 0;
          end;
    '=' : Ausgabe('Halber Zeilenvorschub','');
    'E' : StandardWerte;
    #12 : Ausgabe('Seitenvorschub ','');
    else
    begin
      Fehler('Unbekannter Befehl ',Seq);
      Seq_Pos := 1;
      Seq := ESC;
    end;
  end;
  if (Seq[Seq_Pos] >= 'a') and (Seq[Seq_Pos] <= 'z') then
  begin (* Hinzufügen des Gruppenkennzeichens *)
    FunktLen := length(FunktStr);
    if (FunktStr[FunktLen] >= '0')
    and (FunktStr[FunktLen] <= '9')
    then FunktStr := copy(FunktStr,1,1);
    Seq := copy(Seq,succ(Seq_Pos),255);
    FunktLen := length(FunktStr);
    if FunktStr[FunktLen] = Seq[1]
    then FunktStr := copy(FunktStr,1,pred(FunktLen));
    Seq := FunktStr + Seq;
  end
  else Seq := copy(Seq,succ(Seq_Pos),255)
end;

begin
(*$IFDEF ANALYSE*)
  assign(DiagLst,'PCL.LST');
  rewrite(DiagLst);
(*$ELSE*)
  Ausgabe_Inited := false;
  StandardWerte;
(*$ENDIF*)
  if ParamCount > 0 then DatName := ParamStr(1)
  else
  begin
    ClrScr;
    write('Name der PCL-Datei: ');
    readln(DatName);
  end;
  if pos('.',DatName) = 0
  then DatName := DatName + '.PCL';  (* Standard-Extension *)
  assign(PCL_Datei,DatName);
  (*$I-*)
  reset(PCL_Datei);
  (*$I+*)
  if IOResult > 0 then
  begin
    Fehler('Datei nicht vorhanden: ',DatName);
    halt(1);
  end;
  if ParamCount > 1 then (* 2. und 3. Parameter *)
  begin
    val(ParamStr(2),Faktor_V,Val_Result);
    if Val_Result > 0 then
    begin (* Dateiname der TIFF-Datei *)
      DatName := ParamStr(2);
      if ParamCount > 2 then
      begin
        val(ParamStr(3),Faktor_V,Val_Result);
        if Val_Result > 0
        then Faktor_V:= 1;
      end;
    end;
  end
  else if ParamCount = 1
  then Faktor_V := 1
  else
  begin
    writeln;
    write('Verkleinerungs-Faktor: ');
    readln(Faktor_V);
  end;
  read(PCL_Datei,Zeichen);
  while Zeichen <= ESC do
  begin
    LiesSequenz(Sequenz);
    while length(Sequenz) > 0
    do Analyse(Sequenz);
    if Zeichen <> ESC then
    begin
      LiesZeile(TextZeile);
      if length(TextZeile) > 0 then
      begin
        if TextZeile[1] <= ESC then Analyse(TextZeile)
        else Ausgabe('- ',TextZeile);
      end;
    end;
  end;
  close(PCL_Datei);
(*$IFDEF ANALYSE*)
  close(DiagLst);
(*$ELSE*)
  if Ausgabe_Inited then AusgabeExit;
(*$ENDIF*)
end.

@bu = Das Hauptprogramm bietet noch viel Raum für Erweiterungen