(* Macchina giocatrice di NIM.
  Codice scritto da Viggiano R. Luigi, All righs reserved.

  Sorgente indentato da TPRecod e convertito in HTML da PAS2HTML, 
  due programmi scritti dall' autore suddetto.
  Se vuoi puoi scaricarli cliccando quì: TPRECOD PAS2HTML
  Clicca quì per scaricare il file zip contenente questo 
  sorgente ed il file eseguibile.
  
  Note sul programma: mancano i commenti, li metterò al più 
  presto.
*)

program
  NIMATRON;

uses
  CRT;

const
  Rows = 6;
  MaxPlayers = 4;

type
  TTable = array [ 1..Rows ] of Byte;
  TPlayer = ( Human, Computer );

var
  Table : TTable;
  Winner : Byte;
  Player : TPlayer;
  Players : array [ 1..MaxPlayers ] of TPlayer;
  CurrentPlayer : Byte;
  NumPlayers : Byte;

{============================================================================}

procedure GameRules;
begin
  Writeln ( 'NIMATRON version 1.0. Copyright (c) 1996 by Viggiano Rocco Luigi.' );
  Writeln;
  Writeln ( 'Le regole sono semplici: ogni giocatore a turno toglie uno o più' );
  Writeln ( 'gettoni da una riga orizzontale della griglia del gioco.' );
  Writeln ( 'Lo scopo del gioco è di catturare l'' ultimo gettone.' );
  Writeln;
  Writeln ( 'Per vedere una demo selezionare 2 giocatori e far giocare il' );
  Writeln ( 'computer contro se stesso. ' );
  Writeln;
  Writeln ( 'Nota: l'' intelligenza artificiale del computer è stata progettata' );
  Writeln ( 'per il gioco 1 contro 1 (2 soli giocatori). ' );
  Writeln;
  Writeln ( 'Il computer è quasi imbattibile, ma se vuoi avere qualche possibilità ' );
  Writeln ( 'in più devi iniziare per primo.' );
  ReadKey;
end;

{============================================================================}

procedure ReadPlayers;
var
  i : Byte;
  ch : Char;

begin
  ClrScr;
  repeat
    GotoXY ( 1, 1 );
    Write ( 'Quanti giocatori? ' );
    ClrEol;
    Readln ( NumPlayers );
  until ( NumPlayers <= MaxPlayers );
  for i := 1 to NumPlayers do
    begin
      GotoXY ( 1, 2 + i );
      Write ( 'Player', i, ' (Human/Computer)? ' );
      repeat
        Ch := UpCase ( ReadKey );
      until ( Ch = 'H' ) OR ( Ch = 'C' );
      Writeln ( Ch );
      if ( Ch = 'H' ) then
        Players [ i ] := Human
      else
        Players [ i ] := Computer;
    end;
end;

{============================================================================}

procedure BuildTable;
var
  i : Byte;

begin
  for i := 1 to Rows do
    Table [ i ] := i + 2;
end;

{============================================================================}

procedure ShowTable;
var
  i, j : Byte;

begin
  ClrScr;
  for I := 1 to Rows do
    begin
      Write ( I, ': ' );
      for J := 1 to Table [ I ] do
        Write ( ' O' );
      Writeln;
    end;
end;

{============================================================================}

function RigheNonVuote : Byte;
var
  i : Byte;
  NonVuote : Byte;

begin
  NonVuote := 0;
  for i := 1 to Rows do
    if ( Table [ i ] > 0 ) then
      Inc ( NonVuote );
  RigheNonVuote := NonVuote;
end;

{============================================================================}

procedure Human_intelligence;
var
  R, X : Byte;

begin
  repeat
    GotoXY ( 1, 23 );
    Write ( 'Inserisci la riga: ' );
    ClrEol;
    Readln ( R );
  until ( R IN [ 1..Rows ]) AND ( Table [ R ] > 0 );
  repeat
    GotoXY ( 1, 24 );
    Write ( 'Quanti gettoni vuoi togliere dalla riga ', R, '? ' );
    ClrEol;
    Readln ( X );
  until X IN [ 1..Table [ R ]];
  Dec ( Table [ R ], X );
end;

{============================================================================}

procedure Artificial_Intelligence;
var
  MyParity, R : Byte;


  function Parity ( var T : TTable ) : Byte;
  var
    i, P : Byte;

  begin
    P := 0;
    for i := 1 to Rows do
      P := P XOR T [ i ];
    Parity := P;
  end;


  procedure FaiMossa;
  var
    bit, i : Byte;

  begin
    bit := $80;
    while ( ( bit AND MyParity ) <> bit ) do
      bit := bit SHR 1;
    i := Rows;
    while ( i > 0 ) AND ( ( Table [ i ] AND bit ) <> bit ) do
      Dec ( I );
    while NOT ( Parity ( Table ) = 0 ) do
      Dec ( Table [ I ]);
  end;

begin
  MyParity := Parity ( Table );
  if ( MyParity = 0 ) then
    begin
      repeat
        R := Random ( Rows ) + 1;
      until Table [ R ] > 0;
      Dec ( Table [ R ], Random ( Table [ R ]) + 1 );
    end
  else
    FaiMossa;
end;

{============================================================================}

procedure ComputerMove;
begin
  GotoXY ( 1, 21 );
  Write ( 'Player', CurrentPlayer, ' muove (Computer):' );
  ClrEol;
  Delay ( 1000 );
  Artificial_Intelligence;
  ShowTable;
end;

{============================================================================}

procedure HumanMove;
begin
  GotoXY ( 1, 21 );
  Write ( 'Player', CurrentPlayer, ' muove (Human):' );
  ClrEol;
  Human_Intelligence;
  ShowTable;
end;

begin
  GameRules;
  Randomize;
  ReadPlayers;
  BuildTable;
  ShowTable;
  Winner := 0;
  CurrentPlayer := 1;
  while ( Winner = 0 ) do
    begin
      if ( CurrentPlayer > NumPlayers ) then
        CurrentPlayer := 1;
      Player := Players [ CurrentPlayer ];
      if ( Player = Computer ) then
        ComputerMove
      else
        HumanMove;
      if ( RigheNonVuote = 0 ) then
        Winner := CurrentPlayer;
      Inc ( CurrentPlayer );
    end;
  Delay ( 1000 );
  ClrScr;
  if ( Players [ Winner ] = Computer ) then
    Write ( 'Io sono' ) 
  else
    Write ( 'Tu sei' );
  Writeln ( ' il vincitore! (Player', winner, ').' );
  ReadKey;
end.