(***************************************************************************)
(*                      de Luxe-Version von Superhirn                      *)
(***************************************************************************)
PROGRAM SuperBrain_Professional;

PROCEDURE LiesZeichen(VAR c : char); FORWARD;

(*$I WINDOW.PAR     *)
(*$I WINDOW.BIB     *)
(*$I LAUF.BIB       *)
(*$I CHOOSE.BIB     *)
(*$I SELEKT-1.BIB   *)

CONST MaxFarben = 6;
      MaxSteckerlZahl = 5;
      MaxVersuche = 10;
      SteckerlZahl : 1..MaxSteckerlZahl = 5;
      FarbZahl : 1..MaxFarben = 5;
      SchriftZug = 'CHIP - SPECIAL - SUPERBRAIN - PROFESSIONAL';

TYPE  SteckerlFarbe = (rot,pink,blau,gelb,lila,hell,illegal);
      BewertungsSteckerl = (schwarz, weiss);
      Bewertung = ARRAY[BewertungsSteckerl] OF 0..MaxSteckerlZahl;
      Kombination = ARRAY[1..MaxSteckerlZahl] OF SteckerlFarbe;

VAR   MenueFenster, MenschFenster, ComputerFenster : byte;
      M_Zuege, C_Zuege : integer;

CONST Farben : ARRAY[1..MaxFarben] OF STRING[5] =
               ('rot','pink','blau','gelb','lila','weiá');
      Menue : ARRAY[1.. 6] OF STRING[6] =
              ('1','2','3','4','5','Fertig');
      Wahl : integer = 1;
      HauptMenue : ARRAY[1..5] OF STRING[10] =
      ('Parameter','Ihr Spiel','Mein Spiel','Game','Ende');
      HauptmenueWahl : integer = 1;

PROCEDURE LiesZeichen; (* Mit Ihrer speziellen Tastaturanpassung *)
  BEGIN
    WHILE NOT KeyPressed DO Lauf;
    read(kbd,c);
    (* case c of ... Siehe Turbo-Special-3 *)
        {fuer IBM vp15.09.02}
        CASE C OF
{
          #59 : c:='?'; (* F1 *)
          #72 : C:=^E; (* Cursor hoch *)
          #80 : C:=^X; (* Cursor tief *)
          #75 : C:=^S; (* Cursor links *)
          #77 : C:=^D; (* Cursor rechts *)
          #73 : C:=^R; (* PageUp *)
          #81 : C:=^C; (* PageDown *)
          #82 : C:=^V; (* Insert *)
          #83 : C:=^G; (* Delete *)
         #115 : C:=^A; (* Ctrl + Cursor links *)
         #116 : C:=^F; (* Ctrl + Cursor rechts *)
}
           #0 : ;      (* Dummy hier weil nichts gefiltert wird *)
        END (* CASE *)
  END; (* LiesZeichen *)

(* inverse_video und normal_video bitte entsprechend anpassen! *)
(* PROCEDURE inverse_video; BEGIN TextBackGround(15); TextColor(0) END; *)
PROCEDURE inverse_video; BEGIN InvVideo END;
PROCEDURE normal_video; BEGIN NormVideo END;

PROCEDURE Bewerte(Ziel, Test : Kombination; VAR Wertung : Bewertung);
  VAR i, j : 1..MaxSteckerlZahl;
  BEGIN
    (* Erst die schwarzen BewertungsSteckerl *)
    Wertung[schwarz]:=0;
    FOR i:=1 TO SteckerlZahl DO
      IF Ziel[i]=Test[i] THEN
        BEGIN
          Wertung[schwarz]:=succ(Wertung[schwarz]);
          Ziel[i]:=illegal; Test[i]:=illegal
        END;
    (* Dann die weissen *)
    Wertung[weiss]:=0;
    FOR i:=1 TO SteckerlZahl DO
      FOR j:=1 TO SteckerlZahl DO
        IF (Ziel[i]=Test[j]) AND NOT (Ziel[i]=illegal)
          THEN BEGIN
                 Wertung[weiss]:=succ(Wertung[weiss]);
                 Ziel[i]:=illegal; Test[j]:=illegal
               END
  END;

PROCEDURE ZufallsKombination(VAR K : Kombination);
  VAR i : 1..MaxSteckerlZahl;
  BEGIN
    FOR i:=1 TO SteckerlZahl DO
      K[i]:=SteckerlFarbe(random(FarbZahl)) (* Re-Typing !! *)
  END; (* ZufallsKombination *)

PROCEDURE SchreibBewertung(Wertung : Bewertung; Versuch : integer);
  VAR i : 1..MaxSteckerlZahl;
  BEGIN
    gotoxy(3+SteckerlZahl*6,succ(Versuch)); ClrEol; gotoxy(33,succ(Versuch));
    FOR i:=1 TO Wertung[schwarz] DO write('O');
    FOR i:=1 TO Wertung[weiss] DO write('X');
    writeln
  END; (* SchreibBewertung *)

