Tic-tac-toe: Difference between revisions

→‎{{header|Pascal}}: Changed the input loop lest the program accept the move 0 or a move to assigned position. In addition, formatted the code according to JEDI Code Format.
m (syntax highlighting fixup automation)
(→‎{{header|Pascal}}: Changed the input loop lest the program accept the move 0 or a move to assigned position. In addition, formatted the code according to JEDI Code Format.)
Line 9,582:
I would expect this version should compile with most Pascal variants including Delphi, but YMMR.
 
<syntaxhighlight lang="pascal">program ticTic(Input, Output);
 
type
Contents = (Unassigned, Human, Computer);
var
best_iBestI, best_jBestJ: Integerinteger; { best solution a depth of zero in the search }
bB: array[0..2, 0..2] of Contents; {zero based so modulus works later}
playerPlayer: Contents;
 
procedure displayBoardDisplayBoard;
var
iI, jJ: Integerinteger;
tT: array [Contents] of char;
begin
tT[Unassigned] := ' ';
tT[Human] := 'O';
tT[Computer] := 'X';
for iI := 0 to 2 do begin
for j := 0 to 2 do begin
for J := 0 to 2 write(t[b[i][j]]);do
begin
if j <> 2 then write(' | ');
endWrite(T[B[I, J]]);
writeln();if J <> 2 then
if i < 2 then writeln Write('--------- | ');
end;
WriteLn;
if I < 2 then
WriteLn('---------');
end;
writeln()WriteLn;
writeln()WriteLn;
end;
 
function swapPlayer function SwapPlayer(Player: Contents): Contents;
begin
if Player = Computer then swapPlayer := Human else swapPlayer := Computer;
SwapPlayer := Human
end;
else
SwapPlayer := Computer;
end;
 
function checkWinnerCheckWinner: Contents;
var
iI: Integerinteger;
begin
checkWinnerCheckWinner := Unassigned; (*{ no winner yet *)}
for iI := 0 to 2 do begin
begin
(* first horizontal solution *)
{ first horizontal solution }
if ((checkWinner = Unassigned) and (b[i][0] <> Unassigned)) and ((b[i][1] = b[i][0]) and (b[i][2] = b[i][0])) then
if (CheckWinner = Unassigned) and (B[I, 0] <> Unassigned) and
checkWinner := b[i][0]
(B[I, 1] = B[I, 0]) and (B[I, 2] = B[I, 0]) then
else
(*CheckWinner now:= verticalB[I, solution *)0]
else
if ((checkWinner = Unassigned) and (b[0][i] <> Unassigned)) and ((b[1][i] = b[0][i]) and (b[2][i] = b[0][i])) then
{ now vertical solution }
checkWinner := b[0][i];
if (CheckWinner = Unassigned) and (B[0, I] <> Unassigned) and
end; (* now check the paths of the two cross line slants that share the middle position *)
if (checkWinnerB[1, I] = UnassignedB[0, I]) and (bB[1][12, I] <>= UnassignedB[0, I]) then begin
CheckWinner := B[0, I];
if ((b[1][1] = b[0][0]) and (b[2][2] = b[0][0])) then checkWinner := b[0][0]
end;
else if ((b[1][1] = b[2][0]) and (b[0][2] = b[1][1])) then checkWinner := b[1][1];
{ now check the paths of the two cross line slants that share the middle position }
if (CheckWinner = Unassigned) and (B[1, 1] <> Unassigned) then
begin
if (B[1, 1] = B[0, 0]) and (B[2, 2] = B[0, 0]) then
CheckWinner := B[0, 0]
else if (B[1, 1] = B[2, 0]) and (B[0, 2] = B[1, 1]) then
CheckWinner := B[1, 1];
end;
end;
 
