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

:Program.    Rechtschreib.mod
:Contens.    Ein Programm zum Korrigieren von Texten mittels eines
:Contens.    Lexikons.
:Author.     Bernd Braun
:Address.    Lippestr. 11, D-3300 Braunschweig
:Phone.      0531/845498
:Copyright.  Public Domain
:Language.   Modula-2
:Translator. M2Amiga A+L V3.32d
:Imports.    DynStr, NewInOut, OpenHash
:History.    V1.0 3.Okt.1990
:History.    V1.1 4.Okt.1990 Auch Teilwörter werden bearbeitet.

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

MODULE Rechtschreib;

   FROM ASCII IMPORT
      nul, eof;
   FROM Arts IMPORT
      Assert;
   FROM DynStr IMPORT
      DynString, StatString, MakeDynString;
   FROM NewInOut IMPORT
      FILE, Open, Close, ModeOld, ModeNew, WriteString, WriteStringFile,
      WriteLn, done, ReadFile, ReadStringFile, ReadString, ReadInt,
      WriteInt;
   FROM OpenHash IMPORT
      Table, InitHash, ExitHash, InsertHash, MemberHash, PrintTable;
   FROM Str IMPORT
      Length, Copy, Concat;
   FROM Strings IMPORT
      last, Occurs;
   FROM SYSTEM IMPORT
      ADR;
   IMPORT Strings;

   CONST
      MinTableSize = 997;
      (* Mindestgröße der Hashtabelle. Möglichst Primzahl. *)
      LexName      = "s:lexikon.lex";
      (* Name des Standartlexikons. *)
      Extension    = ".kor";
      (* Diese Extension wird an den Namen des Eingabefiles angehängt. *)

   VAR
      Tabelle     : Table;       (* Das Lexikon. *)
      lexfile,                   (* File in dem das Lexikon steht. *)
      infile,                    (* File des zu korrigierenden Textes. *)
      outfile     : FILE;        (* File des korrigieten Textes. *)
      Str,                       (* String für alles. *)
      EingabeStr,
      UpperStr,
      AusgabeStr  : StatString;
      DynS        : DynString;
      lastch      : CHAR;        (* Letztes eingegegebes Zeichen. *)
      valid       : BOOLEAN;
      von,
      bis,
      len         : INTEGER;
      TabSize     : INTEGER;

   (* Sucht den String Str im Lexikon, sucht auch alle Teilstrings. *)
   PROCEDURE Search ( VAR Str : StatString ) : BOOLEAN;
      VAR
         DynS     : DynString;
         TeilStr  : StatString;
         len, bis : INTEGER;
   BEGIN
      DynS := ADR ( Str );
      (* Suche Str im Lexikon. *)
      IF MemberHash ( Tabelle, DynS ) THEN
         RETURN TRUE;
      END;
      bis := 1;
      len := Length ( Str );
      (* Suche alle Präfixe von Str im Lexikon. *)
      WHILE ( bis <= len ) DO
         Strings.Copy ( TeilStr, Str, 0, bis );
         DynS := ADR ( TeilStr );
         IF MemberHash ( Tabelle, DynS ) THEN
            (* Wenn Präfix von Str im Lexikon suche Suffix. *)
            Strings.Copy ( TeilStr, Str, bis, len - bis );
            IF Search ( TeilStr ) THEN
               RETURN TRUE;
            END;
         END;
         (* Präfix um ein Zeichen vergrößern. *)
         INC ( bis );
      END;
      RETURN FALSE;
   END Search;

   (* Prüft ein Zeichen auf deutsches Sonderzeichen. ÄäÖöÜüß *)
   PROCEDURE isgerman ( ch : CHAR ) : BOOLEAN;
   BEGIN
      RETURN ( ch = 'ä' ) OR ( ch = 'Ä' ) OR ( ch = 'ö' ) OR
             ( ch = 'Ö' ) OR ( ch = 'ü' ) OR ( ch = 'Ü' ) OR
             ( ch = 'ß' );
   END isgerman;

   (* Prüft ein Zeichen auf Buchstabe. *)
   PROCEDURE isletter ( ch : CHAR ) : BOOLEAN;
   BEGIN
      RETURN ( 'A' <= CAP ( ch ) ) AND ( CAP ( ch ) <= 'Z' ) OR
             isgerman ( ch );
   END isletter;

   (* Wandelt alle Buchstaben eines Strings in Großbuchstaben um. *)
   PROCEDURE toupper ( VAR Str : StatString );
      VAR
         i, len : INTEGER;
         ch, hc : CHAR;
   BEGIN
      len := Length ( Str );
      FOR i := 0 TO len DO
         ch := Str [ i ];
         CASE ch OF
            'ä' : hc := 'Ä';
         |  'ö' : hc := 'Ö';
         |  'ü' : hc := 'Ü';
         |  'a' .. 'z'
                : hc := CAP ( ch );
         ELSE
            hc := ch;
         END;
         Str [ i ] := hc;
      END;
   END toupper;

   (* Liest ein Token aus file ein, gibt es in Str zurück, war es
      ein Word wird word TRUE. Rückgabe TRUE, wenn Dateiende erreicht. *)
   PROCEDURE ReadToken (     file : FILE;
                         VAR Str  : StatString;
                         VAR word : BOOLEAN ) : BOOLEAN;
      VAR
         ch : CHAR;     (* Aktuelles Zeichen. *)
         i  : INTEGER;  (* Index in Str. *)
   BEGIN
      i := 0;
      IF lastch # nul THEN
         (* Zeichen im Einagbepuffer lastch zurückgeben. *)
         ch     := lastch;
         lastch := nul;
      ELSE
         (* Neues Zeichen aus Datei lesen. *)
         ReadFile ( file, ch );
      END;
      IF isletter ( ch ) THEN
         (* Wörter beginnen mit einem Buchstaben. *)
         word := TRUE;
         REPEAT
            Str [ i ] := ch;
            INC ( i );
            ReadFile ( file, ch );
         UNTIL NOT done OR NOT isletter ( ch );
         (* Letztes Zeichen, das nicht zum Wort gehört zurückschreiben. *)
         lastch := ch;
         Str [ i ] := nul;
         RETURN TRUE;
      ELSE
         (* Kein Wort. Nur ein Zeichen zurückgeben. *)
         word := FALSE;
         Str [ 0 ] := ch;
         Str [ 1 ] := nul;
         RETURN ch # eof;
      END;
   END ReadToken;