PROCEDURE LiesKombination(Versuch : integer; VAR K : Kombination;
                          Mensch : boolean);
VAR FarbWahl, i, Versch : integer; temp : byte;

PROCEDURE NextWindow(i,m : integer);
  VAR t : integer;
  BEGIN
    Wahl:=i; Choose(3,succ(Versuch),6,7,Menue,m,Wahl,true);
  END; (* NextWindow *)

FUNCTION fertig : boolean;
  VAR i : integer;
  BEGIN
    FOR i:=1 TO SteckerlZahl DO
      IF Menue[i]=chr(48+i) THEN BEGIN fertig:=false; exit END;
    fertig:=true
  END; (* fertlg *)

BEGIN (* LiesKombination *)
  Wahl:=1; FOR i:=1 TO SteckerlZahl DO Menue[i]:=chr(48+i);
  Menue[SteckerlZahl+1]:='Okay'; IF Mensch THEN Versch:=3 ELSE Versch:=43;
  REPEAT
    IF fertig THEN i:=succ(SteckerlZahl) ELSE i:=SteckerlZahl;
    gotoxy(1,succ(Versuch)); IF Mensch THEN write(Versuch);
    Choose(3,succ(Versuch),6,7,Menue,i,Wahl,false);
    IF Wahl<=SteckerlZahl THEN
      REPEAT
        FarbWahl:=1;
        temp:=ScreenPtr; ChangeWindow(MaxScreen);
        OpenWindow(Versch+pred(Wahl)*6,Versuch+7,Versch+7+pred(Wahl)*6,
                   Versuch+succ(7+FarbZahl));
        Selekt(2,1,SizeOf(Farben[1]),Farben,FarbZahl,FarbWahl);
        CloseWindow; ChangeWindow(temp);
        CASE FarbWahl OF
          1..MaxFarben : BEGIN
                           Menue[Wahl]:=Farben[FarbWahl];
                           K[Wahl]:=SteckerlFarbe(pred(FarbWahl));
                         END;
          -1   : IF Wahl>1 THEN NextWindow(pred(Wahl),i);
          -2   : IF Wahl<SteckerlZahl THEN NextWindow(succ(Wahl),i);
        END
      UNTIL (FarbWahl>=0) OR (Wahl=succ(SteckerlZahl))
  UNTIL (Wahl=succ(SteckerlZahl)) AND fertig;
END; (* LiesKombination *)

PROCEDURE SchreibKombination(K : Kombination);
  VAR i : 1..MaxSteckerlZahl;
  BEGIN
    FOR i:=1 TO SteckerlZahl DO
      write(Farben[1+ord(K[i])],'':6-length(Farben[1+ord(K[i])]))
  END; (* SchreibKombination *)

PROCEDURE MenschenSpiel( VAR ZugZahl : integer);
VAR i : integer;
    VersuchsBewertung : Bewertung;
    Gesucht, Versuch : Kombination;

PROCEDURE LeistungsBewertung(Versuche : integer);
  BEGIN
    writeln;
    CASE (Versuche*30) DIV (SteckerlZahl*FarbZahl) OF
      1..3   : writeln('   Das war ein Glueckstreffer!');
      4..6   : writeln('       Eine tolle Leistung!');
      7..9   : writeln('         Das war sehr gut!');
      10..12 : writeln('   Immerhin haben Sie es geschafft');
      ELSE writeln(' Mehr Denken hat noch nie geschadet!')
    END
  END; (* LeistungsBewertung *)

  BEGIN (* MenschenSpiel *)
    ChangeWindow(MenschFenster); ClrScr; inverse_video; write('  ');
    FOR i:=1 TO SteckerlZahl DO write(' ???? '); ClrEol; normal_video;
    ZufallsKombination(Gesucht);
    ZugZahl:=0;
    REPEAT
      ZugZahl:=succ(ZugZahl);
      LiesKombination(ZugZahl,Versuch,true);
      Bewerte(Gesucht,Versuch,VersuchsBewertung);
      SchreibBewertung(VersuchsBewertung,ZugZahl)
    UNTIL (VersuchsBewertung[schwarz]=SteckerlZahl) OR (ZugZahl=MaxVersuche);
    IF VersuchsBewertung[schwarz]<SteckerlZahl
      THEN writeln('Das war nix!') ELSE LeistungsBewertung(ZugZahl);
    gotoxy(1,1); inverse_video; write('   '); SchreibKombination(Gesucht);
    normal_video; ChangeWindow(MenueFenster)
  END; (* MenschenSpiel *)