{ Basic strategy test - is this te best solution we have seen }
function saveBestSaveBest(CurScore, CurBest: Contents) : boolean;
begin
if CurScore = CurBest then saveBest := false
SaveBest := False
else if (Curscore = Unassigned) and (CurBest = Human) then saveBest := false
else if (CurscoreCurScore = ComputerUnassigned) and ((CurBest = Unassigned) or (CurBest = Human)) then saveBest := false
else saveBest SaveBest := true;False
else if (CurScore = Computer) and ((CurBest = Unassigned) or
end;
(CurBest = Human)) then
SaveBest := False
else
SaveBest := True;
end;
 
 
{ Basic strategy - recursive depth first serachsearch of possible moves
if computer can win save it, otherwise block if need be, else do deeper.
At each level modify the board for the next call, but clean up as go back up,
by remembering the modified position on the call stack. }
function test_move function TestMove(valVal: Contents; depthDepth: Integerinteger): Contents;
var
iI, jJ: Integerinteger;
scoreScore, bestBest, changedChanged: Contents;
begin
bestBest := Computer;
changedChanged := Unassigned;
scoreScore := checkWinner()CheckWinner;
if scoreScore <> Unassigned then begin
begin
if score = val then test_move := Human else test_move := Computer;
if Score = Val then
end else begin
for i := 0 to 2 do for jTestMove := 0 to 2 do beginHuman
else
if b[i][j] = Unassigned then begin
changedTestMove := valComputer;
end
b[i][j] := val; (* the value for now and try wioth the other player *)
else
score := test_move(swapPlayer(val), depth + 1);
begin
if (score <> Unassigned) then score := swapPlayer(score);
for I := 0 b[i][j]to :=2 Unassigned;do
for J if:= saveBest(score,0 best)to then2 begindo
begin
if depth = 0 then begin { top level, so remember actual position }
if B[I, J] = best_i :=Unassigned i;then
best_j := j;begin
Changed := Val;
B[I, J] := Val;
{ the value for now and try wioth the other player }
Score := TestMove(SwapPlayer(Val), Depth + 1);
if Score <> Unassigned then
Score := SwapPlayer(Score);
B[I, J] := Unassigned;
if SaveBest(Score, Best) then
begin
if Depth = 0 then
begin { top level, so remember actual position }
BestI := I;
BestJ := J;
end;
Best := Score;
end;
best := score;
end;
end;
if Changed <> Unassigned then
end;
TestMove := Best
if (changed <> Unassigned) then test_move := best else test_move := Unassigned;
else
TestMove := Unassigned;
end;
end;
 
function playGamePlayGame(whomWhom: Contents): string;
var
iI, jJ, kK, moveMove: Integerinteger;
winWin: Contents;
begin
winWin := Unassigned;
for iI := 0 to 2 do for j := 0 to 2 do b[i][j] := Unassigned;
for J := 0 to 2 do
 
B[I, J] := Unassigned;
writeln('The board positions are numbered as follows:');
writelnWriteLn('1The |board 2positions |are 3numbered as follows:');
writelnWriteLn('---------1 | 2 | 3');
writelnWriteLn('4 | 5 | 6---------');
writelnWriteLn('---------4 | 5 | 6');
writelnWriteLn('7 | 8 | 9---------');
writelnWriteLn('You7 have| O,8 I| have X.9');
WriteLn('You have O, I have X.');
writeln();
WriteLn;
 
kK := 1;
repeat {rather a for loop but can not have two actions or early termination in Pascal}
if Whom = Human then
begin
repeat
Write('Your move: ');
ReadLn(Move);
if (Move < 1) or (Move > 9) then
WriteLn('Opps: enter a number between 1 - 9.');
Dec(Move);
{humans do 1 -9, but the computer wants 0-8 for modulus to work}
I := Move div 3; { convert from range to corridinated of the array }
J := Move mod 3;
if B[I, J] <> Unassigned then
WriteLn('Opps: move ', Move + 1, ' was already done.')
until (Move >= 0) and (Move <= 8) and (B[I, J] = Unassigned);
B[I, J] := Human;
end;
if Whom = Computer then
begin
{ randomize if computer opens, so its not always the same game }
if K = 1 then
begin
if whomBestI := Human then beginRandom(3);
BestJ := repeat beginRandom(3);
write('Your move: ');end
readln(move);else
Win := TestMove(Computer, 0);
if (move < 1) or (move > 9) then writeln('Opps: enter a number between 1 - 9')
B[BestI, BestJ] := Computer;
else move := pred(move); {humans do 1 -9, but the computer wants 0-8 for modulus to work}
WriteLn('My move: ', BestI end* until3 ((move+ >= 0) and (moveBestJ <=+ 8)1);
end;
i := move div 3; { convert from range to corridinated of the array }
j := move mod 3DisplayBoard;
Win := CheckWinner;
if b[i][j] = Unassigned then b[i][j] := Human;
if Win <> Unassigned end;then
if whom = Computer then begin
if Win = Human then
(* randomize if computer opens, so its not always the same game *)
PlayGame if k := 1 then'You beginwin.'
else
best_i := random(3); {Pascal random returns positive integers from 0 to func arg}
best_jPlayGame := random(3)'I win.';
end else
else
win := test_move(Computer, 0);
begin
b[best_i][best_j] := Computer;
writelnInc('MyK); move:{ ',"for" best_iloop *counter 3actions + best_j + 1);}
Whom := endSwapPlayer(Whom);
end;
 
until (Win <> Unassigned) or displayBoard(K > 9);
if Win = Unassigned then
win := checkWinner();
PlayGame := 'A draw.';
if win <> Unassigned then begin
end;
if win = Human then playGame := 'You win.' else playGame := 'I win.';
end else begin
k := succ(k); { "for" loop counter actions }
whom := swapPlayer(whom);
end;
end;
until (win <> Unassigned) or (k > 9);
if win = Unassigned then playGame := 'A draw.';
end;
 
begin
Randomize;
randomize();
playerPlayer := Human;
while (true)True do
begin
writelnWriteLn(playGamePlayGame(playerPlayer));
writeln()WriteLn;
playerPlayer := swapPlayerSwapPlayer(playerPlayer);
end
end.</syntaxhighlight>
 
512

edits