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

    :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
    :Version.    1.4
    :Date.       02. Oktober 1990
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga A+L V3.3d
    :Imports.    CharactersV1.4, PrinterSupportV3.0 [beide von Thomas Clever]
    :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);
    :History.    V1.3 A.Lüdtke  10.Dez.1989
    :History.    Tabs durch 1..8*Space ersetzt, FF am Ende des Textes, bei FF
    :History.    im Text neue Seite beginnen, Steuerzeichen durch ^Buchstabe
    :History.    fett darstellen, Dateiname, Datum und Zeit auf jeder Seite
    :History.    anzeigen, auf Preferences (Paperlength und Spacing)
    :History.    reagieren.
    :History.    V1.4 T.Clever  02.Okt.1990
    :History.    Nur noch Drucker-Ausgabe, die aber dafür richtig;
    :History.    evtl. Anhängen von ".mod"

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

MODULE ModList;

FROM ReservierteWoerter IMPORT ReserviertesWort;

FROM Arguments   IMPORT GetArg, NumArgs, quoted;
FROM Arts        IMPORT Requester, Terminate, CurrentLevel, wbStarted;
FROM ASCII       IMPORT eol, cr, lf, esc, ht, ff, nul, bs, vt, so, us;
FROM Characters  IMPORT AppendChar;
FROM Conversions IMPORT ValToStr;
FROM Dos         IMPORT Date, DateStamp;
FROM FileSystem  IMPORT File, Response, ReadChar, Lookup, Close;
FROM Intuition   IMPORT GetPrefs, Preferences, PreferencesPtr, single, eightLPI;
FROM Printer     IMPORT ris, rin, sgr1, sgr22, sgr3, sgr23;
FROM PrinterSupport IMPORT OpenPrinter, ClosePrinter, PWriteString, PWriteLn,
                        PWrite, PWriteCard, PCommand, InstallErrorProc;
FROM Str         IMPORT Length, Concat, CapString, Compare;
FROM SYSTEM      IMPORT ADR, ADDRESS, FFP;
FROM Terminal    IMPORT WriteLn, WriteString, ReadLn, waitCloseGadget;


CONST
  MaxZeichen = 255;

TYPE
  FileName = ARRAY [0..39] OF CHAR;

VAR
  M2Name, m2name  : FileName;
  M2File          : File;
  Puffer          : ARRAY [0..MaxZeichen] OF CHAR;
  Zeichen         : CHAR;
  Zustand         : (ZeichenLesen, WortLesen, String1, String2,
                     Kommentar, FileEnde);
  Druckzeichen    : CARDINAL; (* zählt die in aktueller Zeile gedruckten Zeichen *)
  ZeilenNr        : CARDINAL; (* Nummer der Zeile in der Datei *)
  Druckzeilen     : INTEGER;  (* Anzahl der wirklich gedruckten Zeilen/Seite *)
  SeitenNr        : CARDINAL;
  CharCount       : CARDINAL;
  KommentarTiefe  : CARDINAL;
  SingleSheet     : BOOLEAN;
  DatString       : ARRAY [0..40] OF CHAR;
  ZeilenProSeite  : INTEGER;
  ZeichenProZeile : CARDINAL;
  len             : INTEGER;
  strPtr          : POINTER TO FileName;


(* --- Preferences auslesen und gesetzte Parameter feststellen --- *)

PROCEDURE ReadPrefs;
VAR
  preferences : Preferences;
  prefs : PreferencesPtr;
BEGIN
  prefs := ADR(preferences);
  GetPrefs(prefs,SIZE(Preferences));
  WITH prefs^ DO
    SingleSheet         := paperType = single;
    ZeilenProSeite      := paperLength;
    IF printSpacing = eightLPI THEN
      ZeilenProSeite := CARDINAL( 1.33 * (FFP(ZeilenProSeite) + 0.5));
    END;
    ZeichenProZeile     := printRightMargin - printLeftMargin;
    IF printRightMargin <= printLeftMargin THEN
      ZeichenProZeile := 10;
    END;
    IF (printRightMargin - printLeftMargin) > MaxZeichen THEN
      ZeichenProZeile := MaxZeichen;
    END;
  END;
END ReadPrefs;


(* --------- Prozeduren zur gepufferten Eingabe eines Zeichens ---------- *)

VAR
  ZeichenPuffer : CHAR;


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


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


