(**********************************************************************

    :Program.    ModList.mod
    :Contents.   Ausdrucken von Modula-Sources mit Hervorhebung der
    :Contents.   Modula-Schlüsselwörter und Kommentare
    :Author.     Ursprüngliche PC-Version: CHIP/Tool-Praxis Modula-2/Sonderheft
    :Author.     Amiga-Version: Andreas Kopp
    :Author.     Anpassung an Amiga-Druckertreiber : Nicolas Benezan [bne]
    :Address.    Andreas Kopp, Grünbaumstrasse 83  D-5650 Solingen 1
    :Phone.      (0)212 / 42381
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga A+L V3.2d
    :History.    V1.0 A. Kopp 25.Mar.1989 (Amiga Version)
    :History.    V1.1 [bne]   29.Mar.1989 (Druckeranpassung, SingleSheet)
    :History.    V1.2b [bne]   2.Apr.1989 (Ctrl-C Bug fixed);

**********************************************************************)

MODULE ModList;

FROM Arguments  IMPORT GetArg, NumArgs;
FROM Arts       IMPORT Requester, Terminate;
FROM ASCII      IMPORT eol, cr, lf, esc;
FROM Conversions IMPORT ValToStr;
FROM FileSystem IMPORT File, Response, ReadChar, WriteChar, WriteBytes,
                       WriteByteBlock, Lookup, Close;
FROM Heap       IMPORT Allocate, Deallocate;
FROM InOut      IMPORT WriteLn, WriteString, ReadString;
FROM Intuition  IMPORT GetPrefs, Preferences, PreferencesPtr, single;
FROM Strings    IMPORT Length;
FROM SYSTEM     IMPORT ADR;

CONST MaxZeichenZahl = 96;
      ZeilenProSeite = 60;

VAR
  Puffer  : ARRAY [0..MaxZeichenZahl] OF CHAR;
  Zeichen : CHAR;
  Zustand : (ZeichenLesen,WortLesen,String1,String2,Kommentar,FileEnde);
  ZeilenNr, SeitenNr, ZeichenZahl, KommentarTiefe : CARDINAL;
  SingleSheet: BOOLEAN;
  InFile, OutFile: File;
  InputName, OutputName: ARRAY [0..31] OF CHAR;
  Len:INTEGER;
  Dummy:LONGINT;

(* --- Preferences auslesen, feststellen ob Einzelblattmodus gewählt --- *)

PROCEDURE TestSingleSheet():BOOLEAN;
VAR
  Single:BOOLEAN;
  Prefs:PreferencesPtr;
BEGIN
  Allocate(Prefs,SIZE(Preferences));
  GetPrefs(Prefs,SIZE(Preferences));
  Single:=Prefs^.paperType = single;
  Deallocate(Prefs);
  RETURN Single;
END TestSingleSheet;

(* --------- Lokales Modul zur gepufferten Eingabe eines Zeichens ---------- *)

MODULE GepuffertesLesen;

IMPORT ReadChar, InFile, FileEnde, Zustand;
EXPORT Read, PushBack;

VAR ZeichenPuffer : CHAR;

PROCEDURE Read ( VAR Zeichen : CHAR);
  BEGIN
    IF ZeichenPuffer=0C THEN
      ReadChar(InFile,Zeichen);
      IF InFile.eof THEN
        Zustand:=FileEnde;
      END;
    ELSE
      Zeichen:=ZeichenPuffer;
      ZeichenPuffer:=0C;
    END;
  END Read;

PROCEDURE PushBack (Zeichen : CHAR);
  BEGIN
    ZeichenPuffer:=Zeichen;
  END PushBack;

BEGIN (* Initialisierung *)
  ZeichenPuffer:=0C;
END GepuffertesLesen;

(* ----- Lokales Modul zur Bestimmung, ob es sich bei einem Bezeichner ----- *)
(* ----- um ein Schluesselwort handelt -------------------------------------- *)

MODULE ReservierteWoerter;

EXPORT ReserviertesWort;

VAR ResWort : ARRAY [1..40] OF ARRAY [0..15] OF CHAR;

