(*******************************************)
(* (c) Copyright 1987 by Jens Kalski       *)
(*                       Heidbergredder 27 *)
(*                       2050 Hamburg 80   *)
(*******************************************)
(* Programm         : WS-CP                *)
(* Version          : 5.0 (28.02.1988)     *)
(* Sprache          : TURBO-PASCAL 3.0     *)
(* Programmiert auf : Schneider CPC464     *)
(* Betriebssystem   : CP/M 2.2             *)
(* Kurzbeschreibung : Halbautomatische     *)
(*                    Einfuegung von .CP   *)
(*                    in Textdateien       *)
(*******************************************)

(*$U-,C-*)

PROGRAM WS_CP;

CONST
  FIB_Save_Size = 176; (* Bei MS/DOS -> 76 *)

VAR
  OK,
  PFlag,
  imAbsatz  : BOOLEAN;     (* FALSE -> Ausserhalb eines markierten Absatzes *)
                           (* TRUE  ->  Innerhalb eines markierten Absatzes *)
  c         : CHAR;
  i,Zaehler : INTEGER;
  Name_In,
  Name_Out  : STRING (.14.);
  FIB_Save  : ARRAY(.1..FIB_Save_Size.) OF BYTE;
  Dat_In,
  Dat_Out   : TEXT;

BEGIN
  CrtInit; ClrScr;
  LowVideo;
  WriteLn(' WS-CP 5.0 (28.02.1988) ');
  NormVideo;
  WriteLn('(C) Copyright by Jens Kalski');
  WriteLn;
  IF ParamCount = 1 THEN BEGIN
    Name_In:=ParamStr(1);
    Name_Out:=Name_In;
    i:=Pos('.',Name_Out);
    IF i <> 0 THEN Name_Out:=Copy(Name_Out,1,Pred(i));
    WriteLn('Ich bearbeite ',Name_In);
    Assign(Dat_In,Name_In);
    (*$I-*) Reset(Dat_In); (*$I+*)
    IF IOResult = 0 THEN BEGIN
      Assign(Dat_Out,Name_Out+'$$$');
      (*$I-*) ReWrite(Dat_Out); (*$I+*)
      IF IOResult = 0 THEN BEGIN
        OK:=TRUE;
        imAbsatz:=FALSE;
        WHILE (NOT EoF(Dat_In)) AND OK DO BEGIN
          Read(Dat_In,c);
          CASE c OF
            #11,#139 : IF imAbsatz
                         THEN imAbsatz:=FALSE
                         ELSE BEGIN
                           Write('C');
                           Zaehler:=0;
                           PFlag:=TRUE;
                           imAbsatz:=TRUE;
                           Move(Dat_In,FIB_Save,FIB_Save_Size);
                           WHILE (NOT EoF(Dat_In)) AND PFlag DO BEGIN
                             Read(Dat_In,c);
                             CASE c OF
                               #10,#138 : Zaehler:=Succ(Zaehler);
                               #11,#139 : PFlag:=FALSE;
                             END;
                           END;
                           Move(FIB_Save,Dat_In,FIB_Save_Size);
                           IF PFlag
                             THEN BEGIN
                               LowVideo; Write(' FEHLER : '); NormVideo;
                               WriteLn('Die ^K-Zeichen sind nicht paarig !');
                               Close(Dat_In); Close(Dat_Out); Erase(Dat_Out);
                               OK:=FALSE;
                             END
                             ELSE WriteLn(Dat_Out,'.CP ',Zaehler);
                         END;
            ELSE Write(Dat_Out,c);
          END;
        END;
        IF OK THEN BEGIN
          Close(Dat_In);
          ReName(Dat_In,Name_Out+'.BAK');
          Close(Dat_Out);
          ReName(Dat_Out,Name_In);
          WriteLn; WriteLn;
          WriteLn('Fertig. Bitte }berpr}fen Sie den Text.');
        END;
      END
      ELSE BEGIN
        LowVideo; Write(' FEHLER : '); NormVideo;
        WriteLn(Name_Out,'.$$$ kann nicht geoeffnet werden !');
        Close(Dat_In);
      END;
    END
    ELSE BEGIN
      LowVideo; Write(' FEHLER : '); NormVideo;
      WriteLn(Name_In,' nicht gefunden !');
    END;
  END
  ELSE BEGIN
    WriteLn('Bitte rufen Sie das Programm folgenderma~en auf :');
    WriteLn;
    WriteLn('WS-CP  BEISPIEL.TXT');
    WriteLn;
    LowVideo;
    WriteLn(' Die Eingabedatei heisst BEISPIEL.BAK ');
    WriteLn(' Die Ausgabedatei heisst BEISPIEL.TXT ');
    NormVideo;
  END;
END.  (* -------------------------- Programmende -------------------------- *)