home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.update.uu.se
/
ftp.update.uu.se.2014.03.zip
/
ftp.update.uu.se
/
pub
/
rainbow
/
msdos
/
decus
/
RB104
/
kalah20.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-05-19
|
36KB
|
935 lines
PROGRAM Kalah;
(*
KALAH - a game of African origin. Kalah is a game of logic using pegs
as a tool to battle witts against your opponent. This program
simulates a game of Kalah between one player and a computer. The
computer uses a tree search algorithm to determine the best possible
move for a given board position. The depth of this tree search is
determined by the level of play.
Brian Sietz
Sysop FIDO#82
Cherry Hill, NJ
(609) 429-6630
May 1985
*)
CONST
vers_no = '1.6';
vers_date = '5/09/85';
pi = 3.14159265358979323846;
TYPE
(* various string sizes *)
str8 = PACKED ARRAY [1..8] OF CHAR;
attr_type = (normal,bold,underline,blinking,reverse,graphics,
txt,double_top,double_bottom,wide,col_80,col_132);
attr_set = SET OF attr_type;
(* These are types used by KALAH *)
row_type = (top,bottom);
player_type = (computer,user);
board_type = ARRAY[top..bottom,0..7] OF integer; {the board}
VAR
esc : CHAR; {the ESCape char}
board : board_type; {the board}
compmove : INTEGER; {computer's last move}
level : INTEGER; {level of difficulty}
home_row : ARRAY [computer..user] OF row_type;
opponent : ARRAY [computer..user] OF player_type;
kalah : ARRAY [computer..user] OF integer;
opposite_row : ARRAY [top..bottom] OF row_type;
flashstuff : str8; {"thinking" string}
first_game : BOOLEAN; {skip welcome for next game}
quit_game : BOOLEAN; {User aborted game}
demo : BOOLEAN; {computer plays both sides}
seed : REAL; {random # seed}
user_is_bored : BOOLEAN; {don't wanna play no more...}
PROCEDURE instructions; FORWARD;
FUNCTION random : REAL;
BEGIN seed:=(seed*1101); seed:=seed-TRUNC(seed); random:=seed END;
PROCEDURE delay(n : INTEGER);
(* Delay n seconds *)
var i,j:INTEGER;
BEGIN
FOR i:=1 TO n DO
(*
BEGIN
FOR j:=1 TO 20000 DO;
FOR j:=1 TO 20000 DO;
END;
*)
jsys(167b;1000);
END; {delay}
FUNCTION attr(temp_attr : attr_set) : CHAR;
(*
This function is called from within a WRITE or WRITELN statement
in order to set the current attributes of the NEXT characters
written to the screen. If the position is also specified, it should
appear in the WRITE statement BEFORE a call to ATTR
*)
BEGIN
attr:=CHR(0); {nothing in the function value}
IF normal IN temp_attr THEN WRITE(ESC,'[0m');
IF txt IN temp_attr THEN WRITE(esc,'(B'); {reset graphics mode}
IF col_80 IN temp_attr THEN
BEGIN WRITE(esc,'[?3l'); delay(1); END;
IF col_132 IN temp_attr THEN
BEGIN WRITE(esc,'[?3h'); delay(1); END;
IF double_top IN temp_attr THEN WRITE(esc,'#3');
IF double_bottom IN temp_attr THEN WRITE(esc,'#4');
IF wide IN temp_attr THEN WRITE(esc,'#6');
IF bold IN temp_attr THEN WRITE(ESC,'[1m');
IF underline IN temp_attr THEN WRITE(ESC,'[4m');
IF reverse IN temp_attr THEN WRITE(ESC,'[7m');
IF blinking IN temp_attr THEN WRITE(ESC,'[5m');
IF graphics IN temp_attr THEN WRITE(esc,'(0');
END; {attr}
FUNCTION position(x,y : INTEGER) : CHAR;
(*
From within a WRITE or WRITELN statement, this function call will
move the cursor to the specified position
*)
BEGIN
position:=CHR(0);
WRITE(ESC,'[',x:0,';',y:0,'H');
END; {position}
FUNCTION int_str(n,field : INTEGER; zero : BOOLEAN) : CHAR;
(*
Write the integer value n into the screen at the current position.
FIELD specifies the output width. If the field of the integer is
larger than the field width specified, then the specified field width
specified is ignored, and the integer is printed in its entirety. If
the field of the integer is smaller than the field width specified,
the extra width is padded with spaces, or zeros depending on the ZERO
boolean. The maximum number of digits is limited to eight.
*)
VAR i,j,k,l : INTEGER; num : str8;
BEGIN
int_str:=CHR(0);
IF n=0 THEN j:=0 ELSE j:=TRUNC(LN(n)/LN(10))+1; {# digits in n}
FOR i:=1 TO j DO
BEGIN {make string array of digits of n}
k:=n-((n DIV 10)*10);
num[j-i+1]:=CHR(k+48);
n:=n DIV 10;
END;
i:=j;
WHILE i<field DO
BEGIN {pad the extra field - if any}
IF zero THEN WRITE('0')
ELSE WRITE(' ');
i:=i+1;
END;
FOR i:=1 TO j DO WRITE(num[i]); {output the digits}
END; {int_str}
FUNCTION clear_screen : CHAR;
(* Clears the TTY screen *)
BEGIN
clear_screen:=CHR(0);
WRITE(ESC,'[H',ESC,'[J');
END; {clear_screen}
FUNCTION clear_eoln : CHAR;
(* Clears from cursor to EOLN *)
BEGIN
clear_eoln:=CHR(0);
WRITE(ESC,'[K');
END; {clear_eoln}
FUNCTION getkey : CHAR;
(* Return a single character *)
VAR ch : CHAR; x : REAL;
BEGIN
jsys(100b;0:INPUT);
jsys(73b;;ch);
IF ch IN ['a'..'z'] THEN ch:=CHR(ORD(ch)-32);
(* IF ORD(ch)>=32 THEN write(ch); *)
getkey:=ch;
x:=random; {mix up the random number generator a bit...}
END; {getkey}
PROCEDURE draw_pegs(row : row_type; bin,old_count : INTEGER);
(*
Draw the pegs inside the boxes. The pegs are updated for the specified
Row and Bin. Old_count specifies the previous number of pins in the
specified bin. This is to speed drawing time if many bins need updating.
If Old_count=0, then all pins are redrawn.
*)
VAR i,j,k,l,m,ct : INTEGER; ch : CHAR;
BEGIN
WRITE(attr([bold,graphics]));
IF bin IN [0,7] THEN
CASE row OF
top : BEGIN {computer's kalah}
k:=12; l:=6;
j:=old_count;
WHILE j<board[home_row[computer],kalah[computer]] DO
BEGIN
WRITE(position(k-(j DIV 21),l+(j MOD 21)),'`');
j:=j+1;
END;
WRITE(attr([normal,txt]),position(11,45));
WRITE(int_str(board[top,kalah[computer]],2,TRUE));
END;
bottom: BEGIN {user's kalah}
k:=12; l:=54;
j:=old_count;
WHILE j<board[home_row[user],kalah[user]] DO
BEGIN
WRITE(POSITION(k-(j DIV 21),l+(j MOD 21)),'`');
j:=j+1;
END;
WRITE(attr([normal,txt]),position(12,45));
WRITE(int_str(board[bottom,kalah[user]],2,TRUE));
END;
END
ELSE
BEGIN {a single bin}
l:=(bin-1)*12+6;
IF row=top THEN k:=7 ELSE k:=18;
IF board[row,bin]>27 THEN m:=27 ELSE m:=board[row,bin];
IF board[row,bin]=0 THEN
BEGIN {remove pegs}
ch:=' '; ct:=old_count;
old_count:=0;
WRITE(attr([normal]));
END
ELSE
BEGIN {draw new pegs}
ch:='`'; ct:=board[row,bin]-1;
WRITE(attr([bold,graphics]));
END;
FOR j:=old_count TO ct DO
WRITE(POSITION(k-(j DIV 9),l+(j MOD 9)),ch);
(* the number of pegs *)
WRITE(position(k-3,(bin-1)*12+12),
int_str(board[row,bin],2,TRUE));
END;
WRITE(attr([txt,normal]));
END; {draw_pegs}
PROCEDURE draw_board;
(* Draws, or Redraws the entire screen *)
VAR i,j : INTEGER; row : row_type;
BEGIN
WRITE(clear_screen,position(1,14),attr([normal,graphics]));
(* draw the outside boarder *)
WRITE('lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk');
WRITE(position(2,2),'lqqqqqqqqqqqj');
WRITE(position(2,67),'mqqqqqqqqqqk');
FOR i:=3 TO 19 DO
BEGIN
WRITE(position(i,2),'x');
WRITE(position(i,78),'x');
END;
WRITE(position(20,2),'mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj');
FOR j:=1 TO 7 DO
FOR i:=1 TO 4 DO
BEGIN
WRITE(position(i+3,(j-1)*12+4),'x');
WRITE(position(i+14,(j-1)*12+4),'x');
END;
(* draw the inside boxes *)
WRITE(position(3,4),'lqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqk');
WRITE(position(14,4),'lqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqk');
WRITE(position(8,4),'mqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqj');
WRITE(position(19,4),'mqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqj');
(* draw the kalah's *)
WRITE(position(9,4),'lqqqqqqqqqqqqqqqqqqqqqqqk');
WRITE(position(9,52),'lqqqqqqqqqqqqqqqqqqqqqqqk');
WRITE(position(13,4),'mqqqqqqqqqqqqqqqqqqqqqqqj');
WRITE(position(13,52),'mqqqqqqqqqqqqqqqqqqqqqqqj');
FOR j:=1 TO 4 DO
FOR i:=1 TO 3 DO
WRITE(position(i+9,(j-1)*24+4),'x');
WRITE(position(2,17),attr([txt,normal,bold]),'Kalah Version');
WRITE(position(2,32),vers_no);
WRITE(position(2,44),'Brian Sietz');
WRITE(position(2,57),vers_date);
FOR row:=top TO bottom DO
FOR i:=1 TO 6 DO
BEGIN
(* the bin number *)
IF row=top THEN WRITE(position(4,(i-1)*12+6))
ELSE WRITE(position(15,(i-1)*12+6));
WRITE(attr([txt,normal]),'[');
WRITE(attr([bold]),int_str(i,0,FALSE));
WRITE(attr([normal]),'] = ');
draw_pegs(row,i,0);
END;
draw_pegs(top,0,0);
draw_pegs(bottom,7,0);
WRITE(attr([normal,bold,underline]),position(9,36),' SCORE ');
WRITE(attr([normal]),position(11,34),'Computer: ');
WRITE(position(12,34),'User: ');
IF demo THEN WRITE(position(24,36),attr([bold,blinking,reverse]),
'Demo Mode');
WRITE(attr([txt,normal]));
END; {draw_board}
PROCEDURE MORE;
(* Pauses, and waits for the user to confirm to continue *)
VAR ch : CHAR;
BEGIN
WRITE(position(24,22),attr([bold,blinking]),
'Type a space to continue... ',attr([normal]));
ch:=CHR(0);
WHILE ch<>' ' DO
BEGIN
WRITE(CHR(8),' ',CHR(8));
ch:=getkey;
END;
WRITE(position(24,22),clear_eoln);
END; {more}
PROCEDURE help;
(* short screen for the command list *)
BEGIN
WRITE(clear_screen);
WRITELN(attr([normal,bold,wide]),'The following are the valid commands:');
WRITELN(attr([bold,wide]));
WRITELN(attr([bold,wide]),'1..6 - Move pegs from specified bin');
WRITELN(attr([bold,wide]),'L - Change level of play');
WRITELN(attr([bold,wide]),'R - Redraw the screen');
WRITELN(attr([bold,wide]),'C - Show computer''s hint');
WRITELN(attr([bold,wide]),'D - Demo mode (computer plays both)');
WRITELN(attr([bold,wide]),'Q - Quit this game');
WRITELN(attr([bold,wide]),'I - Show full instructions');
WRITELN(attr([bold,wide]),'? - Very brief help');
WRITELN(attr([bold,wide]),'H - display this message');
more;
draw_board;
END; {help}
PROCEDURE END_game;
(*
When the game is over, this routine places the extra pegs in the correct
players Kalah, displays the score, and prompts to play again
*)
VAR i,j : INTEGER;
BEGIN
WRITE(position(23,1),clear_eoln);
WRITE(position(23,10),attr([wide,bold,blinking]));
WRITE('Ok, that''s it folks!');
IF NOT quit_game THEN
BEGIN
delay(3);
FOR i:=1 TO 6 DO
BEGIN
j:=board[top,i];
IF j<>0 THEN
BEGIN
board[top,kalah[computer]]:=board[top,kalah[computer]]+j;
board[top,i]:=0;
draw_pegs(top,i,j);
draw_pegs(top,kalah[computer],board[top,kalah[computer]]-j);
END;
j:=board[bottom,i];
IF j<>0 THEN
BEGIN
board[bottom,kalah[user]]:=board[bottom,kalah[user]]+j;
board[bottom,i]:=0;
draw_pegs(bottom,i,j);
draw_pegs(bottom,kalah[user],board[bottom,kalah[user]]-j);
END;
END;
delay(3);
WRITE(clear_screen);
IF board[top,kalah[computer]]>board[bottom,kalah[user]] THEN
BEGIN
WRITE(position(1,1),attr([normal]),'You lose with a score of ');
WRITE(int_str(board[bottom,kalah[user]],0,FALSE));
WRITE(' To ');
WRITE(int_str(board[top,kalah[computer]],0,FALSE));
WRITELN('...');
END
ELSE
IF board[top,kalah[computer]]<board[bottom,kalah[user]] THEN
BEGIN
WRITE(position(1,1),attr([bold]),'You win with a score of ');
WRITE(int_str(board[bottom,kalah[user]],0,FALSE));
WRITE(' To ');
WRITE(int_str(board[top,kalah[computer]],0,FALSE));
WRITELN('!!!');
END
ELSE
BEGIN
WRITE(position(1,1),attr([bold]),'The game ends in a tie: ');
WRITE(int_str(board[bottom,kalah[user]],0,FALSE));
WRITE(' To ');
WRITE(int_str(board[top,kalah[computer]],0,FALSE));
WRITELN('!!!');
END
END;
WRITE(position(15,1),attr([bold,blinking]),'Would you care to play again? [Y/N] ');
WRITE(attr([normal]));
IF getkey<>'Y' THEN user_is_bored:=TRUE;
END; {END_game}
FUNCTION move_pegs(player:player_type; bin:INTEGER;
VAR board: board_type;disp:BOOLEAN) : INTEGER;
(*
Distributes the pegs around the board. The value returned is the
bin number of the last peg. This routine also takes into consideration
the captures if any.
*)
VAR
i,n : INTEGER;
row : row_type;
PROCEDURE advance_bin(VAR bin:INTEGER; VAR row:row_type; player:player_type);
(* points to the next bin in the counter-clockwise motion *)
BEGIN
CASE row OF
top : BEGIN
bin:=bin-1;
IF bin<0 THEN BEGIN bin:=1; row:=bottom; END;
END;
bottom : BEGIN
bin:=bin+1;
IF bin>7 THEN BEGIN bin:=6; row:=top; END;
END;
END;
IF ((bin=7) AND (player=computer)) OR ((bin=0) AND (player=user))
THEN advance_bin(bin,row,player);
END; {advance_bin}
BEGIN {move_pegs}
row:=home_row[player];
n:=board[row,bin];
board[row,bin]:=0;
IF disp THEN draw_pegs(row,bin,n);
FOR i:=1 TO n DO
BEGIN
advance_bin(bin,row,player);
board[row,bin]:=board[row,bin]+1;
IF disp THEN
BEGIN
draw_pegs(row,bin,board[row,bin]-1);
END;
END;
move_pegs:=bin;
IF (board[row,bin]=1) AND (row=home_row[player]) AND
(board[opposite_row[row],bin]<>0) AND (bin IN [1..6]) THEN
BEGIN (* CAPTURE! *)
board[row,bin]:=0; {move the capture peg}
IF disp THEN
BEGIN
WRITE(position(23,2),clear_eoln,'Capture!!');
delay(1);
draw_pegs(row,bin,1); {used to have 1 peg}
n:=board[home_row[player],kalah[player]]; {# in Kalah}
board[home_row[player],kalah[player]]:=
board[home_row[player],kalah[player]]+1;
draw_pegs(home_row[player],kalah[player],n);
i:=board[opposite_row[row],bin];
board[home_row[player],kalah[player]]:=
board[home_row[player],kalah[player]]+i;
board[opposite_row[row],bin]:=0; {move them into kalah}
draw_pegs(opposite_row[row],bin,i);
draw_pegs(home_row[player],kalah[player],n);
END
ELSE
BEGIN {just do the calculations to speed time}
board[home_row[player],kalah[player]]:=
board[home_row[player],kalah[player]]+
board[opposite_row[row],bin]+1;
board[opposite_row[row],bin]:=0;
END;
END
ELSE IF disp THEN WRITE(position(23,2),clear_eoln);
END; {move_pegs}
(* some misc functions to make typing easier *)
FUNCTION s1 (board : board_type) : INTEGER;
(* number of pegs on top row *)
BEGIN
s1:=board[top,1]+board[top,2]+board[top,3]+
board[top,4]+board[top,5]+board[top,6];
END;
FUNCTION s2 (board : board_type) : INTEGER;
(* number of pegs on bottom row *)
BEGIN
s2:=board[bottom,1]+board[bottom,2]+board[bottom,3]+
board[bottom,4]+board[bottom,5]+board[bottom,6];
END;
FUNCTION k1 (board : board_type) : INTEGER;
(* number of pegs in computers kalah *)
BEGIN k1:=board[home_row[computer],kalah[computer]]; END;
FUNCTION k2 (board : board_type) : INTEGER;
(* number of pegs in users kalah *)
BEGIN k2:=board[home_row[user],kalah[user]]; END;
FUNCTION game_is_over(board : board_type) : BOOLEAN;
BEGIN
IF s1(board)=0 THEN game_is_over:=TRUE
ELSE IF s2(board)=0 THEN game_is_over:=TRUE
ELSE game_is_over:=FALSE;
END; {game_is_over}
FUNCTION bestmove(player:player_type; depth:INTEGER; VAR bestval : INTEGER;
board:board_type) : INTEGER;
(*
This function returns the position of the best move with the specified
board for a given player. This routine uses a recursive tree search
algorithm checking and evaluating every legal move for itself, and its
opponent.
*)
VAR temp : board_type; i,j,n : INTEGER;
PROCEDURE flash;
(* A silly routine to update the "thinking" string: [* ] *)
VAR i : INTEGER;
BEGIN
WRITE(position(23,36),flashstuff);
i:=1;
REPEAT i:=i+1; UNTIL flashstuff[i]='*'; flashstuff[i]:=' ';
IF i=7 THEN flashstuff[2]:='*' ELSE flashstuff[i+1]:='*';
END;
FUNCTION eval(board : board_type) : INTEGER;
(* evaluate the material gain of the current board position *)
BEGIN
IF NOT game_is_over(board) THEN eval:=k1(board)-k2(board)
ELSE BEGIN
board[top,0]:=board[top,0]+s1(board);
board[bottom,7]:=board[bottom,7]+s2(board);
IF k1(board)>k2(board) THEN
CASE player OF {winning move!}
computer: eval:=998;
user : eval:=-998;
END
ELSE eval:=k1(board)-k2(board);
END;
END;
BEGIN
n:=0;
IF player=computer THEN bestval:=-999 ELSE bestval:=999;
FOR i:=1 TO 6 DO
IF (board[home_row[player],i]<>0) AND NOT game_is_over(board) THEN
BEGIN
IF (level>2) AND (depth=level) THEN flash;
temp:=board;
j:=move_pegs(player,i,temp,FALSE);
IF (j=kalah[player]) AND (depth IN [level-1,level]) AND
NOT game_is_over(temp) THEN
j:=bestmove(player,depth,n,temp)
ELSE
IF (depth=1) OR game_is_over(temp) THEN n:=eval(temp)
ELSE j:=bestmove(opponent[player],depth-1,n,temp);
CASE player OF
computer: IF (n>bestval) OR ((n=bestval) AND (random>0.5))
THEN BEGIN bestval:=n; bestmove:=i; END;
user: IF (n<bestval) OR ((n=bestval) AND (random>0.5))
THEN BEGIN bestval:=n; bestmove:=i; END;
END;
END;
END; {bestmove}
PROCEDURE make_move(player : player_type);
VAR bin,i,j : INTEGER; ch : CHAR; done : BOOLEAN;
PROCEDURE play(player : player_type);
BEGIN
IF player=computer THEN WRITE(position(21,14))
ELSE WRITE(position(22,14));
delay(1);
done:=TRUE; {assume no free move}
Flashstuff := '[* ]';
compmove:=bestmove(player,level,i,board);
WRITE(attr([bold]));
IF player=computer THEN WRITE(position(21,2),'My Move: ')
ELSE WRITE(position(22,2),'My Move: ');
WRITE(CHR(compmove+48));
delay(2);
i:=move_pegs(player,compmove,board,TRUE);
IF (i=kalah[player]) AND
NOT game_is_over(board) THEN
BEGIN
done:=FALSE; {we get a free move!}
WRITE(position(21,19),clear_eoln);
WRITE('Last peg landed in my own kalah');
WRITE(position(22,19),clear_eoln);
WRITE(attr([bold,blinking]));
WRITE('I go again...',attr([normal]));
delay(1);
END;
END;
BEGIN
done:=FALSE;
WRITE(position(21,16),clear_eoln,position(22,16),clear_eoln,
position(23,1) ,clear_eoln,attr([txt,normal]));
WHILE (NOT done) AND (NOT game_is_over(board)) AND NOT quit_game DO
CASE player OF
computer: play(computer);
user : IF demo THEN play(user) ELSE
BEGIN
done:=FALSE;
WRITE(position(22,12),' ');
WRITE(position(22,2),attr([txt,bold,blinking]));
WRITE('Your Move: ',attr([normal]));
ch:=getkey;
CASE ch OF
'?' : BEGIN
WRITE(position(22,19),'Command - one of ');
WRITE('1..6, R, C, I, L, D, Q');
WRITE(', or H for help');
END;
'H' : help;
'C' : BEGIN
Flashstuff := '[* ]';
j:=level;
level:=2;
compmove:=bestmove(user,level,i,board);
WRITE(position(23,2));
WRITE('I would make move ');
WRITE(CHR(compmove+48));
level:=j;
END;
'L' : BEGIN {level change}
WRITE(position(23,2),clear_eoln);
WRITE('Current level = ');
WRITE(CHR(level+48),', New level: ');
ch:=getkey;
IF ch IN ['1'..'4'] THEN
level:=ORD(ch)-ORD('0');
WRITE(position(23,2),'Skill Level = ');
WRITE(CHR(level+48),clear_eoln);
END;
'Q' : BEGIN
WRITE(position(22,12),clear_eoln);
WRITE(position(22,19),'Sure? [Y/N] ');
IF getkey='Y' THEN
BEGIN
WRITE(clear_screen);
quit_game:=TRUE;
END
ELSE WRITE(position(22,19),clear_eoln);
END;
'I' : BEGIN {detailed instructions again}
Instructions;
draw_board;
END;
'R' : draw_board;
'D' : BEGIN
WRITE(position(22,12),clear_eoln);
WRITE(position(22,19),
'Demo mode - Sure? [Y/N] ');
IF getkey='Y' THEN
BEGIN
demo:=TRUE;
WRITE(position(24,36),
attr([bold,blinking,reverse]),
'Demo Mode');
END;
WRITE(position(22,12),clear_eoln,
attr([normal]));
END;
'1','2','3','4','5','6':
IF board[home_row[user],ORD(ch)-48]>0 THEN
BEGIN {legal move}
done:=TRUE; {yes, he made his move}
delay(1);
WRITE(position(21,16),clear_eoln);
bin:=ORD(ch)-48;
i:=move_pegs(user,bin,board,TRUE);
IF (i=kalah[user]) AND
NOT game_is_over(board) THEN
BEGIN
done:=FALSE; {go again...}
WRITE(position(21,19),clear_eoln);
WRITE('Last peg landed in your own kalah');
WRITE(position(22,19),clear_eoln);
WRITE(attr([bold,blinking]),'Go again...');
WRITE(attr([normal]));
END;
END {legal moves}
ELSE
BEGIN {illegal move}
WRITE(attr([bold,blinking]));
WRITE(position(23,2),clear_eoln,' Illegal move...');
END;
END;
END;
END;
END; {make_move}
PROCEDURE init_game;
VAR i,j : INTEGER; ch : CHAR; pegs : INTEGER;
BEGIN
board[home_row[user],kalah[user]]:=0;
board[home_row[computer],kalah[computer]]:=0;
compmove:=0;
quit_game:=FALSE;
IF first_game THEN
BEGIN
WRITE(clear_screen,attr([col_80]));
WRITE(position(1,1),attr([normal,double_top,bold]),
'Welcome to the game of Kalah!');
WRITE(position(2,1),attr([double_bottom,bold]),
'Welcome to the game of Kalah!');
WRITE(position(20,1),attr([bold]));
WRITELN('(c) Brian Sietz, May 1985');
WRITELN(attr([normal]),'FIDO#82 [NJ] [609] 429-6630');
WRITELN('(300/1200 Baud)');
WRITE(position(10,1),attr([wide,blinking,bold]),
'Do you want instructions? [Y/N] ',
attr([normal]));
ch:=getkey;
IF ch='Y' THEN
instructions;
END;
WRITE(clear_screen,attr([normal,bold]),position(3,1),
'How many pegs shall I put in each bin? [3..7] ');
ch:=getkey;
WHILE NOT (ch IN ['0'..'9']) DO
BEGIN
WRITE(CHR(8),' ',CHR(8));
ch:=getkey;
END;
pegs:=ORD(ch)-ORD('0');
IF pegs<3 THEN
BEGIN
WRITE(position(4,1),'That''s not quite enough - I''ll put in 6');
pegs:=6;
END;
IF pegs>7 THEN
BEGIN
WRITE(position(4,1),'That''s a bit too much - I''ll put in 6');
pegs:=6;
END;
FOR i:=1 TO 6 DO
BEGIN board[top,i]:=pegs; board[bottom,i]:=pegs; END;
WRITE(position(7,1),'Choose your level of difficulty [1..4] ');
ch:=getkey;
WHILE NOT (ch IN ['0'..'9']) DO
BEGIN
WRITE(CHR(8),' ',CHR(8));
ch:=getkey;
END;
level:=ORD(ch)-ORD('0');
IF level>4 THEN
BEGIN
WRITE(position(8,1),'Be serious - level 4 is hard enough!' );
WRITE(' - We''ll play at 4...');
level:=4;
END;
IF level<1 THEN
BEGIN
WRITE(position(8,1),'There is nothing lower than 1! ');
WRITE(' - We''ll play at 1...');
level:=1;
END;
WRITE(position(12,1),'Would you care to make the first move ');
WRITE('or play a demo game? [Y/N/D] ');
ch:=getkey;
IF ch='D' THEN demo:=TRUE ELSE demo:=FALSE;
first_game:=FALSE;
draw_board;
IF ch='Y' THEN make_move(user);
END; {init_game}
PROCEDURE init_vars;
BEGIN (* Stuff to do ONCE! *)
REWRITE(OUTPUT,'TTY:',0,0,100000000000B);
REWRITE(INPUT,'TTY:','/I');
home_row[computer]:=top;
home_row[user]:=bottom;
kalah[computer]:=0;
kalah[user]:=7;
opposite_row[top]:=bottom;
opposite_row[bottom]:=top;
opponent[computer]:=user;
opponent[user]:=computer;
esc:=CHR(27);
first_game:=TRUE; user_is_bored:=FALSE;
seed:=pi-3;
END; {init_vars}
PROCEDURE instructions; (* Complete instructions *)
VAR temp_board : board_type; i,j : INTEGER;
BEGIN
WRITE(clear_screen);
WRITELN(position(10,1),attr([txt,normal]));
WRITELN(attr([bold,wide]),' The game of KALAH ');
WRITELN(attr([bold,wide]),' is a game of logic using pegs ');
WRITELN(attr([bold,wide]),' as the means to battle wits ');
WRITELN(attr([bold,wide]),' between you and the computer.');
more;
WRITELN(clear_screen,position(10,1),attr([bold]));
WRITELN(' The game is played on a board with six bins for each player, and');
WRITELN(' a Kalah (a larger bin) to hold your winning pegs. In each turn a');
WRITELN(' player moves by removing all of the pegs from one bin, which are');
WRITELN(' then redistributed counter clockwise around the board, one per');
WRITELN(' bin. Depending on which bin was selected, a user can increase');
WRITELN(' his score, capture some of his opponent''s pegs, or get a free');
WRITELN(' move.');
more;
WRITE(attr([col_132]));
temp_board:=board; {save the current board positions}
{setup a sample board}
board[home_row[user],kalah[user]]:=4;
board[home_row[computer],kalah[computer]]:=2;
board[top,1]:=1; board[bottom,1]:=1;
board[top,2]:=3; board[bottom,2]:=2;
board[top,3]:=4; board[bottom,3]:=0;
board[top,4]:=2; board[bottom,4]:=11;
board[top,5]:=5; board[bottom,5]:=1;
board[top,6]:=0; board[bottom,6]:=0;
draw_board;
WRITE(attr([txt,normal,bold]));
WRITE(position( 2,85),'On the left is a sample of the board in the');
WRITE(position( 3,85),'middle of a random game.');
WRITE(position(10,7),'[Computer''s Kalah]');
WRITE(position(10,58),'[Your Kalah]');
WRITE(position( 5,85),'To make a move, select a bin numbered 1-6.');
WRITE(position( 6,85),'There must be at least one peg in that bin.');
WRITE(position( 7,85),'The computer will automatically remove the');
WRITE(position( 8,85),'pegs from the selected bin, and distribute');
WRITE(position( 9,85),'them for you, placing one in each bin counter');
WRITE(position(10,85),'clockwise around the board, though never in');
WRITE(position(11,85),'your opponent''s Kalah.');
WRITE(position(13,85),'Each time pegs land in your Kalah, your score');
WRITE(position(14,85),'is increased. For example, press the space');
WRITE(position(15,85),'bar to see what would happen if you selected');
WRITE(position(16,85),'bin 4.');
more;
i:=move_pegs(user,4,board,TRUE);
WRITE(attr([bold]));
WRITE(position(18,85),'Notice that all 11 pegs were re-distributed,');
WRITE(position(19,85),'and none were placed in the Computer''s Kalah.');
more;
FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
WRITE(position(2,85),attr([bold]),'A "');
WRITE(attr([underline]),'Free move');
WRITE(attr([normal,bold]),'" is granted whenever the ');
WRITE(attr([underline]),'last',attr([normal,bold]));
WRITE(position(3,85),'peg being distributed lands in your Kalah.');
WRITE(position(4,85),'There is no limit to the number of free moves');
WRITE(position(5,85),'a player can make. For example, press the');
WRITE(position(6,85),'space bar to see what would happen if you');
WRITE(position(7,85),'selected bin 5.');
more;
i:=move_pegs(user,5,board,TRUE);
WRITE(position(21,19),clear_eoln);
WRITE('Last peg landed in your own kalah');
WRITE(position(22,19),clear_eoln);
WRITE(attr([bold,blinking]),'Go again...',attr([normal,bold]));
WRITE(position(9,85),'At this point, you would be prompted to take ');
WRITE(position(10,85),'another turn.');
more;
FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
WRITE(position(21,1),esc,'[J',attr([bold])); {clear_eos}
WRITE(position(2,85),'A "');
WRITE(attr([underline]),'Capture',attr([normal,bold]));
WRITE('" takes place when the ');
WRITE(attr([underline]),'last',attr([normal,bold]),' peg');
WRITE(position(3,85),'lands in one of your own empty bins, and');
WRITE(position(4,85),'there are pegs in the corresponding bin on');
WRITE(position(5,85),'your opponent''s side. The pegs in your');
WRITE(position(6,85),'opponent''s bin are considered captured, and,');
WRITE(position(7,85),'along with the peg used for the capture, are');
WRITE(position(8,85),'moved into your Kalah. For example, press');
WRITE(position(9,85),'the space bar to see what would happen if you');
WRITE(position(10,85),'selected bin 1.');
more;
i:=move_pegs(user,1,board,TRUE);
WRITE(attr([bold]));
WRITE(position(12,85),'Notice that all pegs from bin 3 on ');
WRITE(attr([underline]),'both',attr([normal,bold]),' sides');
WRITE(position(13,85),'were moved into your Kalah.');
more;
FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
WRITE(position(21,1),esc,'[J',attr([bold])); {clear_eos}
WRITE(position(2,85),'The game ends when one player runs out of');
WRITE(position(3,85),'pegs, and cannot make a move. The player who');
WRITE(position(4,85),'has pegs remaining, gets those pegs moved');
WRITE(position(5,85),'into his Kalah.');
WRITE(position(7,85),'Be careful! The winner is the player with');
WRITE(position(8,85),'the most pegs in their Kalah, not necessarily');
WRITE(position(9,85),'the one who finishes first.');
more;
FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
WRITE(attr([bold]),position(2,85),'Helpful strategies:');
WRITE(position(3,85),' o Your best offense is a good defense!');
WRITE(position(4,85),' o Try to limit the number of free moves your');
WRITE(position(5,85),' opponent takes. You can block him by');
WRITE(position(6,85),' moving alot of pegs.');
WRITE(position(7,85),' o Make sure you are free of any captures.');
WRITE(position(8,85),' o Keep your eyes out for free moves.');
WRITE(position(9,85),' o Check to see if you can make a capture.');
WRITE(position(10,85),' Remember, a capture ends your turn so look');
WRITE(position(11,85),' for free moves first!');
more;
WRITE(attr([bold]));
WRITE(position(13,85),'These instructions can be viewed at any time');
WRITE(position(14,85),'after the game starts with the "I" command.');
WRITE(position(16,85),'Good luck! If you are a beginner, may I');
WRITE(position(17,85),'suggest starting off with level 1. ');
WRITE(position(19,85),'Please send your comments to: Brian Sietz');
WRITE(position(20,85),'[609] 429-6630 (300/1200 Baud)');
more;
WRITE(attr([col_80]));
board:=temp_board;
END; {instructions}
BEGIN {main}
init_vars; {do only once!}
REPEAT
init_game;
REPEAT
make_move(computer);
make_move(user);
UNTIL game_is_over(board) OR quit_game;
END_game;
UNTIL user_is_bored;
WRITE(clear_screen,attr([txt,normal]));
END.