PROCEDURE LiesParameter;
  VAR c : char;
  BEGIN
    OpenWindow(1,5,40,10);
    gotoxy(10,1); write('Die Spielparameter');
    gotoxy(1,3); write('  Anzahl der Steckerl (2..5): ',SteckerlZahl);
    gotoxy(1,4); write('  Anzahl der Farben   (2..6): ',FarbZahl);
    gotoxy(31,3);
    REPEAT LiesZeichen(c) UNTIL c IN ['2'..'5',^M];
    IF c<>^M THEN BEGIN write(c); SteckerlZahl:=ord(c)-48 END;
    gotoxy(31,4);
    REPEAT LiesZeichen(c) UNTIL c IN ['2'..'6',^M];
    IF c<>^M THEN BEGIN write(c); FarbZahl:=ord(c)-48 END;
    CloseWindow;
  END; (* LiesParameter *)

PROCEDURE ComputerSpiel(VAR ZugZahl : integer);

LABEL GEFUNDEN;
VAR E : boolean; i : integer;
    S : ARRAY[1..10] OF RECORD K : Kombination; B : Bewertung END;
    Gesucht : Kombination;

FUNCTION passt(K : Kombination; Nr : integer) : boolean;
  VAR i : integer; BT : Bewertung;
  BEGIN
    FOR i:= 1 TO Nr DO
      BEGIN
        Bewerte(K,S[i].K,BT); Lauf; Lauf;
        IF BT[schwarz]<>S[i].B[schwarz] THEN BEGIN passt:=false; exit END ELSE
        IF BT[weiss]<>S[i].B[weiss] THEN BEGIN passt:=false; exit END
      END;
    passt:=true
  END; (* passt *)

PROCEDURE NextKombination(VAR K : Kombination; VAR Ende : boolean);
  VAR i : 0..MaxSteckerlZahl;
      fertig : boolean;
  BEGIN
    i:=SteckerlZahl; Lauf; Lauf;
    REPEAT
      fertig:=true;
      K[i]:=succ(K[i]);
      IF ord(K[i])=FarbZahl THEN
        BEGIN K[i]:=rot; fertig:=false; i:=pred(i) END
    UNTIL fertig OR (i=0);
    Ende:=i=0
  END; (* NextKombination *)

FUNCTION VersuchErfolgreich(Nr : integer):boolean;

PROCEDURE LiesBewertung(VAR B : Bewertung; Nr : integer);
  LABEL FERTIG;
  VAR c : char; temp : integer;
  BEGIN
    temp:=ScreenPtr; ChangeWindow(MaxScreen); OpenWindow(43,Nr+8,78,Nr+13);
    writeln('Geben Sie die Bewertung ein'); writeln;
    write('Anzahl der schwarzen Stecker: ');
    REPEAT LiesZeichen(c) UNTIL (c>='0') AND (c<=chr(48+SteckerlZahl));
    writeln(c); B[schwarz]:=ord(c)-48; B[weiss]:=0;
    IF B[schwarz]=SteckerlZahl THEN GOTO FERTIG;
    write('Anzahl der weissen Stecker:   ');
    REPEAT LiesZeichen(c) UNTIL c IN ['0'..chr(48+SteckerlZahl-B[schwarz])];
    write(c); B[weiss]:=ord(c)-48;
    IF B[schwarz]+B[weiss]=SteckerlZahl THEN
      IF B[weiss]=1 THEN BEGIN B[schwarz]:=SteckerlZahl; B[weiss]:=0 END;
    FERTIG: CloseWindow; ChangeWindow(temp)
  END; (* LiesBewertung *)

  BEGIN (* VersuchErfolgreich *)
    SchreibKombination(S[Nr].K); LiesBewertung(S[Nr].B,Nr);
    SchreibBewertung(S[Nr].B,Nr);
    VersuchErfolgreich:=S[Nr].B[schwarz]=SteckerlZahl
  END; (* VersuchErfolgreich *)

PROCEDURE PruefeBewertung(K : Kombination; Z : integer; VAR i : integer);
  BEGIN
    i:=0; REPEAT i:=succ(i) UNTIL NOT passt(K,i);
    gotoxy(4,succ(i)); inverse_video; SchreibKombination(S[i].K); normal_video
  END; (* PruefeBewertung *)

