(**************************************)
(*  Nimm Spiel zur Demonstration des  *)
(*  Boutons Algorithmus               *)
(*  Adaption in Turbo Pascal          *)
(*  JOYCE PCW 8256/8512/9512          *)
(*  (c) 1992 Dieter Kinzinger         *)
(*         & CPC International        *)
(**************************************)

Program Nimm;

Var   haufen         : Array[1..8] Of Integer;
      anzahl,
      ungerade,
      wahl,abzug,
      rest           : Byte;
      spieler        : Char;
      Ende,nochmal   : Boolean;

Procedure hide_cursor;
Begin
     Write(#27,'f');
End;

Procedure show_cursor;
Begin
     Write(#27,'e');
End;

Procedure linie(typ: Byte);
var art,i : Byte;
Begin
     Case typ Of
      1 : art := 138;
      2 : art := 154;
      3 : art := 95;
     End;
     For i:=1 to 90 Do Write(Chr(art));
End;

Procedure maske;
Begin
     ClrScr;
     GotoXY(0,1);linie(1);
     GotoXY(35,3);Write('N I M M - S P I E L');
     GotoXY(0,5);linie(1);
     GotoXY(0,20);linie(2);
     GotoXY(0,28);linie(3);
End;

Procedure display;
Var i,k : Byte;
Begin
     For i:= 1 to anzahl do Begin
         GotoXY(10,i+8);Write(i,':');
         For k:=1 to haufen[i] Do
             Write('*');
         ClrEol;
     End;
End;

Procedure eingabe;
Var i : Byte;
Begin
     GotoXY(20,22);
     Write('Wieviele Haufen <1-8> ?  ');
     repeat
        GotoXY(45,22);Write(chr(7));Read(anzahl);
     Until anzahl In [1..8];
     For i := 1 to anzahl Do
         haufen[i] := Trunc(1+2*i*Random);
     display;
     GotoXY(20,22);
     Write('M|chten Sie beginnen?<j,n>       ');
     GotoXY(48,22);Read(spieler);
     GotoXY(20,22);ClrEol;
End;

Procedure status;
Var zaehler,i,j,bit : Byte;
Begin
     ungerade := 0;bit := 1;
     For i := 1 to 4 do Begin
         zaehler := 0;
         For j := 1 to anzahl do Begin
             If ((haufen[j] and bit)=bit) Then
                        zaehler := zaehler + 1;
         End;
         bit := bit * 2;
         ungerade := ungerade Or (zaehler and 1);
     End;
End;

Procedure computerzug;
Var i : Byte;
Begin
     hide_cursor;
     status;
     if ungerade > 0 Then Begin
        wahl := 1;
        abzug := 0;
        While (ungerade>0) And (wahl<=anzahl) Do
        Begin
          If haufen[wahl] = 0 then Begin
              haufen[wahl]:= haufen[wahl] + abzug;
              wahl := wahl +1;
              abzug := 0;
          End Else Begin
              abzug := abzug + 1;
              haufen[wahl] := haufen[wahl] - 1;
              status;
          End;
        End;
     End Else Begin
        wahl := 0;
        For i := 1 to anzahl Do
          If haufen[i] > wahl Then wahl := i;
        abzug := haufen[wahl];
        haufen[wahl] := 0;
     End;
     display;
     rest:=0;
     For i:=1 to anzahl Do Begin
         rest := haufen[i]+rest;
     End;
     If rest<=0 then Begin
       GotoXY(20,22);
       Write(Chr(7),'Der Computer hat gewonnen!');
       Ende := true;
     End;
     show_cursor;
End;

Procedure spielerzug;
Var i : Byte;
Begin
  GotoXY(20,22);
  Write('Aus welchem Haufen nehmen Sie?    ');
  Repeat
    GotoXY(61,22);Write(Chr(7));Read(wahl);
  Until wahl In [1..anzahl];
  GotoXY(20,22);
  Write('Wieviel H|lzchen m|chten Sie nehmen?',
  '      ');
  Repeat
        GotoXY(61,22);Write(Chr(7));Read(abzug);
  Until abzug In [1..haufen[wahl]];
  GotoXY(20,22);ClrEol;
  haufen[wahl]:=haufen[wahl]-abzug;
  display;
  rest:=0;
  For i:=1 to anzahl Do rest := haufen[i]+rest;
  If rest=0 then Begin
     GotoXY(20,22);
     Write(Chr(7),'Sie haben gewonnen!');
     Ende := True;
  End Else computerzug;
End;

Procedure abfrage;
Var wahl : Char;
Begin
  GotoXY(20,24);
  Write('M|chten Sie noch ein Spiel? <j,n>    ');
  Read(wahl);
  GotoXY(20,24);ClrEol;
  If wahl='j' Then nochmal:=True
              Else nochmal:=False;
End;

Begin
   Repeat
     Ende := False;
     maske;
     eingabe;
     If spieler = 'j' Then spielerzug
                      Else computerzug;
     Repeat spielerzug Until Ende;
     abfrage;
   Until nochmal = False;
   ClrScr;
End.