BEGIN
   (* Eingabepuffer lastch löschen. *)
   lastch := nul;
   WriteString ( "Rechtschreib (C) 1990 B.Braun" );
   WriteLn;
   WriteLn;
   WriteString ( "Wie viele Einträge soll die Tabelle haben?" );
   WriteLn;
   WriteString ( "Leereingabe für " );
   WriteInt    ( MinTableSize, 1 );
   WriteLn;
   WriteString ( ">" );
   ReadInt ( TabSize );
   WriteString ( "Initialisiere Tabelle." );
   WriteLn;
   IF TabSize = 0 THEN
      InitHash ( Tabelle, MinTableSize );
   ELSE
      InitHash ( Tabelle, TabSize );
   END;
   WriteString ( "Bitte den Namen des Lexikons angeben." );
   WriteLn;
   WriteString ( "Leereingabe für " );
   WriteString ( LexName );
   WriteLn;
   WriteString ( ">" );
   ReadString  ( Str );
   IF Length ( Str ) # 0 THEN
      lexfile := Open ( Str, ModeOld );
   ELSE
      lexfile := Open ( LexName, ModeOld );
   END;
   Assert ( done, ADR ( "Kann Lexikon nicht öffnen!" ) );
   (* Einlesen des Lexikons in die Hashtabelle. *)
   LOOP
      ReadStringFile ( lexfile, Str );
      IF NOT done THEN EXIT END;
      MakeDynString  ( Str, DynS );
      InsertHash     ( Tabelle, DynS );
   END;
   Close ( lexfile );
   (* Bearbeiten des zu korrigierenden Textes. *)
   WriteString ( "Welcher Text soll bearbeitet werden?" );
   WriteLn;
   LOOP
      REPEAT 
         WriteString ( ">" );
         ReadString  ( Str );
      UNTIL done;
      infile := Open ( Str, ModeOld );
      IF NOT done THEN
         WriteString ( "Kein Eingabefile nicht öffnen!" );
         WriteLn;
      ELSE
         EXIT;
      END;
   END;
   Concat ( Str, Extension );
   outfile := Open ( Str, ModeNew );
   IF NOT done THEN
      (* Als Eingabefile wurd nil:, con:0/0/... oder ähnliches angegeben. *)
      Copy ( Str, "nil:" );
      (* Ausgabe ins Nichts schicken. *)
      outfile := Open ( Str, ModeNew );
      Assert ( done, ADR ( "Kann Ausgabefile nicht öffnen!" ) );
   END;
   WriteString ( "Schreibe korrigierten Text in" );
   WriteLn;
   WriteString ( Str );
   WriteLn;
   WriteLn;
   (* Hauptschleife. *)
   LOOP
      IF NOT ReadToken ( infile, EingabeStr, valid ) THEN EXIT END;
      WriteString ( EingabeStr );
      IF NOT valid THEN
         (* Kein Wort. *)
         WriteStringFile ( outfile, EingabeStr );
      ELSE
         (* Wort im Lexikon suchen. *)
         Copy ( UpperStr, EingabeStr );
         toupper ( UpperStr );
         IF NOT Search  ( UpperStr ) THEN
            (* Wort nicht in Hashtabelle gefunden. *)
            WriteLn; WriteLn;
            WriteString ( EingabeStr );
            WriteLn;
            WriteString ( "Bitte korrigiertes Wort eingeben. " );
            WriteLn;
            WriteString ( "Silben bitte mit '-' trennen." );
            WriteLn;
            WriteString ( "Leereingabe für Eintragen in Lexikon. " );
            WriteLn;
            WriteString ( "'!' für Abbruch, '+' für weiter." );
            WriteLn;
            WriteString ( ">" );
            ReadString  ( AusgabeStr );
            WriteLn;
            IF AusgabeStr [ 0 ] = '+' THEN
               (* Weitermachen. *)
               WriteStringFile ( outfile, EingabeStr );
            ELSIF AusgabeStr [ 0 ] = '!' THEN
               (* Eingabe bis zum Ende überlesen. *)
               LOOP
                  WriteString ( EingabeStr );
                  WriteStringFile ( outfile, EingabeStr );
                  IF NOT ReadToken ( infile, EingabeStr, valid ) THEN
                     EXIT;
                  END;
               END;
            ELSIF Length ( AusgabeStr ) = 0 THEN
               (* Wort unkorrigiert in Tabelle eintragen. *)
               WriteStringFile ( outfile, EingabeStr );
               MakeDynString ( UpperStr, DynS );
               InsertHash ( Tabelle, DynS );
            ELSE
               (* Korrigiertes Wort in Tabelle eintragen. *)
               (* Bindestriche aus Eingabestring extrahieren. *)
               von := 0;
               bis := 0;
               len := Length ( AusgabeStr );
               WHILE bis # last DO
                  bis := Occurs  ( AusgabeStr, von, '-', TRUE );
                  IF bis = last THEN
                     Strings.Copy ( Str, AusgabeStr, von, len - von );
                  ELSE
                     Strings.Copy ( Str, AusgabeStr, von, bis - von );
                  END;
                  WriteStringFile ( outfile, Str );
                  toupper         ( Str );
                  MakeDynString   ( Str, DynS );
                  IF NOT MemberHash ( Tabelle, DynS ) THEN
                     InsertHash     ( Tabelle, DynS );
                  END;
                  von := bis + 1;
               END;
            END;
         ELSE
            (* Wort im Lexikon gefunden. *)
            WriteStringFile ( outfile, EingabeStr );
         END;
      END;
   END;
   Close ( infile );
   Close ( outfile );
   (* Zurückschreiben der Hashtabelle ins Lexikon. *)
   WriteLn; WriteLn;
   WriteString ( "Rechtschreibprüfung beendet!" );
   WriteLn;
   WriteString
   ( "In welche Datei soll die Tabelle als Lexikon abgespeichert werden?" );
   WriteLn;
   WriteString ( "Leereingabe für " );
   WriteString ( LexName );
   WriteLn;
   WriteString ( ">" );
   ReadString ( Str );
   IF Length ( Str ) # 0 THEN
      lexfile := Open ( Str, ModeNew );
   ELSE
      lexfile := Open ( LexName, ModeNew );
   END;
   Assert ( done, ADR ( "Kann Ausgabefile nicht öffnen!" ) );
   PrintTable ( Tabelle, lexfile );
   Close ( lexfile );
(* Dauert zu lange, aber Heap macht das schon
   ExitHash ( Tabelle, TRUE );
*)
END Rechtschreib.