(*********************************************************************
 *
 *  :Program.    Speech.mod
 *  :Author.     Michael Frieß
 *  :Address.    Kernerstr. 22a
 *  :Address.    7000 Stuttgart 1
 *  :shortcut.   [MiF]
 *  :Version.    1.0
 *  :Date.       01.11.88
 *  :Copyright.  PD
 *  :Language.   Modula-II
 *  :Translator. M2Amiga
 *  :Contents.   Routinen zur Sprachunterstützung (auch Deutsch!)
 *
 *********************************************************************)

IMPLEMENTATION MODULE Speech;

FROM SYSTEM      IMPORT ADR, LONGSET, BYTE;
FROM Exec        IMPORT
        MsgPortPtr, OpenDevice, CloseDevice,
        write, DoIO;
FROM ExecSupport IMPORT
        CreatePort, DeletePort,
        CreateExtIO, DeleteExtIO;
FROM Narrator IMPORT narratorName, NarratorPtr, Narrator,
                defPitch, defRate, defVol, defFreq, defSex,
                defMode;
FROM Strings  IMPORT Length;
IMPORT Translator;


CONST module = "Speech V1.0";
      copyright = "Speech: (C) Copyright 1988 by Michael Frieß";
      Trenn = "_"; (* Trennzeichen für Silbentrennung *)

TYPE str2 = ARRAY [0..1] OF CHAR;
     str3 = ARRAY [0..2] OF CHAR;

VAR NarratorPort : MsgPortPtr;
    NarratorMsg  : NarratorPtr;
    Phonemes     : ARRAY [1..70] OF CHAR;
    AudChannels  : ARRAY [1..4] OF BYTE;


PROCEDURE OpenNarrator (m: BOOLEAN);
 BEGIN
  NarratorPort := CreatePort (ADR(module), 0);
  NarratorMsg  := CreateExtIO (NarratorPort, SIZE (Narrator));
  WITH NarratorMsg^ DO
   message.command := write;
   chMasks := ADR(AudChannels);
   nmMasks := 4;
   rate := defRate;
   pitch  := defPitch;
   mode   := defMode;
   sex    := defSex;
   volume := defVol;
   sampFreq := defFreq;
   IF m THEN mouths := 1 ELSE mouths := 0 END
  END;
  OpenDevice (ADR(narratorName), 0, NarratorMsg, LONGSET{0});
 END OpenNarrator;

PROCEDURE CloseNarrator;
 BEGIN
  CloseDevice (NarratorMsg);
  DeleteExtIO (NarratorMsg);
  DeletePort  (NarratorPort);
 END CloseNarrator;

PROCEDURE SayPhonemes (p: ARRAY OF CHAR; v: voice);
 BEGIN
  WITH NarratorMsg^ DO
   rate   := v.rate;
   pitch  := v.pitch;
   mode   := v.mode;
   sex    := v.sex;
   volume := v.volume;
   sampFreq := v.sampFreq;
   message.data   := ADR(p);
   message.length := Length (p)
  END;
  DoIO (NarratorMsg);
 END SayPhonemes;

PROCEDURE Cap (c: CHAR): CHAR;
 BEGIN
  CASE c OF
   "ä": RETURN "Ä" |
   "ö": RETURN "Ö" |
   "ü": RETURN "Ü"
  ELSE RETURN CAP(c)
  END
 END Cap;