(* ---------------------  Drucker-Steuer-Routinen  -------------------- *)

PROCEDURE PrinterErrorProc;
BEGIN
  WriteString("Drucker-Fehler!!!"); WriteLn;
  Terminate( CurrentLevel() );
END PrinterErrorProc;


PROCEDURE InitDrucker;
VAR
  com : ARRAY [0..2] OF CHAR;
BEGIN
  PCommand( ris, 0, 0, 0, 0 );    (* ISO Reset Kommando  *)
  (*
    PCommand( rin, 0, 0, 0, 0 );
    (* Dies geht nicht, weil sonst beim ersten Ausdruck nach dem Booten *)
    (* die Seitenbeschreibung der ersten Seite nicht kursiv&fett ist -  *)
    (* zumindestens nicht bei meinem Drucker(-treiber). Warum???        *)
  *)
  com := "*#1"; com[0] := esc;
  PWriteString( com );  (* ISO Initialisierung *)
END InitDrucker;


PROCEDURE FettAn;
BEGIN
  PCommand( sgr1, 0, 0, 0, 0 );
END FettAn;


PROCEDURE FettAus;
BEGIN
  PCommand( sgr22, 0, 0, 0, 0 );
END FettAus;


PROCEDURE KursivAn;
BEGIN
  PCommand( sgr3, 0, 0, 0, 0 );
END KursivAn;


PROCEDURE KursivAus;
BEGIN
  PCommand( sgr23, 0, 0, 0, 0 );
END KursivAus;


(* ------------------- Seitenumbruch --------------------- *)

PROCEDURE NeueSeite;
BEGIN
  IF ZeilenNr > 0 THEN
    PWrite( ff );
    IF SingleSheet THEN
      IF NOT Requester(ADR("  M o d L i s t"),
                       ADR("Bitte nächstes Blatt einlegen"),
                       ADR("weiter"),
                       ADR("abbrechen")) THEN
        Terminate(CurrentLevel());
      END;
    END;
  END;
  INC(SeitenNr);
  KursivAn; FettAn;
  PWriteString( "Seite " );
  PWriteCard(SeitenNr,2);
  PWriteString("     ");
  PWriteString( M2Name );
  PWriteString("     ");
  PWriteString( DatString );
  FettAus; KursivAus;
  PWriteLn;
END NeueSeite;


(* -------------------- Textausgabe-Routinen -------------------- *)

PROCEDURE PrintChar( ch: CHAR );
VAR
  x, anzahl : CARDINAL;
BEGIN
  CASE ch OF
     lf,
     cr : Read(Zeichen);
          IF Zeichen # cr THEN
            PushBack(Zeichen);
          END;
          INC( Druckzeilen );
          IF Druckzeilen > ZeilenProSeite-3 THEN
            PrintChar( ff );
          ELSE
            PWriteLn;
            Druckzeichen := 0;
          END;
          INC(ZeilenNr);
          KursivAn;
          PWriteCard( ZeilenNr, 4 );
          PrintChar( ":" );
          PrintChar( " " );
          IF KommentarTiefe = 0 THEN
            KursivAus;
          END;
    |ff : NeueSeite;
          PWriteLn;
          Druckzeilen := 0;
          Druckzeichen := 0;
    |ht : anzahl := 8 - (Druckzeichen MOD 8);
          FOR x := 1 TO anzahl DO
            PrintChar(" ");
          END;
  ELSE
    IF Druckzeichen > ZeichenProZeile-6 THEN
      (* Ende der Zeile erreicht *)
      INC( Druckzeilen );
      IF Druckzeilen > ZeilenProSeite-3 THEN
        PrintChar( ff );
      ELSE
        PWriteLn;
        Druckzeichen := 0;
      END;
      PWriteString("      ");
    END;
    PWrite( ch );
    INC( Druckzeichen );
  END; (* CASE *)
END PrintChar;


PROCEDURE PrintString( str: ARRAY OF CHAR );
VAR
  x, len : CARDINAL;
BEGIN
  len := Length(str) - 1;
  FOR x := 0 TO len DO
    PrintChar( str[x] );
  END;
END PrintString;


PROCEDURE PrintCtrl( char: CHAR );
BEGIN
  FettAn;
  PrintChar("^");
  PrintChar( CHAR( ORD(char) + 64) );
  FettAus;
END PrintCtrl;


