{Nicholas Tobey}
{3/10/10 }
{Contest #3 }
{Intermediate }
{Enloe }
{Potter }
Program ACSLSenet;
uses
crt;
type
road =
array[1..33] of integer;
truth =
array[1..4] of boolean;
var
bstart:integer;
wstart:integer;
start:integer;
broll:integer;
wroll:integer;
roll:integer;
board:road;
win:integer;
move:truth;
result:integer;
{0:Cannot Move; 31:Done}
i,j:integer;
function black(board:road;space:integer):boolean;
Begin
black :=
(board[space]=1)or(board[space]=3);
End;
function white(board:road;space:integer):boolean;
Begin
white :=
(board[space]=2)or(board[space]=4);
End;
function empty(board:road;space:integer):boolean;
Begin
empty :=
(board[space]=0);
End;
function legal(board:road;from,space:integer):boolean;
Begin
if space
> 31 then
legal:= false
else
Begin
if empty(board,space) then
legal:= true
else
Begin
if
black(board,from)=black(board,space) then
legal:= false
else
legal:= true;
End;
End;
End;
procedure sset(var board:road;space:integer;color:integer);
Begin
board[space]:= color;
End;
function jump(var board:road;from,sto:integer; var
move:truth):integer; {success}
var
store:integer;
Begin
if ((sto
> 26) and (from < 26)) then sto:= 26;
if not
legal(board,from,sto) then
jump:=
from
else if
empty(board,sto) then
Begin
move[board[from]]:= true;
board[sto]:= board[from];
board[from]:= 0;
jump:= sto;
End
else if
black(board, sto) XOR black(board, from) then
Begin
move[board[from]]:= true;
move[board[sto]] := true;
store := board[sto];
board[sto] := board[from];
board[from]:= store;
jump:= sto;
End
else
jump:=
from;
End;
function input(var board:road;var
bstart,wstart,broll,wroll:integer):integer; {roll}
var
wPawns:integer;
bPawns:integer;
i:integer;
store:integer;
Begin
clrscr;
writeln('Number of Black Pawns?');
readln(bPawns);
writeln('Location of Black Pawn 1?');
readln(bstart);
board[bstart] := 3;
for i:= 2
to bPawns do
Begin
writeln('Location of Black Pawn ', i, '?');
readln(store);
board[store] := 1;
End;
writeln('Number of White Pawns?');
readln(wPawns);
writeln('Location of White Pawn 1?');
readln(wstart);
board[wstart] := 4;
for i:= 2
to wPawns do
Begin
writeln('Location of White Pawn ', i, '?');
readln(store);
board[store] := 2;
End;
writeln('Rod
Count for Black?');
readln(broll);
writeln('Rod Count for White?');
readln(wroll);
End;
function find(board:road; num:integer):integer;
var
i,store:integer;
Begin
store:= 0;
for i:= 1 to 33 do
if
board[i]= num then store:= i;
find:=
store;
End;
procedure fulljump(var board:road; num,roll:integer; var
win:integer; var move:truth);
var
start:integer;
result:integer;
Begin
start:=
find(board,num);
result:=
jump(board,start,start+roll,move);
if (result
= 27) and (result <> start) then
Begin
result:= jump(board,result,15,move);
if result = 0 then result:= 27;
End;
if result =
31 then
Begin
board[32+win]:= board[31];
board[31]:= 0;
win:= win + 1;
End;
End;
procedure display(num:integer; move:truth);
var
hold:integer;
Begin
if not
move[num] then
writeln('CANNOT MOVE')
else
Begin
hold:= find(board, num);
if hold > 31 then
writeln('DONE')
else
writeln(hold);
End;
End;
procedure initialize(var board:road; var move:truth);
var
i:integer;
Begin
for i:= 1
to 33 do
board[i]:= 0;
for i:= 1
to 4 do
move[i]:= false;
End;
Begin
for i:= 1 to 5
do
Begin
initialize(board,move);
win:=
0;
input(board,
bstart, wstart, broll, wroll);
fulljump(board, 3, broll, win, move);
fulljump(board, 4, wroll, win, move);
display(3, move);
display(4, move);
readln;
End;
End.