PROCEDURE Translate (in: ARRAY OF CHAR; VAR out: ARRAY OF CHAR;
                     Language: language) : INTEGER;
 VAR i, j, max, Result : INTEGER;
     c0 : CHAR;
     s  : ARRAY [0..0] OF CHAR;
     Anlaut, VorVokal : BOOLEAN;

 PROCEDURE Append (c: ARRAY OF CHAR);
  (* Append phonemes to phoneme-string *)
  VAR i: INTEGER;
  BEGIN
   IF j+HIGH(c) <= HIGH (out) THEN
    FOR i := 0 TO HIGH(c) DO
     out[j+i] := c[i]
    END;
    INC(j,HIGH(c)+1)
   ELSE
    Result := Translator.noMem
   END;
  END Append;

 PROCEDURE TEST1 (c: CHAR): BOOLEAN;
  (* test next input character *)
  BEGIN
   IF i < max THEN
    RETURN (c = Cap(in[i+1]))
   ELSE
    RETURN FALSE
   END
  END TEST1;

 PROCEDURE TEST2 (c: str2) : BOOLEAN;
  (* test next two input characters *)
  BEGIN
   IF i+1 < max THEN
    RETURN ((c[0] = Cap(in[i+1])) AND (c[1] = Cap(in[i+2])))
   ELSE
    RETURN FALSE
   END;
  END TEST2;

 PROCEDURE TEST3 (c: str3) : BOOLEAN;
  (* test next three input characters *)
  BEGIN
   IF i+2 < max THEN
    RETURN ((c[0] = Cap(in[i+1])) AND (c[1] = Cap(in[i+2]))
       AND  (c[2] = Cap(in[i+3])))
   ELSE
    RETURN FALSE
   END;
  END TEST3;

 PROCEDURE TESTDoppel ():BOOLEAN;
  (* Testet Doppelkonsonanten *)
  BEGIN
   RETURN ((i+2 <= max) AND (Cap(in[i+1]) = Cap(in[i+2]))) OR
          ((i+3 <= max) AND (in[i+2] = Trenn) AND (Cap(in[i+1]) = Cap(in[i+3])))
  END TESTDoppel;

 PROCEDURE TESTAuslaut ():BOOLEAN;
  (* Testet, ob Silbe Auslaut ist. *)
  VAR j: INTEGER;
  BEGIN
   j := i;
   WHILE (j <= max) AND (in[j] # " ") DO
    IF in[j] = Trenn THEN
     RETURN FALSE END;
    INC (j)
   END;
   RETURN TRUE
  END TESTAuslaut;

 PROCEDURE TGerman;
  (* translate german *)
  BEGIN
    max := Length(in)-1;
    i := 0; j := 0;
    Anlaut := TRUE;
    WHILE i <= max DO
     c0 := Cap (in[i]);
     CASE c0 OF
       "A": IF TEST1 ("A") OR TEST1 ("H") THEN INC(i); Append ("AAAA")
            ELSIF TEST1 ("E")  THEN in[i+1] := "Ä"
            ELSIF TEST1 ("Y") OR TEST1 ("I") THEN INC(i); Append ("AY")
            ELSIF TEST1 ("U")               THEN INC(i); Append ("AW")
            ELSIF TEST2 ("CH") OR TEST3 ("SCH")
                  OR TESTDoppel()          THEN Append ("AH")
            ELSE                                Append ("AA")
            END;
            VorVokal := FALSE
     | "Ä": IF TEST1 ("U")    THEN INC(i); Append ("OY")
            ELSIF TEST1 ("H") THEN INC(i); Append ("AEAE");
            ELSIF TEST3 ("SCH") OR TESTDoppel() THEN
                                          Append ("EH");
            ELSE
                                          Append ("AE");
            END;
            VorVokal := FALSE
     | "B": IF TESTAuslaut() AND NOT VorVokal THEN
             Append ("P") ELSE Append ("B")
            END
     | "C": IF TEST2 ("HS")   THEN INC (i); Append ("KS")
            ELSIF TEST1 ("H") THEN INC (i); Append ("/C")
            ELSIF TEST1 ("K") THEN INC (i); Append ("K")
            ELSE                           Append ("TS")
            END
     | "D": IF TEST1 ("T") THEN INC (i); Append ("T")
            ELSIF TESTAuslaut() AND NOT VorVokal
            THEN                        Append ("T")
            ELSE                        Append ("D")
            END
     | "E": IF TEST1 ("E") OR TEST1 ("H")    THEN INC (i); Append ("EH");
            ELSIF TEST1 ("I") OR TEST1 ("Y") THEN INC (i); Append ("AY");
            ELSIF TEST1 ("U")               THEN INC (i); Append ("OY");
            ELSIF TEST2 ("CH") OR TEST3 ("SCH") OR TESTDoppel() THEN
             Append ("EH");
            ELSIF TESTAuslaut() AND NOT Anlaut THEN Append ("IX")
             (* Abschwächung bei anlautender Silbe nicht
                implementiert *)
            ELSE
             Append ("EH");
            END;
            VorVokal := FALSE
     | "F": Append ("F")
     | "G": IF TESTAuslaut() AND NOT VorVokal THEN
             Append ("K") ELSE Append ("G")
            END
     | "H": Append ("/H");
     | "I": IF TEST2 ("EH") THEN INC (i,2); Append ("IY")
            ELSIF TEST1 ("E") OR TEST1 ("H") THEN INC (i); Append ("IY")
            ELSIF TEST2 ("CH") OR TEST3 ("SCH") OR TESTDoppel() OR
                  (Anlaut AND TESTAuslaut()) THEN
              Append ("IX")
            ELSE
              Append ("IY")
            END;
            VorVokal := FALSE
     | "J".."N": s[0] := c0; Append (s)
     | "O": IF TEST1 ("E") THEN in[i+1] := "Ö"
            ELSIF TEST1 ("O") OR TEST1 ("H") THEN INC(i); Append ("OH");
            ELSIF TEST1 ("U") THEN INC (i); Append ("UH")
            ELSIF TEST1 ("I") THEN INC (i); Append ("OY")
            ELSIF TEST2 ("CH") OR TEST3 ("SCH")
                  OR TESTDoppel() THEN
             Append ("OH")
            ELSE
             Append ("OH");
            END;
            VorVokal := FALSE
     | "Ö": IF TEST1 ("H") THEN         INC(i); Append ("ER");
            ELSIF NOT (TEST2 ("CH") OR TEST3 ("SCH") OR TESTDoppel()) THEN
              Append ("ER")
            ELSE
              Append ("ER")
            END;
            VorVokal := FALSE
     | "P": IF TEST1 ("H") THEN Append ("F") ELSE Append ("P") END
     | "Q": IF TEST1 ("U") THEN INC (i) END;
            Append ("KV");
     | "R": Append ("R");
     | "S": IF TEST2 ("CH") THEN INC (i,2); Append ("SH");
            ELSIF (TEST1 ("P") OR TEST1 ("T"))
              AND Anlaut AND VorVokal THEN Append ("SH");
            ELSIF (TEST1 ("A")) OR (TEST1 ("E")) OR (TEST1 ("I"))
               OR (TEST1 ("O")) OR (TEST1 ("U")) OR (TEST1 ("Ä"))
               OR (TEST1 ("Ö")) OR (TEST1 ("Ü"))
            THEN
             Append ("Z")
            ELSE
             Append ("S")
            END
     | "T": IF TEST1 ("H") OR TEST1 ("T") THEN INC (i); Append ("TT")
            ELSE Append ("T")
            END
     | "U": IF TEST1 ("E") THEN in[i+1] := "Ü"
            ELSIF TEST1 ("H") THEN INC(i); Append ("UW")
            ELSIF TEST2 ("CH") OR TEST3 ("SCH") OR TESTDoppel()
             THEN Append ("UH")
            ELSE Append ("UW")
            END;
            VorVokal := FALSE
     | "Ü": IF TEST1 ("H") THEN         INC(i); Append ("ER");
            ELSIF TEST2 ("CH") OR TEST3 ("SCH") OR TESTDoppel() THEN
             Append ("ER");
            ELSE
             Append ("ER");
            END;
            VorVokal := FALSE
     | "V": Append ("F")
     | "W": Append ("V")
     | "X": Append ("KS");
     | "Y": IF TEST1 ("H") THEN INC (i); Append ("IH")
            ELSIF TEST2 ("CH") OR TEST3 ("SCH") OR TESTDoppel()
             THEN Append ("IH")
            ELSE Append ("IX")
            END
     | "Z": Append ("TS");
     | "ß": Append ("S")
     | Trenn: Anlaut := FALSE; VorVokal := TRUE;
     | "1".."9", "?", ".", "-", ",", "(", ")": s[0] := c0; Append (s)
     ELSE Anlaut := TRUE;
          VorVokal := TRUE;
          IF (j > 0) AND (out[j-1] # " ") THEN Append (" ") END
     END;
     INC (i)
    END;
    Append (CHR(0))
  END TGerman;

BEGIN
  Result := 0;
  CASE Language OF
     German : TGerman
   | English: Result := INTEGER(
              Translator.Translate (ADR(in),  Length(in),
                                    ADR(out), HIGH(out)+1))
   | French : Result := Translator.notUsed
  END;
  RETURN Result
 END Translate;

BEGIN
 AudChannels[1] := 1;
 AudChannels[2] := 2;
 AudChannels[3] := 4;
 AudChannels[4] := 8;
 WITH DefaultVoice DO
  rate := defRate;
  pitch  := defPitch;
  mode   := defMode;
  sex    := defSex;
  volume := defVol;
  sampFreq := defFreq;
 END
END Speech.