(* ------------------- Datums-/Zeit-Routinen ------------------- *)

PROCEDURE Schaltjahr( Jahr: LONGINT ): LONGINT;
VAR
  dummy : LONGINT;
BEGIN
  dummy := 0;
  IF (Jahr REM 4)   = 0 THEN dummy := 1 END;
  IF (Jahr REM 100) = 0 THEN dummy := 0 END;
  IF (Jahr REM 400) = 0 THEN dummy := 1 END;
  RETURN( dummy);
END Schaltjahr;


PROCEDURE TageProMonat( Monat: LONGINT; Jahr: LONGINT ): LONGINT;
VAR
  dummy : LONGINT;
BEGIN
  CASE Monat OF
    1,3,5,7,8,10,12 : dummy := 31                       |
    2               : dummy := 28 + Schaltjahr( Jahr)   |
    4,6,9,11        : dummy := 30
  END;
  RETURN( dummy);
END TageProMonat;


PROCEDURE ConvertDate;
VAR
  Tage  : LONGINT;
  Monat : LONGINT;
  Jahr  : LONGINT;
  HStr  : ARRAY[1..10] OF CHAR;
  Error : BOOLEAN;
  Datum : Date;
BEGIN
  DateStamp(ADR(Datum));
  Tage := Datum.days + 1;       (* plus 1 da 'Tage seit 1.1.78'         *)
  Jahr := 1978;
  WHILE Tage > 366 DO
    DEC( Tage, 365 + Schaltjahr( Jahr));
    INC( Jahr);
  END;
  Monat := 1;
  WHILE Tage > 31 DO
    DEC( Tage, TageProMonat( Monat, Jahr));
    INC( Monat);
  END;
  CASE (Datum.days REM 7) OF
    0: DatString := "Sonntag "          |
    1: DatString := "Montag "           |
    2: DatString := "Dienstag "         |
    3: DatString := "Mittwoch "         |
    4: DatString := "Donnerstag "       |
    5: DatString := "Freitag "          |
    6: DatString := "Samstag "
  END;
  ValToStr( Tage, FALSE, HStr, 10, 2, " ", Error);
  Concat( DatString, HStr); Concat( DatString, ".");
  CASE Monat OF
    1:  HStr := "Januar "       |
    2:  HStr := "Februar "      |
    3:  HStr := "März "         |
    4:  HStr := "April "        |
    5:  HStr := "Mai "          |
    6:  HStr := "Juni "         |
    7:  HStr := "Juli "         |
    8:  HStr := "August "       |
    9:  HStr := "September "    |
    10: HStr := "Oktober "      |
    11: HStr := "November "     |
    12: HStr := "Dezember "     |
  END;
  Concat( DatString, HStr);
  ValToStr( Jahr, FALSE, HStr, 10, 4, "0", Error);
  Concat( DatString, HStr); Concat( DatString, "  ");
  ValToStr( Datum.minute DIV 60, FALSE, HStr, 10, 2, "0", Error);
  Concat( DatString, HStr); Concat( DatString, ".");
  ValToStr( Datum.minute REM 60, FALSE, HStr, 10, 2, "0", Error);
  Concat( DatString, HStr); Concat( DatString, " Uhr");
END ConvertDate;


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