PROCEDURE ReserviertesWort(Bezeichner : ARRAY OF CHAR) : BOOLEAN;
  VAR
    von, bis, mitte : [1..40];

  PROCEDURE kleiner(X,Y : ARRAY OF CHAR) : BOOLEAN;
    VAR i, Minimum : CARDINAL;
    BEGIN
      IF HIGH(X) < HIGH(Y) THEN
        Minimum:=HIGH(X)
      ELSE
        Minimum:=HIGH(Y)
      END;
      i:=0;
      WHILE (i < Minimum) AND (X[i] = Y[i]) AND (X[i] # 0C) AND (Y[i] # 0C) DO
        INC(i);
      END;
      RETURN X[i] < Y[i];
    END kleiner;

  BEGIN
    von:=1; bis:=40;
    WHILE von # bis DO
      mitte:=(von+bis) DIV 2;
      IF kleiner(ResWort[mitte],Bezeichner) THEN
        von:=mitte+1;
      ELSE
        bis:=mitte
      END;
    END;
    RETURN NOT kleiner(ResWort[von], Bezeichner) AND
           NOT kleiner(Bezeichner,ResWort[von]);
  END ReserviertesWort;

BEGIN
  ResWort[ 1]:="AND";           ResWort[21]:="LOOP";
  ResWort[ 2]:="ARRAY";         ResWort[22]:="MOD";
  ResWort[ 3]:="BEGIN";         ResWort[23]:="MODULE";
  ResWort[ 4]:="BY";            ResWort[24]:="NOT";
  ResWort[ 5]:="CASE";          ResWort[25]:="OF";
  ResWort[ 6]:="CONST";         ResWort[26]:="OR";
  ResWort[ 7]:="DEFINITION";    ResWort[27]:="POINTER";
  ResWort[ 8]:="DIV";           ResWort[28]:="PROCEDURE";
  ResWort[ 9]:="DO";            ResWort[29]:="QUALIFIED";
  ResWort[10]:="ELSE";          ResWort[30]:="RECORD";
  ResWort[11]:="ELSIF";         ResWort[31]:="REPEAT";
  ResWort[12]:="END";           ResWort[32]:="RETURN";
  ResWort[13]:="EXIT";          ResWort[33]:="SET";
  ResWort[14]:="EXPORT";        ResWort[34]:="THEN";
  ResWort[15]:="FOR";           ResWort[35]:="TO";
  ResWort[16]:="FROM";          ResWort[36]:="TYPE";
  ResWort[17]:="IF";            ResWort[37]:="UNTIL";
  ResWort[18]:="IMPLEMENTATION";ResWort[38]:="VAR";
  ResWort[19]:="IMPORT";        ResWort[39]:="WHILE";
  ResWort[20]:="IN";            ResWort[40]:="WITH";
END ReservierteWoerter;

  PROCEDURE Write(Char: CHAR);
    BEGIN
      WriteChar(OutFile,Char);
    END Write;

(* --- Steuerzeichen (Escape-Sequenzen) nach ISO-Norm               --- *)
(* --- werden vom PRT:-Device automatisch für den Drucker übersetzt --- *)

  PROCEDURE InitDrucker;
    BEGIN
      Write(esc); Write("#");Write("1");
    END InitDrucker;

(* USAOn ist unnötig, bei Umlauten schaltet das prt:-device automatisch um *)

  PROCEDURE EliteOn;
    BEGIN
      Write(esc); Write("["); Write("2"); Write("w");
    END EliteOn;

  PROCEDURE ExitDrucker;     (* Mein Drucker kennt keine ESC-Sequence zum    *)
    BEGIN                    (* EXIT, daher steht hier nur ne neue Initiali- *)
      InitDrucker;           (* sierung. Abbruch in diesem Fall mit Ctrl-C   *)
    END ExitDrucker;

  PROCEDURE MarkiereWort(Bezeichner: ARRAY OF CHAR;Len: LONGINT);
    BEGIN
      Write(esc); Write("["); Write("1"); Write("m");
        (* Fettdruck (Boldface) an *)
      WriteBytes(OutFile,ADR(Bezeichner),Len,Len);
      Write(esc); Write("["); Write("2"); Write("2"); Write("m");
        (* Fettdruck aus *)
    END MarkiereWort;

  PROCEDURE KursivAn;
    BEGIN
      Write(esc); Write("["); Write("3"); Write("m");    (* italics *)
    END KursivAn;

  PROCEDURE KursivAus;
    BEGIN
      Write(esc); Write("["); Write("2"); Write("3"); Write("m");
    END KursivAus;

(* ------------------- Seitenumbruch und Zeilennummern --------------------- *)

  PROCEDURE WriteCard(Val,Digits:CARDINAL);
    VAR
      Error:BOOLEAN;
      Str:ARRAY [0..7] OF CHAR;
    BEGIN
      ValToStr(Val,FALSE,Str,10,Digits," ",Error);
      IF NOT Error THEN
        WriteBytes(OutFile,ADR(Str),Length(Str),Dummy);
      END;
    END WriteCard;

  PROCEDURE NeueSeite;
    BEGIN
      IF ZeilenNr>0 THEN
        Write(CHR(12));
        IF SingleSheet THEN
          IF NOT Requester(ADR("ModList"),
                           ADR("Bitte nächstes Blatt einlegen"),
                           ADR("weiter"),
                           ADR("abbrechen")) THEN
            Terminate(0);
          END;
        END;
      END;
      INC(SeitenNr);
      KursivAn;
      WriteByteBlock(OutFile,"Seite ");
      WriteCard(SeitenNr,1);
      KursivAus;
      Write(cr); Write(lf); Write(lf);
    END NeueSeite;

  PROCEDURE NeueZeile;
    VAR test : CARDINAL;
    BEGIN
      Read(Zeichen);
      IF Zeichen # cr THEN
        PushBack(Zeichen);
      END;
      IF ZeilenNr MOD ZeilenProSeite = 0 THEN
        NeueSeite;
      ELSE
        Write(cr); Write(lf);
      END;
      INC(ZeilenNr);
      KursivAn;
      WriteCard(ZeilenNr,4);
      Write(":"); Write(" ");
      IF KommentarTiefe = 0 THEN
        KursivAus;
      END;
    END NeueZeile;

(* --------------- Hauptprogramm als endlicher Automat --------------------- *)

BEGIN (* ModList *)
  WriteString("Quelltext - Lister");WriteLn;
  WriteString("------------------");WriteLn;
  WriteLn;
  WriteString("Zu druckendes Listing: ");
  IF NumArgs()>=1 THEN
    GetArg(1,InputName,Len);
    WriteString(InputName);
    WriteLn;
  ELSE
    WriteLn;WriteLn;
    WriteString("in>");
    ReadString(InputName);
  END;
  Lookup(InFile,InputName,512,FALSE); (* Eingabedatei öffnen *)
  IF InFile.res#done THEN
    WriteString("Quelldatei konnte nicht geöffnet werden!");
    WriteLn;
    HALT
  END;
  WriteString("Ausgabedatei: (prt: für Ausgabe auf Drucker)");
  WriteLn;WriteLn;
  WriteString("out>");
  ReadString(OutputName);
  Lookup(OutFile,OutputName,0,TRUE); (* Ausgabedatei öffnen *)
  IF OutFile.res#done THEN
    WriteString("Ausgabedatei konnte nicht geöffnet werden!");
    WriteLn;
    Close(InFile);
    HALT
  END;
  SingleSheet:=TestSingleSheet();
  InitDrucker; EliteOn;
  ZeilenNr:=0; SeitenNr:=0; Zustand:=ZeichenLesen; Zeichen:=eol;
  WHILE (Zustand#FileEnde) AND (OutFile.res=done) DO
    CASE Zustand OF
    |ZeichenLesen:
      CASE Zeichen OF
      |"A".."Z":
        ZeichenZahl:=0;
        Puffer[ZeichenZahl]:=Zeichen;
        Zustand:=WortLesen;
      |'"':
        Write(Zeichen);
        Zustand:=String1;
      |"'":
        Write(Zeichen);
        Zustand:=String2;
      |"(":
        Read(Zeichen);
        IF Zeichen = '*' THEN
          KursivAn;
          Write("("); Write("*");
          KommentarTiefe:=1;
          Zustand:=Kommentar;
        ELSE
          Write("(");
          PushBack(Zeichen);
        END;
      |eol,cr:
        NeueZeile;
      ELSE
        Write(Zeichen);
      END;
    |WortLesen:
      IF (Zeichen >= "A") AND (Zeichen <= "Z") THEN
        IF ZeichenZahl < MaxZeichenZahl THEN
          INC(ZeichenZahl);
          Puffer[ZeichenZahl]:=Zeichen;
        END;
      ELSE
        IF ZeichenZahl < MaxZeichenZahl THEN
          INC(ZeichenZahl);
          Puffer[ZeichenZahl]:=0C;
        END;
        IF ReserviertesWort(Puffer) THEN
          MarkiereWort(Puffer,ZeichenZahl);
        ELSE
          WriteBytes(OutFile,ADR(Puffer),ZeichenZahl,Dummy);
        END;
        PushBack(Zeichen);
        Zustand:=ZeichenLesen;
      END;
    |String1:
      Write(Zeichen);
      IF Zeichen = '"' THEN
        Zustand:=ZeichenLesen;
      END;
    |String2:
      Write(Zeichen);
      IF Zeichen = "'" THEN
        Zustand:=ZeichenLesen;
      END;
    |Kommentar:
      CASE Zeichen OF
      |'(':
        Read(Zeichen);
        IF Zeichen="*" THEN
          Write("("); Write("*");
          INC(KommentarTiefe);
        ELSE
          Write("(");
          PushBack(Zeichen);
        END;
      |'*':
        Read(Zeichen);
        IF Zeichen=")" THEN
          Write("*"); Write(")");
          DEC(KommentarTiefe);
          IF KommentarTiefe=0 THEN
            KursivAus;
            Zustand:=ZeichenLesen;
          END;
        ELSE
          Write("*");
          PushBack(Zeichen);
        END;
      |eol,cr:
        NeueZeile
      ELSE
        Write(Zeichen);
      END; (* CASE Zeichen *)
    END; (* CASE Zustand *)
    Read(Zeichen);
  END; (* WHILE *)
  Close(InFile);
  Close(OutFile);
END ModList.