(****************************************************************************)
(*                     Quelle und Ziel bestimmen                            *)
(****************************************************************************)

PROCEDURE Eingaben;
  TYPE charset = SET OF char;
  VAR i : integer;

FUNCTION getchar(Meldung : str127; Erlaubt : charset) : char;
  VAR c : char;
  BEGIN
    write(Meldung); REPEAT read(kbd,c); c:=upcase(c) UNTIL c IN Erlaubt;
    writeln(c); getchar:=c
  END;

  BEGIN
    ClrScr; writeln('PDYNAM 2.0'); writeln;
    REPEAT
      write('Name der Quelldatei: '); readln(MainName);
      FOR i:=1 TO length(MainName) DO MainName[i]:=upcase(MainName[i]);
      IF MainName='' THEN halt;
      IF pos('.',MainName)=0 THEN MainName:=MainName+'.PAS';
      (*$I-*) assign(Main,MainName); reset(Main) (*$I+*)
    UNTIL IOResult=0;
    CASE getchar('Ausgabe auf B)ildschirm, D)rucker, F)ile ',['B','D','F']) OF
     'B':BEGIN
           AusgabeDevice:=Bildschirm; ZielName:='CON:';
           MT:=2; MB:=1; PL:=25; PO:=0
         END;
     'D':BEGIN
           AusgabeDevice:=Drucker; MT:=4; MB:=10; PL:=72; PO:=0;
           WarteFlag:=getchar('Nach jeder Seite warten (J/N) ?',['J','N'])='J';
           IF getchar('L)ST: oder A)UX: ? ',['A','L'])='A'
             THEN ZielName:='AUX:' ELSE ZielName:='LST:';
         END;
     'F':BEGIN
           AusgabeDevice:=Datei; write('Name der Datei: ');
           readln(ZielName); PL:=maxint; MT:=3; MB:=0; PO:=0
         END
    END;
    assign(ZielDatei,ZielName); rewrite(ZielDatei)
  END; (* Eingaben *)

(****************************************************************************)
(*                              Ausgabe                                     *)
(****************************************************************************)

PROCEDURE Fehler(N : integer);
  BEGIN
    writeln; writeln('Fehler im Quelltext!');
    IF InclFlag THEN write(InclName) ELSE write(MainName); write(' Zeile ',N);
    halt
  END;

PROCEDURE NeueSeite(Tiefe : integer); FORWARD;

PROCEDURE print(Bez : str127);
  BEGIN
    Zeile:=succ(Zeile); IF Zeile>PL-MB THEN NeueSeite(0);
    writeln(ZielDatei); write(ZielDatei,Bez)
  END; (* print *)

PROCEDURE SchreibQuellName;
  BEGIN
    writeln(ZielDatei);
    write(ZielDatei,QuellName,'':15-length(QuellName)); QuellName:='';
  END; (* SchreibQuellName *)

PROCEDURE markiere(Bez : str127);
  VAR i : integer;
  BEGIN
    CASE AusgabeDevice OF
      Bildschirm : BEGIN lowvideo; write(Bez); normvideo; END;
      Drucker    : FOR i:=1 TO length(Bez) DO write(ZielDatei,Bez[i],^H,Bez[i]);
      Datei      : write(ZielDatei,FileFettEin,Bez,FileFettAus)
    END; write(ZielDatei,'':10-length(Bez))
  END; (* markiere *)

(*$A-*)   (* Achtung - indirekte Rekursion mit NeueSeite *)
PROCEDURE SchreibProz(V : integer);
  BEGIN
    Zeile:=succ(Zeile); IF Zeile>PL-MB THEN NeueSeite(pred(V));
    SchreibQuellName; write(ZielDatei,'':pred(V)*7);
    WITH ProzListe[V] DO
      BEGIN markiere(BezNamen[Art]); write(ZielDatei,name) END
  END; (* SchreibProz *)
(*$A+*)

PROCEDURE SchreibRef(VAR Bez : str127);
  BEGIN
    Zeile:=succ(Zeile); IF Zeile>PL-MB THEN NeueSeite(V);
    IF V=0 THEN QuellName:='(MAIN)';
    SchreibQuellName; write(ZielDatei,'':pred(V)*7,'-> ',Bez);
  END; (* SchreibRef *)

PROCEDURE NeueSeite;
  VAR i : integer;
  BEGIN
    Seite:=succ(Seite);
    CASE AusgabeDevice OF
      Bildschirm : BEGIN
                     IF Seite>1 THEN
                       BEGIN gotoxy(70,25); write('RETURN'); readln END;
                     Clrscr
                   END;
      Drucker    : BEGIN
                     IF Seite>1 THEN IF NOT WarteFlag THEN write(ZielDatei,^L);
                     IF WarteFlag THEN
                       BEGIN write('Neue Seite einlegen '); readln END
                   END;
      END; (* CASE *)
    write(ZielDatei,^M'Dynamische Struktur von ',
                      MainName,'':47-length(MainName),'Seite ',Seite:2);
    Zeile:=succ(MT+V); FOR i:=2 TO MT DO writeln(ZielDatei);
    IF InclFlag THEN QuellName:=InclName ELSE QuellName:=MainName;
    FOR i:=1 TO Tiefe DO
      BEGIN SchreibProz(i); write(ZielDatei,' (Forts.)') END
  END; (* NeueSeite *)