BEGIN  (* main *)

  (* Titel *)
  WriteLn;
  WriteString(" Modula-2 Quelltext-Drucker V1.4");WriteLn;
  WriteString("---------------------------------");WriteLn;
  WriteLn;

  (* Verarbeitung der Argumente *)
  GetArg( 1, M2Name, len );
  IF (NumArgs() > 1) OR
     ( (M2Name[0] = "?") AND (M2Name[1] = nul) AND NOT quoted ) THEN
    WriteString(' Syntax: ModList [<Quelldatei>[".def"|".mod"]]'); WriteLn;
    WriteLn;
    Terminate( CurrentLevel() );
  ELSIF NumArgs() = 0 THEN
    WriteString("Quelldatei: ");
    ReadLn( M2Name, len );
    IF len = 0 THEN
      Terminate( CurrentLevel() );
    END;
    WriteLn;
  END;

  (* wenn M2Name weder mit '.def' noch mit '.mod' endet, dann '.mod' anhängen *)
  m2name := M2Name;
  CapString( m2name );
  IF len > 4 THEN
    strPtr := ADR(m2name[len-4]);
    IF (Compare(strPtr^,".DEF") # 0) AND (Compare(strPtr^,".MOD") # 0) THEN
      Concat( M2Name, ".mod" );
    END;
  ELSE
    Concat( M2Name, ".mod" );
  END;

  (* --------------------- Initialisierungen --------------------- *)

  (* Datei öffnen *)
  Lookup( M2File, M2Name, 512, FALSE );
  IF M2File.res # done THEN
    WriteString("Modula-Datei konnte nicht geöffnet werden!");
    WriteLn;
    Terminate( CurrentLevel() );
  END;

  (* Drucker initialisieren *)
  IF NOT OpenPrinter() THEN
    WriteString("Drucker konnte nicht initialisiert werden!");
    WriteLn;
    Terminate( CurrentLevel() );
  ELSE
    InstallErrorProc( PrinterErrorProc );
    InitDrucker;
  END;

  (* Es geht los ... *)
  WriteString("Die Datei ");
  WriteString(M2Name);
  WriteString(" wird gedruckt...");
  WriteLn; WriteLn;

  ZeichenPuffer := 0C;    (* für Read und PushBack *)
  Druckzeichen  := 0;     (* für PrintChar *)
  Druckzeilen   := -1;    (* für PrintChar *)
  ReadPrefs;
  ZeilenNr      := 0;
  SeitenNr      := 0;
  Zustand       := ZeichenLesen;
  Zeichen       := lf;
  ConvertDate;
  NeueSeite;

  (* ----------------------- Hauptschleife ----------------------- *)

  WHILE Zustand # FileEnde DO
    CASE Zustand OF
    |ZeichenLesen:
      CASE Zeichen OF
      |"A".."Z":
        Puffer := "";
        AppendChar( Puffer, Zeichen );
        Zustand:=WortLesen;
      |'"':
        PrintChar('"');
        Zustand:=String1;
      |"'":
        PrintChar("'");
        Zustand:=String2;
      |"(":
        Read(Zeichen);
        IF Zeichen = '*' THEN
          KursivAn;
          PrintString("(*");
          KommentarTiefe:=1;
          Zustand:=Kommentar;
        ELSE
          PrintChar("(");
          PushBack(Zeichen);
        END;
      |nul..bs,vt,so..us:
        PrintCtrl(Zeichen);
      ELSE
        PrintChar(Zeichen);
      END; (* CASE Zeichen OF *)
    |WortLesen:
      IF (Zeichen >= "A") AND (Zeichen <= "Z") THEN
        AppendChar( Puffer, Zeichen );
      ELSE
        IF ReserviertesWort(Puffer) THEN
          FettAn;
          PrintString( Puffer );
          FettAus;
        ELSE
          PrintString( Puffer );
        END;
        PushBack(Zeichen);
        Zustand:=ZeichenLesen;
      END;
    |String1:
      CASE Zeichen OF
      |nul..us:
        PrintCtrl(Zeichen);
      ELSE
        PrintChar(Zeichen);
        IF Zeichen = '"' THEN
          Zustand := ZeichenLesen;
        END;
      END;
    |String2:
      CASE Zeichen OF
      |nul..us:
        PrintCtrl(Zeichen);
      ELSE
        PrintChar(Zeichen);
        IF Zeichen = "'" THEN
          Zustand := ZeichenLesen;
        END;
      END;
    |Kommentar:
      CASE Zeichen OF
      |'(':
        Read(Zeichen);
        IF Zeichen="*" THEN
          PrintString("(*");
          INC(KommentarTiefe);
        ELSE
          PrintChar("(");
          PushBack(Zeichen);
        END;
      |'*':
        Read(Zeichen);
        IF Zeichen=")" THEN
          PrintString("*)");
          DEC(KommentarTiefe);
          IF KommentarTiefe=0 THEN
            KursivAus;
            Zustand:=ZeichenLesen;
          END;
        ELSE
          PrintChar("*");
          PushBack(Zeichen);
        END;
      |nul..bs,vt..us:
        PrintCtrl(Zeichen);
      ELSE
        INC(CharCount);
        PrintChar(Zeichen);
      END; (* CASE Zeichen OF *)
    END; (* CASE Zustand OF *)
    Read(Zeichen);
  END; (* WHILE *)

  PWrite(ff);

  ClosePrinter;
  Close(M2File);

  waitCloseGadget := FALSE;
END ModList.