BEGIN (* ComputerSpiel *)
  ChangeWindow(ComputerFenster); ClrScr;
  LiesKombination(0,Gesucht,false);
  gotoxy(1,1); inverse_video; write('   ');
  SchreibKombination(Gesucht); ClrEol; normal_video;
  ZugZahl:=1; gotoxy(1,succ(ZugZahl)); write(ZugZahl,'  ');
  ZufallsKombination(S[ZugZahl].K);
  IF VersuchErfolgreich(ZugZahl) THEN GOTO GEFUNDEN;
  ZugZahl:=2; gotoxy(1,succ(ZugZahl)); write(ZugZahl,'  ');
  REPEAT ZufallsKombination(S[ZugZahl].K) UNTIL passt(S[ZugZahl].K,1);
  IF VersuchErfolgreich(ZugZahl) THEN GOTO GEFUNDEN;
  REPEAT
    ZugZahl:=succ(ZugZahl); gotoxy(1,ZugZahl+1); write(ZugZahl,'  ');
    FOR i:=1 TO SteckerlZahl DO S[ZugZahl].K[i]:=rot; E:=false;
    WHILE NOT passt(S[ZugZahl].K,pred(ZugZahl)) AND NOT E DO
      NextKombination(S[ZugZahl].K,E);
    IF E THEN BEGIN
                writeln('Falsche Angaben!');
                PruefeBewertung(Gesucht,pred(ZugZahl),ZugZahl);
                GOTO GEFUNDEN
              END;
  UNTIL VersuchErfolgreich(ZugZahl);
  GEFUNDEN:
  ChangeWindow(MenueFenster)
END; (* ComuterSpiel *)

PROCEDURE Game;
  CONST ErsterWahl : ARRAY[1..2] OF STRING[8] = ('Mensch','Computer');
  VAR AnDerReihe : (Mensch,Computer);
      M_Punkte, C_Punkte : integer;
      M_Ergebnis, C_Ergebnis : integer;
      Erster : integer;
      SpielEnde : boolean;
      MenueWahl : integer;
      PunkteStr : STRING[80];

  BEGIN
    OpenWindow(50,5,70,9); writeln('Wer soll beginnen?'); Erster:=1;
    REPEAT selekt(5,2,9,ErsterWahl,2,Erster) UNTIL Erster IN [0..2];
    CloseWindow;
    CASE Erster OF
      0 : exit;
      1 : AnDerReihe:=Mensch;
      2 : AnDerReihe:=Computer;
    END;
    SpielEnde:=false; M_Punkte:=0; C_Punkte:=0; M_Ergebnis:=0; C_Ergebnis:=0;
    REPEAT
      PunkteStr:='Aktueller Punktestand: Mensch '+chr(48+M_Punkte)+
                 ' - Computer '+chr(48+C_Punkte)+'!';
      InitLaufSchrift(30,1,PunkteStr,20,1500);
      MenueWahl:=2+ord(AnDerReihe);
      Choose(3,3,15,11,HauptMenue,5,MenueWahl,true);
      CASE AnDerReihe OF
        Mensch : MenschenSpiel(M_Ergebnis);
        Computer : ComputerSpiel(C_Ergebnis);
      END;
      IF succ(ord(AnDerReihe))<>Erster THEN
        BEGIN
          IF M_Ergebnis>C_Ergebnis
            THEN C_Punkte:=C_Punkte+(M_Ergebnis-C_Ergebnis)
            ELSE M_Punkte:=M_Punkte+(C_Ergebnis-M_Ergebnis);
          SpielEnde:=(M_Punkte>=5) OR (C_Punkte>=5);
          ChangeWindow(MenschFenster); ClrScr;
          ChangeWindow(ComputerFenster); ClrScr;
          ChangeWindow(MenueFenster);
        END;
      IF AnDerReihe=Mensch THEN AnDerReihe:=Computer ELSE AnDerReihe:=Mensch
    UNTIL SpielEnde;
    IF M_Punkte>C_Punkte
      THEN BEGIN
             ChangeWindow(MenschFenster);
             gotoxy(2,5); write('Gratuliere - Sie haben gewonnen!')
           END
      ELSE BEGIN
             ChangeWindow(ComputerFenster);
             gotoxy(2,5); write('Schade - Sie haben verloren!')
           END;
    ChangeWindow(MenueFenster);
    InitLaufSchrift(30,1,SchriftZug,20,1500)
END; (* Game *)

BEGIN (* SuperBrain_Professional *)
  InitWindows; ClrScr; cbreak:=false;
  OpenWindow(1,6,40,24); MenschFenster:=ScreenPtr;
  gotoxy(15,0); write('> MENSCH <');
  OpenWindow(41,6,80,24); ComputerFenster:=ScreenPtr;
  gotoxy(14,0); write('> COMPUTER <');
  OpenWindow(1,1,80,5); MenueFenster:=ScreenPtr;
  InitLaufSchrift(30,1,SchriftZug,20,1500);
  REPEAT
    Choose(3,3,15,11,HauptMenue,5,HauptMenueWahl,false);
    CASE HauptMenueWahl OF
      1 : LiesParameter;
      2 : MenschenSpiel(M_Zuege);
      3 : ComputerSpiel(C_Zuege);
      4 : Game
    END;
  UNTIL HauptMenueWahl=5; WHILE MaxScreen>0 DO CloseWindow;
END. (* SuperBrain_Professional *)