(*************************************************************************)
(*                     Kuenstliche Intelligenz ?                         *)
(*    EXPSYS,    aus CHIP-SPECIAL Turbo 2                                *)
(*************************************************************************)

PROGRAM ExpertenSystem;

TYPE  Eintrag = RECORD
              CASE Endknoten : boolean OF
              true : (Vermutung : STRING[40]);
              false: (Frage : RECORD
                              Zeile : STRING[40];
                              ja,
                              nein : integer
                              END)
              END;

VAR  EintrFile :FILE OF Eintrag;

PROCEDURE NormZeile(VAR z);
 VAR Zeile: String[40] Absolute z;
 BEGIN
   Zeile[1]:=upcase(Zeile[1]);
   IF Zeile[length(Zeile)]='?' THEN delete(Zeile,length(Zeile),1);
 END;

PROCEDURE LiesEintrag(Nummer : integer;VAR tEintr : Eintrag);
 BEGIN
  seek (EintrFile,Nummer-1);read(EintrFile,tEintr)
 END;

PROCEDURE SchreibEintrag(Nummer : integer; tEintr : Eintrag);
 BEGIN
  seek(EintrFile,Nummer-1);write(EintrFile,tEintr)
 END;

PROCEDURE StartDialog;
 VAR tEintr : Eintrag;
 BEGIN
  Clrscr;
  WITH tEintr, Frage DO
    BEGIN
      Endknoten:=false;
      write('Bitte geben Sie die erste Frage ein! ');
      readln(Zeile); NormZeile(Zeile);
      ja:=2; nein:=3
    END;
  SchreibEintrag(1,tEintr);
  WITH tEintr DO
    BEGIN
      Endknoten:=true;
      writeln('Worum handelt es sich wenn diese Frage bejaht wird? ');
      readln(Vermutung);
    END;
  SchreibEintrag(2,tEintr);
  WITH tEintr DO
    BEGIN
     Endknoten:=true;
     writeln('Worum handelt es sich,wenn diese Frage verneint wird? ');
     readln(Vermutung);
    END;
  SchreibEintrag(3,tEintr);
 END;

FUNCTION JaNein : char;
 VAR c: char;
 BEGIN
  write('J/N ? ');
  REPEAT read(kbd,c);c:=upcase(c) UNTIL c IN ['J','N'];
  writeln(c);
  JaNein:=c;
 END;

{$A-}
PROCEDURE Dialog(Nummer : integer);
 VAR tEintr,
     wEintr: Eintrag;
     Nr1,
     Nr2   : integer;
  BEGIN
   LiesEintrag(Nummer,tEintr);
   WITH tEintr DO
    CASE Endknoten OF
     true: BEGIN
            Endknoten:=false;
            writeln('Vermutlich handelt es sich um >',Vermutung,'<.');
            writeln;
            write('Ist das richtig? ');
            CASE JaNein OF
            'J': writeln(#10#13'Ich hoffe,Ihnen geholfen zu haben.');
            'N': BEGIN
                  WITH wEintr DO
                   BEGIN
                    Endknoten:=true;
                    writeln;
                    write('Worum handelt es sich dann? ');
                    readln(Vermutung);writeln;
                   END;
                  Nr1:=FileSize(EintrFile)+1;
                  SchreibEintrag(Nr1,wEintr);
                  WITH wEintr DO
                   BEGIN
                    Endknoten:=true;
                    Vermutung:=tEintr.Frage.Zeile;
                   END;
                  Nr2:=FileSize(EintrFile)+1;
                  SchreibEintrag(Nr2,wEintr);
                  write('Bitte geben Sie eine Frage ein,wodurch ');
                  write('es sich von >',wEintr.Vermutung);
                  writeln('< unterscheidet !');
                  readln(Frage.Zeile); writeln; NormZeile(Frage.Zeile);
                  write('Und wie lautet die Antwort?');
                  WITH Frage DO
                     CASE JaNein OF
                      'J': BEGIN ja:=Nr1; nein:=Nr2 END;
                      'N': BEGIN ja:=Nr2; nein:=Nr1 END;
                     END;
                  SchreibEintrag(Nummer,tEintr);
                  END;
                END;
               END;
        False: WITH Frage DO
                BEGIN
                 write(Zeile);
                 CASE JaNein OF
                 'J': Dialog(ja);
                 'N': Dialog(nein);
                END;
               END;
              END; {case}
             END; {Dialog}
     {$A+}

BEGIN
 clrscr;
 writeln('EXPSYS - WISSEN & LERNEN');
 writeln('========================');writeln;
 assign(EintrFile,'EXPSYS.EXP');
 {$I-} reset(EintrFile) {$I+};
 IF IOResult<>0
    THEN BEGIN
       rewrite(EintrFile);
       StartDialog;
    END;
 REPEAT
   clrscr;
   Dialog(1);writeln;writeln;
   write('Weitermachen?')
 UNTIL JaNein='N';
 close(EintrFile);
END.