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 / kalah.pas < prev    next >
Pascal/Delphi Source File  |  1995-05-19  |  36KB  |  926 lines
  1. PROGRAM Kalah;
  2.  
  3. (*
  4. KALAH - a game of African origin.  Kalah is a game of logic using pegs
  5. as a tool to battle witts against your opponent.  This program
  6. simulates a game of Kalah between one player and a computer.  The
  7. computer uses a tree search algorithm to determine the best possible
  8. move for a given board position.  The depth of this tree search is
  9. determined by the level of play.
  10.  
  11.          Brian Sietz
  12.         Sysop FIDO#82
  13.        Cherry Hill, NJ
  14.        (609) 429-6630
  15.            May 1985
  16.  
  17. *)
  18.  
  19. CONST
  20.         vers_no = '1.6';
  21.         vers_date = '5/09/85';
  22.         pi = 3.14159265358979323846;
  23.  
  24. TYPE
  25.         (* various string sizes *)
  26.         str8 = PACKED ARRAY [1..8] OF CHAR;
  27.         attr_type = (normal,bold,underline,blinking,reverse,graphics,
  28.                      txt,double_top,double_bottom,wide,col_80,col_132);
  29.         attr_set = SET OF attr_type;
  30.  
  31. (* These are types used by KALAH *)
  32.  
  33.         row_type    = (top,bottom);
  34.         player_type = (computer,user);
  35.         board_type  = ARRAY[top..bottom,0..7] OF integer;  {the board}
  36.  
  37. VAR
  38.         esc : CHAR;  {the ESCape char}
  39.         board : board_type;             {the board}
  40.         compmove : INTEGER;                {computer's last move}
  41.         level : INTEGER;                   {level of difficulty}
  42.         home_row : ARRAY [computer..user] OF row_type;
  43.         opponent : ARRAY [computer..user] OF player_type;
  44.         kalah : ARRAY [computer..user] OF integer;
  45.         opposite_row : ARRAY [top..bottom] OF row_type;
  46.         flashstuff : str8;              {"thinking" string}
  47.         first_game : BOOLEAN;           {skip welcome for next game}
  48.         quit_game : BOOLEAN;            {User aborted game}
  49.         demo : BOOLEAN;                 {computer plays both sides}
  50.         seed : REAL;                    {random # seed}
  51.         user_is_bored : BOOLEAN;        {don't wanna play no more...}
  52.  
  53. PROCEDURE instructions; FORWARD;
  54.  
  55. PROCEDURE delay(n : INTEGER);
  56. (* Delay n seconds *)
  57. var i,j:INTEGER;
  58. BEGIN
  59.     FOR i:=1 TO n DO
  60.       BEGIN
  61.         FOR j:=1 TO 20000 DO;
  62.         FOR j:=1 TO 20000 DO;
  63.       END;
  64. END; {delay}
  65.  
  66.  
  67. FUNCTION attr(temp_attr : attr_set) : CHAR;
  68. (*
  69. This function is called from within a WRITE or WRITELN statement
  70. in order to set the current attributes of the NEXT characters
  71. written to the screen.  If the position is also specified, it should
  72. appear in the WRITE statement BEFORE a call to ATTR
  73. *)
  74. BEGIN
  75.     attr:=CHR(0);  {nothing in the function value}
  76.     IF normal IN temp_attr THEN WRITE(ESC,'[0m');
  77.     IF txt IN temp_attr THEN WRITE(esc,'(B');  {reset graphics mode}
  78.     IF col_80 IN temp_attr THEN 
  79.         BEGIN WRITE(esc,'[?3l'); delay(1); END;
  80.     IF col_132 IN temp_attr THEN 
  81.         BEGIN WRITE(esc,'[?3h'); delay(1); END;
  82.     IF double_top IN temp_attr THEN WRITE(esc,'#3');
  83.     IF double_bottom IN temp_attr THEN WRITE(esc,'#4');
  84.     IF wide IN temp_attr THEN WRITE(esc,'#6');
  85.     IF bold IN temp_attr THEN WRITE(ESC,'[1m');
  86.     IF underline IN temp_attr THEN WRITE(ESC,'[4m');
  87.     IF reverse IN temp_attr THEN WRITE(ESC,'[7m');
  88.     IF blinking IN temp_attr THEN WRITE(ESC,'[5m');
  89.     IF graphics IN temp_attr THEN WRITE(esc,'(0');
  90. END; {attr}
  91.  
  92.  
  93. FUNCTION  position(x,y : INTEGER) : CHAR;
  94. (*
  95. From within a WRITE or WRITELN statement, this function call will
  96. move the cursor to the specified position
  97. *)
  98. BEGIN
  99.     position:=CHR(0);
  100.     WRITE(ESC,'[',x:0,';',y:0,'H');
  101. END; {position}
  102.  
  103. FUNCTION int_str(n,field : INTEGER; zero : BOOLEAN) : CHAR;
  104. (*
  105. Write the integer value n into the screen at the current position.
  106. FIELD specifies the output width.  If the field of the integer is
  107. larger than the field width specified, then the specified field width
  108. specified is ignored, and the integer is printed in its entirety.  If
  109. the field of the integer is smaller than the field width specified,
  110. the extra width is padded with spaces, or zeros depending on the ZERO
  111. boolean.  The maximum number of digits is limited to eight.
  112. *)
  113. VAR i,j,k,l : INTEGER; num : str8;
  114. BEGIN
  115.     int_str:=CHR(0);
  116.     IF n=0 THEN j:=0 ELSE j:=TRUNC(LN(n)/LN(10))+1;  {# digits in n}
  117.     FOR i:=1 TO j DO
  118.         BEGIN   {make string array of digits of n}
  119.             k:=n-((n DIV 10)*10);
  120.             num[j-i+1]:=CHR(k+48);
  121.             n:=n DIV 10;
  122.         END;
  123.     i:=j;
  124.     WHILE i<field DO
  125.         BEGIN {pad the extra field - if any}
  126.             IF zero THEN WRITE('0')
  127.                 ELSE WRITE(' ');
  128.             i:=i+1;
  129.         END;
  130.     FOR i:=1 TO j DO WRITE(num[i]);  {output the digits}
  131. END; {int_str}
  132.  
  133.  
  134. FUNCTION clear_screen : CHAR;
  135. (* Clears the TTY screen *)
  136. BEGIN
  137.     clear_screen:=CHR(0);
  138.     WRITE(ESC,'[H',ESC,'[J');
  139. END; {clear_screen}
  140.  
  141. FUNCTION clear_eoln : CHAR;
  142. (* Clears from cursor to EOLN *)
  143. BEGIN
  144.     clear_eoln:=CHR(0);
  145.     WRITE(ESC,'[K');
  146. END; {clear_eoln}
  147.  
  148.  
  149. FUNCTION getkey : CHAR;
  150. (* Return a single character *)
  151. VAR ch : CHAR; x : REAL;
  152. BEGIN
  153.     read(kbd,ch);
  154.     IF ch IN ['a'..'z'] THEN ch:=CHR(ORD(ch)-32);
  155.     IF ORD(ch)>=32 THEN write(ch);
  156.     getkey:=ch;
  157.     x:=random;  {mix up the random number generator a bit...}
  158. END; {getkey}
  159.  
  160. PROCEDURE draw_pegs(row : row_type; bin,old_count : INTEGER);
  161. (* 
  162. Draw the pegs inside the boxes.  The pegs are updated for the specified
  163. Row and Bin.  Old_count specifies the previous number of pins in the
  164. specified bin.  This is to speed drawing time if many bins need updating.
  165. If Old_count=0, then all pins are redrawn. 
  166. *)
  167. VAR i,j,k,l,m,ct : INTEGER; ch : CHAR;
  168. BEGIN
  169.     WRITE(attr([bold,graphics]));
  170.     IF bin IN [0,7] THEN
  171.         CASE row OF
  172.             top   : BEGIN {computer's kalah}
  173.                         k:=12;  l:=6;
  174.                         j:=old_count;
  175.                         WHILE j<board[home_row[computer],kalah[computer]] DO
  176.                             BEGIN
  177.                                 WRITE(position(k-(j DIV 21),l+(j MOD 21)),'`');
  178.                                 j:=j+1;
  179.                             END;
  180.                         WRITE(attr([normal,txt]),position(11,45));
  181.                         WRITE(int_str(board[top,kalah[computer]],2,TRUE));
  182.                     END;
  183.             bottom: BEGIN {user's kalah}
  184.                         k:=12;  l:=54;
  185.                         j:=old_count;
  186.                         WHILE j<board[home_row[user],kalah[user]] DO
  187.                             BEGIN
  188.                                 WRITE(POSITION(k-(j DIV 21),l+(j MOD 21)),'`');
  189.                                 j:=j+1;
  190.                             END;
  191.                         WRITE(attr([normal,txt]),position(12,45));
  192.                         WRITE(int_str(board[bottom,kalah[user]],2,TRUE));
  193.                     END;
  194.         END
  195.         ELSE
  196.             BEGIN {a single bin}
  197.                 l:=(bin-1)*12+6;
  198.                 IF row=top THEN k:=7 ELSE k:=18;
  199.                 IF board[row,bin]>27 THEN m:=27 ELSE m:=board[row,bin];
  200.                 IF board[row,bin]=0 THEN
  201.                   BEGIN {remove pegs}
  202.                       ch:=' '; ct:=old_count;
  203.                       old_count:=0;
  204.                       WRITE(attr([normal]));
  205.                   END
  206.                 ELSE
  207.                   BEGIN {draw new pegs}
  208.                       ch:='`'; ct:=board[row,bin]-1;
  209.                       WRITE(attr([bold,graphics]));
  210.                   END;
  211.                 FOR j:=old_count TO ct DO
  212.                     WRITE(POSITION(k-(j DIV 9),l+(j MOD 9)),ch);
  213.                 (* the number of pegs *)
  214.                 WRITE(position(k-3,(bin-1)*12+12),
  215.                       int_str(board[row,bin],2,TRUE));
  216.             END;
  217.         WRITE(attr([txt,normal]));
  218. END; {draw_pegs}
  219.  
  220. PROCEDURE draw_board;
  221. (* Draws, or Redraws the entire screen *)
  222. VAR i,j : INTEGER; row : row_type;
  223. BEGIN
  224.     WRITE(clear_screen,position(1,14),attr([normal,graphics]));
  225.     (* draw the outside boarder *)
  226.     WRITE('lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk');
  227.     WRITE(position(2,2),'lqqqqqqqqqqqj');
  228.     WRITE(position(2,67),'mqqqqqqqqqqk');
  229.     FOR i:=3 TO 19 DO
  230.         BEGIN
  231.             WRITE(position(i,2),'x');
  232.             WRITE(position(i,78),'x');
  233.         END;
  234.     WRITE(position(20,2),'mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj');
  235.     FOR j:=1 TO 7 DO
  236.         FOR i:=1 TO 4 DO
  237.             BEGIN
  238.                 WRITE(position(i+3,(j-1)*12+4),'x');
  239.                 WRITE(position(i+14,(j-1)*12+4),'x');
  240.             END;
  241.     (* draw the inside boxes *)
  242.     WRITE(position(3,4),'lqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqk');
  243.     WRITE(position(14,4),'lqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqwqqqqqqqqqqqk');
  244.     WRITE(position(8,4),'mqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqj');
  245.     WRITE(position(19,4),'mqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqvqqqqqqqqqqqj');
  246.      (* draw the kalah's *)
  247.      WRITE(position(9,4),'lqqqqqqqqqqqqqqqqqqqqqqqk');
  248.      WRITE(position(9,52),'lqqqqqqqqqqqqqqqqqqqqqqqk');
  249.      WRITE(position(13,4),'mqqqqqqqqqqqqqqqqqqqqqqqj');
  250.      WRITE(position(13,52),'mqqqqqqqqqqqqqqqqqqqqqqqj');
  251.      FOR j:=1 TO 4 DO
  252.          FOR i:=1 TO 3 DO
  253.              WRITE(position(i+9,(j-1)*24+4),'x');
  254.      WRITE(position(2,17),attr([txt,normal,bold]),'Kalah Version');
  255.      WRITE(position(2,32),vers_no);
  256.      WRITE(position(2,44),'Brian Sietz');
  257.      WRITE(position(2,57),vers_date);
  258.      FOR row:=top TO bottom DO
  259.          FOR i:=1 TO 6 DO
  260.              BEGIN
  261.                  (* the bin number *)
  262.                  IF row=top THEN WRITE(position(4,(i-1)*12+6))
  263.                      ELSE WRITE(position(15,(i-1)*12+6));
  264.                  WRITE(attr([txt,normal]),'[');
  265.                  WRITE(attr([bold]),int_str(i,0,FALSE));
  266.                  WRITE(attr([normal]),'] = ');
  267.                  draw_pegs(row,i,0);
  268.              END;
  269.      draw_pegs(top,0,0);
  270.      draw_pegs(bottom,7,0);
  271.      WRITE(attr([normal,bold,underline]),position(9,36),'  SCORE  ');
  272.      WRITE(attr([normal]),position(11,34),'Computer: ');
  273.      WRITE(position(12,34),'User:     ');
  274.      IF demo THEN WRITE(position(24,36),attr([bold,blinking,reverse]),
  275.                         'Demo Mode');
  276.      WRITE(attr([txt,normal]));
  277. END; {draw_board}
  278.  
  279. PROCEDURE MORE;
  280. (* Pauses, and waits for the user to confirm to continue *)
  281. VAR ch : CHAR;
  282. BEGIN
  283.     WRITE(position(24,22),attr([bold,blinking]),
  284.           'Type a space to continue... ',attr([normal]));
  285.     ch:=CHR(0);
  286.     WHILE ch<>' ' DO
  287.       BEGIN
  288.         WRITE(CHR(8),' ',CHR(8));
  289.         ch:=getkey;
  290.       END;
  291.     WRITE(position(24,22),clear_eoln);
  292. END; {more}
  293.  
  294.  
  295.  
  296. PROCEDURE help;
  297. (* short screen for the command list *)
  298. BEGIN
  299.     WRITE(clear_screen);
  300.     WRITELN(attr([normal,bold,wide]),'The following are the valid commands:');
  301.     WRITELN(attr([bold,wide]));
  302.     WRITELN(attr([bold,wide]),'1..6 - Move pegs from specified bin');
  303.     WRITELN(attr([bold,wide]),'L    - Change level of play');
  304.     WRITELN(attr([bold,wide]),'R    - Redraw the screen');
  305.     WRITELN(attr([bold,wide]),'C    - Show computer''s hint');
  306.     WRITELN(attr([bold,wide]),'D    - Demo mode (computer plays both)');
  307.     WRITELN(attr([bold,wide]),'Q    - Quit this game');
  308.     WRITELN(attr([bold,wide]),'I    - Show full instructions');
  309.     WRITELN(attr([bold,wide]),'?    - Very brief help');
  310.     WRITELN(attr([bold,wide]),'H    - display this message');
  311.     more;
  312.     draw_board;
  313. END; {help}
  314.  
  315. PROCEDURE END_game;
  316. (* 
  317. When the game is over, this routine places the extra pegs in the correct
  318. players Kalah, displays the score, and prompts to play again
  319. *)
  320. VAR i,j : INTEGER;
  321. BEGIN
  322.   WRITE(position(23,1),clear_eoln);
  323.   WRITE(position(23,10),attr([wide,bold,blinking]));
  324.   WRITE('Ok, that''s it folks!');
  325.   IF NOT quit_game THEN
  326.     BEGIN
  327.       delay(3);
  328.       FOR i:=1 TO 6 DO
  329.         BEGIN
  330.           j:=board[top,i];
  331.           IF j<>0 THEN
  332.               BEGIN
  333.                   board[top,kalah[computer]]:=board[top,kalah[computer]]+j;
  334.                   board[top,i]:=0;
  335.                   draw_pegs(top,i,j);
  336.                   draw_pegs(top,kalah[computer],board[top,kalah[computer]]-j);
  337.               END;
  338.           j:=board[bottom,i];
  339.           IF j<>0 THEN
  340.               BEGIN
  341.                   board[bottom,kalah[user]]:=board[bottom,kalah[user]]+j;
  342.                   board[bottom,i]:=0;
  343.                   draw_pegs(bottom,i,j);
  344.                   draw_pegs(bottom,kalah[user],board[bottom,kalah[user]]-j);
  345.               END;
  346.         END;
  347.       delay(3);
  348.       WRITE(clear_screen);
  349.       IF board[top,kalah[computer]]>board[bottom,kalah[user]] THEN
  350.           BEGIN
  351.               WRITE(position(1,1),attr([normal]),'You lose with a score of ');
  352.               WRITE(int_str(board[bottom,kalah[user]],0,FALSE));
  353.               WRITE(' To ');
  354.               WRITE(int_str(board[top,kalah[computer]],0,FALSE));
  355.               WRITELN('...');
  356.           END
  357.       ELSE
  358.           IF board[top,kalah[computer]]<board[bottom,kalah[user]] THEN
  359.               BEGIN
  360.                   WRITE(position(1,1),attr([bold]),'You win with a score of ');
  361.                   WRITE(int_str(board[bottom,kalah[user]],0,FALSE));
  362.                   WRITE(' To ');
  363.                   WRITE(int_str(board[top,kalah[computer]],0,FALSE));
  364.                   WRITELN('!!!');
  365.               END
  366.           ELSE 
  367.               BEGIN
  368.                   WRITE(position(1,1),attr([bold]),'The game ends in a tie: ');
  369.                   WRITE(int_str(board[bottom,kalah[user]],0,FALSE));
  370.                   WRITE(' To ');
  371.                   WRITE(int_str(board[top,kalah[computer]],0,FALSE));
  372.                   WRITELN('!!!');
  373.               END
  374.     END;
  375.   WRITE(position(15,1),attr([bold,blinking]),'Would you care to play again? [Y/N] ');
  376.   WRITE(attr([normal]));
  377.   IF getkey<>'Y' THEN user_is_bored:=TRUE;
  378. END; {END_game}
  379.  
  380. FUNCTION move_pegs(player:player_type; bin:INTEGER;
  381.                    VAR board: board_type;disp:BOOLEAN) : INTEGER;
  382. (*
  383. Distributes the pegs around the board.  The value returned is the
  384. bin number of the last peg.  This routine also takes into consideration
  385. the captures if any.
  386. *)
  387. VAR
  388.         i,n : INTEGER;
  389.         row : row_type;
  390.  
  391.  
  392.   PROCEDURE advance_bin(VAR bin:INTEGER; VAR row:row_type; player:player_type);
  393.   (* points to the next bin in the counter-clockwise motion *)
  394.       BEGIN
  395.           CASE row OF
  396.               top    : BEGIN
  397.                            bin:=bin-1;
  398.                            IF bin<0 THEN BEGIN bin:=1; row:=bottom; END;
  399.                        END;
  400.               bottom : BEGIN
  401.                            bin:=bin+1;
  402.                            IF bin>7 THEN BEGIN bin:=6; row:=top; END;
  403.                        END;
  404.           END;
  405.           IF ((bin=7) AND (player=computer)) OR ((bin=0) AND (player=user))
  406.               THEN advance_bin(bin,row,player);
  407.       END; {advance_bin}
  408.   
  409.  
  410. BEGIN {move_pegs}
  411.     row:=home_row[player];
  412.     n:=board[row,bin];
  413.     board[row,bin]:=0;
  414.     IF disp THEN draw_pegs(row,bin,n);
  415.     FOR i:=1 TO n DO
  416.         BEGIN
  417.             advance_bin(bin,row,player);
  418.             board[row,bin]:=board[row,bin]+1;
  419.             IF disp THEN
  420.               BEGIN
  421.                 draw_pegs(row,bin,board[row,bin]-1);
  422.               END;
  423.         END;
  424.     move_pegs:=bin;
  425.     IF (board[row,bin]=1) AND (row=home_row[player]) AND
  426.         (board[opposite_row[row],bin]<>0) AND (bin IN [1..6]) THEN
  427.          BEGIN      (*  CAPTURE!  *)
  428.              board[row,bin]:=0;  {move the capture peg}
  429.              IF disp THEN
  430.                  BEGIN
  431.                      WRITE(position(23,2),clear_eoln,'Capture!!');
  432.                      delay(1);
  433.                      draw_pegs(row,bin,1); {used to have 1 peg}
  434.                      n:=board[home_row[player],kalah[player]]; {# in Kalah}
  435.                      board[home_row[player],kalah[player]]:=
  436.                        board[home_row[player],kalah[player]]+1;
  437.                      draw_pegs(home_row[player],kalah[player],n);
  438.                      i:=board[opposite_row[row],bin];
  439.                      board[home_row[player],kalah[player]]:=
  440.                        board[home_row[player],kalah[player]]+i;
  441.                      board[opposite_row[row],bin]:=0;  {move them into kalah}
  442.                      draw_pegs(opposite_row[row],bin,i);
  443.                      draw_pegs(home_row[player],kalah[player],n);
  444.                  END
  445.              ELSE
  446.                  BEGIN {just do the calculations to speed time}
  447.                      board[home_row[player],kalah[player]]:=
  448.                        board[home_row[player],kalah[player]]+
  449.                        board[opposite_row[row],bin]+1;
  450.                      board[opposite_row[row],bin]:=0;
  451.                  END;
  452.          END
  453.      ELSE IF disp THEN WRITE(position(23,2),clear_eoln);
  454. END; {move_pegs}
  455.  
  456. (* some misc functions to make typing easier *)
  457.  
  458. FUNCTION s1 (board : board_type) : INTEGER;
  459. (* number of pegs on top row *)
  460. BEGIN
  461.     s1:=board[top,1]+board[top,2]+board[top,3]+
  462.     board[top,4]+board[top,5]+board[top,6];
  463. END;
  464.  
  465.  
  466.  
  467. FUNCTION s2 (board : board_type) : INTEGER;
  468. (* number of pegs on bottom row *)
  469. BEGIN
  470.     s2:=board[bottom,1]+board[bottom,2]+board[bottom,3]+
  471.     board[bottom,4]+board[bottom,5]+board[bottom,6];
  472. END;
  473.  
  474.  
  475.  
  476. FUNCTION k1 (board : board_type) : INTEGER;
  477. (* number of pegs in computers kalah *)
  478.     BEGIN k1:=board[home_row[computer],kalah[computer]];  END;
  479.  
  480.  
  481.  
  482. FUNCTION k2 (board : board_type) : INTEGER;
  483. (* number of pegs in users kalah *)
  484.     BEGIN k2:=board[home_row[user],kalah[user]];          END;
  485.  
  486.  
  487.  
  488. FUNCTION game_is_over(board : board_type) : BOOLEAN;
  489. BEGIN
  490.     IF s1(board)=0 THEN game_is_over:=TRUE
  491.         ELSE IF s2(board)=0 THEN game_is_over:=TRUE
  492.             ELSE game_is_over:=FALSE;
  493. END; {game_is_over}
  494.  
  495. FUNCTION bestmove(player:player_type; depth:INTEGER; VAR bestval : INTEGER;
  496.                   board:board_type) : INTEGER;
  497. (*
  498. This function returns the position of the best move with the specified
  499. board for a given player.  This routine uses a recursive tree search
  500. algorithm checking and evaluating every legal move for itself, and its
  501. opponent.
  502. *)
  503. VAR temp : board_type;  i,j,n : INTEGER;
  504.  
  505.     PROCEDURE flash;
  506.     (* A silly routine to update the "thinking" string:  [*      ]   *)
  507.         VAR i : INTEGER;
  508.         BEGIN
  509.             WRITE(position(23,36),flashstuff);
  510.             i:=1;
  511.             REPEAT  i:=i+1;  UNTIL flashstuff[i]='*';  flashstuff[i]:=' ';
  512.             IF i=7 THEN flashstuff[2]:='*'  ELSE flashstuff[i+1]:='*';
  513.         END;
  514.  
  515.  
  516.  
  517.     FUNCTION eval(board : board_type) : INTEGER;
  518.     (* evaluate the material gain of the current board position *)
  519.         BEGIN
  520.             IF NOT game_is_over(board) THEN eval:=k1(board)-k2(board)
  521.                 ELSE BEGIN
  522.                          board[top,0]:=board[top,0]+s1(board);
  523.                          board[bottom,7]:=board[bottom,7]+s2(board);
  524.                          IF k1(board)>k2(board) THEN
  525.                              CASE player OF  {winning move!}
  526.                                  computer: eval:=998;
  527.                                  user    : eval:=-998;
  528.                              END
  529.                          ELSE eval:=k1(board)-k2(board);
  530.                      END;
  531.         END;
  532.  
  533. BEGIN
  534.     n:=0;
  535.     IF player=computer THEN bestval:=-999 ELSE bestval:=999;
  536.     FOR i:=1 TO 6 DO
  537.         IF (board[home_row[player],i]<>0) AND NOT game_is_over(board) THEN 
  538.             BEGIN
  539.                 IF (level>2) AND (depth=level) THEN flash;
  540.                 temp:=board;
  541.                 j:=move_pegs(player,i,temp,FALSE);
  542.                 IF (j=kalah[player]) AND (depth IN [level-1,level]) AND
  543.                     NOT game_is_over(temp) THEN
  544.                         j:=bestmove(player,depth,n,temp)
  545.                     ELSE
  546.                         IF (depth=1) OR game_is_over(temp) THEN n:=eval(temp)
  547.                             ELSE j:=bestmove(opponent[player],depth-1,n,temp);
  548.                 CASE player OF
  549.                     computer:  IF (n>bestval) OR ((n=bestval) AND (random>0.5))
  550.                         THEN  BEGIN bestval:=n; bestmove:=i; END;
  551.                     user:      IF (n<bestval) OR ((n=bestval) AND (random>0.5))
  552.                         THEN  BEGIN bestval:=n; bestmove:=i; END;
  553.                 END;
  554.             END;
  555. END; {bestmove}
  556.  
  557. PROCEDURE make_move(player : player_type);
  558. VAR bin,i,j : INTEGER; ch : CHAR;  done : BOOLEAN;
  559.  
  560.     PROCEDURE play(player : player_type);
  561.     BEGIN
  562.         IF player=computer THEN WRITE(position(21,14))
  563.             ELSE WRITE(position(22,14));
  564.         delay(1);
  565.         done:=TRUE;  {assume no free move}
  566.         Flashstuff := '[*     ]';
  567.         compmove:=bestmove(player,level,i,board);
  568.         WRITE(attr([bold]));
  569.         IF player=computer THEN WRITE(position(21,2),'My Move:    ')
  570.             ELSE WRITE(position(22,2),'My Move:    ');
  571.         WRITE(CHR(compmove+48));
  572.         delay(2);
  573.         i:=move_pegs(player,compmove,board,TRUE);
  574.         IF (i=kalah[player]) AND
  575.             NOT game_is_over(board) THEN
  576.                 BEGIN
  577.                     done:=FALSE;  {we get a free move!}
  578.                     WRITE(position(21,19),clear_eoln);
  579.                     WRITE('Last peg landed in my own kalah');
  580.                     WRITE(position(22,19),clear_eoln);
  581.                     WRITE(attr([bold,blinking]));
  582.                     WRITE('I go again...',attr([normal]));
  583.                     delay(1);
  584.                 END;
  585.         END;
  586.         
  587. BEGIN
  588.     done:=FALSE;
  589.     WRITE(position(21,16),clear_eoln,position(22,16),clear_eoln,
  590.           position(23,1) ,clear_eoln,attr([txt,normal]));
  591.     WHILE (NOT done) AND (NOT game_is_over(board)) AND NOT quit_game DO
  592.         CASE player OF
  593.             computer: play(computer);
  594.             user    : IF demo THEN play(user) ELSE
  595.                     BEGIN
  596.                         done:=FALSE;
  597.                         WRITE(position(22,12),'     ');
  598.                         WRITE(position(22,2),attr([txt,bold,blinking]));
  599.                         WRITE('Your Move:  ',attr([normal]));
  600.                         ch:=getkey;
  601.                         CASE ch OF
  602.                           '?' : BEGIN
  603.                                    WRITE(position(22,19),'Command - one of ');
  604.                                    WRITE('1..6, R, C, I, L, D, Q');
  605.                                    WRITE(', or H for help');
  606.                                 END;
  607.                           'H' : help;
  608.                           'C' : BEGIN
  609.                                     Flashstuff := '[*     ]';
  610.                                     j:=level;
  611.                                     level:=2;
  612.                                     compmove:=bestmove(user,level,i,board);
  613.                                     WRITE(position(23,2));
  614.                                     WRITE('I would make move ');
  615.                                     WRITE(CHR(compmove+48));
  616.                                     level:=j;
  617.                                 END;
  618.                           'L' : BEGIN {level change}
  619.                                     WRITE(position(23,2),clear_eoln);
  620.                                     WRITE('Current level = ');
  621.                                     WRITE(CHR(level+48),', New level: ');
  622.                                     ch:=getkey;
  623.                                     IF ch IN ['1'..'4'] THEN 
  624.                                         level:=ORD(ch)-ORD('0');
  625.                                     WRITE(position(23,2),'Skill Level = ');
  626.                                     WRITE(CHR(level+48),clear_eoln);
  627.                                 END;
  628.                           'Q' : BEGIN
  629.                                     WRITE(position(22,12),clear_eoln);
  630.                                     WRITE(position(22,19),'Sure? [Y/N] ');
  631.                                     IF getkey='Y' THEN
  632.                                         BEGIN
  633.                                             WRITE(clear_screen);
  634.                                             quit_game:=TRUE;
  635.                                         END
  636.                                     ELSE WRITE(position(22,19),clear_eoln);
  637.  
  638.                                 END;
  639.                           'I' : BEGIN {detailed instructions again}
  640.                                     Instructions;
  641.                                     draw_board;
  642.                                 END;
  643.                           'R' : draw_board;
  644.                           'D' : BEGIN
  645.                                     WRITE(position(22,12),clear_eoln);
  646.                                     WRITE(position(22,19),
  647.                                           'Demo mode - Sure? [Y/N] ');
  648.                                     IF getkey='Y' THEN
  649.                                         BEGIN
  650.                                            demo:=TRUE;
  651.                                            WRITE(position(24,36),
  652.                                                  attr([bold,blinking,reverse]),
  653.                                                  'Demo Mode');
  654.                                         END;
  655.                                     WRITE(position(22,12),clear_eoln,
  656.                                           attr([normal]));
  657.                                 END;
  658.                           '1','2','3','4','5','6':
  659.                           IF board[home_row[user],ORD(ch)-48]>0 THEN
  660.                           BEGIN {legal move}
  661.                             done:=TRUE;  {yes, he made his move}
  662.                             delay(1);
  663.                             WRITE(position(21,16),clear_eoln);
  664.                             bin:=ORD(ch)-48;
  665.                             i:=move_pegs(user,bin,board,TRUE);
  666.                             IF (i=kalah[user]) AND
  667.                               NOT game_is_over(board) THEN
  668.                                 BEGIN
  669.                                   done:=FALSE; {go again...}
  670.                                   WRITE(position(21,19),clear_eoln);
  671.                                   WRITE('Last peg landed in your own kalah');
  672.                                   WRITE(position(22,19),clear_eoln);
  673.                                   WRITE(attr([bold,blinking]),'Go again...');
  674.                                   WRITE(attr([normal]));
  675.                                 END;
  676.                           END {legal moves}
  677.                         ELSE
  678.                           BEGIN {illegal move}
  679.                               WRITE(attr([bold,blinking]));
  680.                               WRITE(position(23,2),clear_eoln,'  Illegal move...');
  681.                           END;
  682.                         END;
  683.                       END;
  684.         END;
  685. END; {make_move}
  686.  
  687. PROCEDURE init_game;
  688. VAR i,j : INTEGER; ch : CHAR;  pegs : INTEGER;
  689.  
  690. BEGIN
  691.     board[home_row[user],kalah[user]]:=0;
  692.     board[home_row[computer],kalah[computer]]:=0;
  693.     compmove:=0;
  694.     quit_game:=FALSE;
  695.     IF first_game THEN
  696.         BEGIN
  697.             WRITE(clear_screen,attr([col_80]));
  698.             WRITE(position(1,1),attr([normal,double_top,bold]),
  699.                   'Welcome to the game of Kalah!');
  700.             WRITE(position(2,1),attr([double_bottom,bold]),
  701.                   'Welcome to the game of Kalah!');
  702.             WRITE(position(20,1),attr([bold]));
  703.             WRITELN('(c) Brian Sietz, May 1985');
  704.             WRITELN(attr([normal]),'FIDO#82 [NJ] [609] 429-6630');
  705.             WRITELN('(300/1200 Baud)');        
  706.             WRITE(position(10,1),attr([wide,blinking,bold]),
  707.                   'Do you want instructions? [Y/N] ',
  708.                   attr([normal]));
  709.             ch:=getkey;
  710.             IF ch='Y' THEN
  711.                 instructions;
  712.         END;
  713.     WRITE(clear_screen,attr([normal,bold]),position(3,1),
  714.           'How many pegs shall I put in each bin? [3..7] ');
  715.     ch:=getkey;
  716.     WHILE NOT (ch IN ['0'..'9']) DO 
  717.         BEGIN
  718.             WRITE(CHR(8),' ',CHR(8));
  719.             ch:=getkey;
  720.         END;
  721.     pegs:=ORD(ch)-ORD('0');
  722.     IF pegs<3 THEN
  723.         BEGIN
  724.             WRITE(position(4,1),'That''s not quite enough - I''ll put in 6');
  725.             pegs:=6;
  726.         END;
  727.     IF pegs>7 THEN
  728.         BEGIN
  729.             WRITE(position(4,1),'That''s a bit too much - I''ll put in 6');
  730.             pegs:=6;
  731.         END;
  732.     FOR i:=1 TO 6 DO
  733.         BEGIN board[top,i]:=pegs; board[bottom,i]:=pegs; END;
  734.     WRITE(position(7,1),'Choose your level of difficulty [1..4] ');
  735.     ch:=getkey;
  736.     WHILE NOT (ch IN ['0'..'9']) DO 
  737.         BEGIN
  738.             WRITE(CHR(8),' ',CHR(8));
  739.             ch:=getkey;
  740.         END;
  741.     level:=ORD(ch)-ORD('0');
  742.     IF level>4 THEN
  743.         BEGIN
  744.             WRITE(position(8,1),'Be serious - level 4 is hard enough!' );
  745.             WRITE(' - We''ll play at 4...');
  746.             level:=4;
  747.         END;
  748.     IF level<1 THEN
  749.         BEGIN
  750.             WRITE(position(8,1),'There is nothing lower than 1! ');
  751.             WRITE(' - We''ll play at 1...');
  752.             level:=1;
  753.         END;
  754.     WRITE(position(12,1),'Would you care to make the first move ');
  755.     WRITE('or play a demo game? [Y/N/D] ');
  756.     ch:=getkey;
  757.     IF ch='D' THEN demo:=TRUE ELSE demo:=FALSE;
  758.     first_game:=FALSE;
  759.     draw_board;
  760.     IF ch='Y' THEN make_move(user);
  761. END; {init_game}
  762.  
  763.  
  764.  
  765.  
  766. PROCEDURE init_vars;
  767. BEGIN  (* Stuff to do ONCE! *)
  768.     home_row[computer]:=top;
  769.     home_row[user]:=bottom;
  770.     kalah[computer]:=0;
  771.     kalah[user]:=7;
  772.     opposite_row[top]:=bottom;
  773.     opposite_row[bottom]:=top;
  774.     opponent[computer]:=user;
  775.     opponent[user]:=computer;
  776.     esc:=CHR(27);
  777.     first_game:=TRUE;  user_is_bored:=FALSE;
  778.     seed:=pi-3;
  779. END; {init_vars}
  780.  
  781. PROCEDURE instructions;    (* Complete instructions *)
  782. VAR temp_board : board_type;  i,j : INTEGER;
  783. BEGIN
  784.   WRITE(clear_screen);
  785.   WRITELN(position(10,1),attr([txt,normal]));
  786.   WRITELN(attr([bold,wide]),'         The game of KALAH        ');
  787.   WRITELN(attr([bold,wide]),'   is a game of logic using pegs  ');
  788.   WRITELN(attr([bold,wide]),'   as the means  to  battle  wits ');
  789.   WRITELN(attr([bold,wide]),'  between  you  and  the computer.');
  790.   more;
  791.   WRITELN(clear_screen,position(10,1),attr([bold]));
  792.   WRITELN('    The game is played on a board with six bins for each player,  and');
  793.   WRITELN('    a Kalah (a larger bin) to hold your winning pegs.  In each turn a');
  794.   WRITELN('    player moves by removing all of the pegs from one bin, which  are');
  795.   WRITELN('    then redistributed  counter clockwise around the  board, one  per');
  796.   WRITELN('    bin.  Depending on which  bin was selected,  a user can  increase');
  797.   WRITELN('    his score, capture  some of his  opponent''s pegs, or  get a  free');
  798.   WRITELN('    move.');
  799.   more;
  800.   WRITE(attr([col_132]));
  801.   temp_board:=board;  {save the current board positions}
  802.   {setup a sample board}
  803.   board[home_row[user],kalah[user]]:=4;
  804.   board[home_row[computer],kalah[computer]]:=2;
  805.   board[top,1]:=1;  board[bottom,1]:=1;
  806.   board[top,2]:=3;  board[bottom,2]:=2;
  807.   board[top,3]:=4;  board[bottom,3]:=0;
  808.   board[top,4]:=2;  board[bottom,4]:=11;
  809.   board[top,5]:=5;  board[bottom,5]:=1;
  810.   board[top,6]:=0;  board[bottom,6]:=0;
  811.   draw_board;
  812.   WRITE(attr([txt,normal,bold]));
  813.   WRITE(position( 2,85),'On the left is a  sample of the board in  the');
  814.   WRITE(position( 3,85),'middle of a random game.');
  815.  
  816.   WRITE(position(10,7),'[Computer''s Kalah]');
  817.   WRITE(position(10,58),'[Your Kalah]');
  818.  
  819.   WRITE(position( 5,85),'To make a  move, select a  bin numbered  1-6.');
  820.   WRITE(position( 6,85),'There must be at least  one peg in that  bin.');
  821.   WRITE(position( 7,85),'The computer  will automatically  remove  the');
  822.   WRITE(position( 8,85),'pegs from  the selected  bin, and  distribute');
  823.   WRITE(position( 9,85),'them for you, placing one in each bin counter');
  824.   WRITE(position(10,85),'clockwise around  the  board, though never in');
  825.   WRITE(position(11,85),'your opponent''s Kalah.');
  826.  
  827.   WRITE(position(13,85),'Each time pegs land in your Kalah, your score');
  828.   WRITE(position(14,85),'is increased.  For  example, press the  space');
  829.   WRITE(position(15,85),'bar to see what would happen if you  selected');
  830.   WRITE(position(16,85),'bin 4.');
  831.   more;
  832.   i:=move_pegs(user,4,board,TRUE);
  833.   WRITE(attr([bold]));
  834.   WRITE(position(18,85),'Notice that all 11 pegs were  re-distributed,');
  835.   WRITE(position(19,85),'and none were placed in the Computer''s Kalah.');
  836.   more;
  837.   FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
  838.   WRITE(position(2,85),attr([bold]),'A "');
  839.   WRITE(attr([underline]),'Free move');
  840.   WRITE(attr([normal,bold]),'"  is granted  whenever the  ');
  841.   WRITE(attr([underline]),'last',attr([normal,bold]));
  842.   WRITE(position(3,85),'peg being  distributed lands  in your  Kalah.');
  843.   WRITE(position(4,85),'There is no limit to the number of free moves');
  844.   WRITE(position(5,85),'a player can  make.  For  example, press  the');
  845.   WRITE(position(6,85),'space bar  to see  what would  happen if  you');
  846.   WRITE(position(7,85),'selected bin 5.');
  847.   more;
  848.   i:=move_pegs(user,5,board,TRUE);
  849.   WRITE(position(21,19),clear_eoln);
  850.   WRITE('Last peg landed in your own kalah');
  851.   WRITE(position(22,19),clear_eoln);
  852.   WRITE(attr([bold,blinking]),'Go again...',attr([normal,bold]));
  853.   WRITE(position(9,85),'At this point, you  would be prompted to take ');
  854.   WRITE(position(10,85),'another turn.');
  855.   more;
  856.   FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
  857.   WRITE(position(21,1),esc,'[J',attr([bold])); {clear_eos}
  858.   WRITE(position(2,85),'A "');
  859.   WRITE(attr([underline]),'Capture',attr([normal,bold]));
  860.   WRITE('"  takes place  when the  ');
  861.   WRITE(attr([underline]),'last',attr([normal,bold]),'  peg');
  862.   WRITE(position(3,85),'lands in  one of  your  own empty  bins,  and');
  863.   WRITE(position(4,85),'there are pegs  in the  corresponding bin  on');
  864.   WRITE(position(5,85),'your  opponent''s  side.   The  pegs  in  your');
  865.   WRITE(position(6,85),'opponent''s bin are considered captured,  and,');
  866.   WRITE(position(7,85),'along with the peg used for the capture,  are');
  867.   WRITE(position(8,85),'moved into  your Kalah.   For example,  press');
  868.   WRITE(position(9,85),'the space bar to see what would happen if you');
  869.   WRITE(position(10,85),'selected bin 1.');
  870.   more;
  871.   i:=move_pegs(user,1,board,TRUE);
  872.   WRITE(attr([bold]));
  873.   WRITE(position(12,85),'Notice that all pegs from bin 3 on ');
  874.   WRITE(attr([underline]),'both',attr([normal,bold]),' sides');
  875.   WRITE(position(13,85),'were moved into your Kalah.');
  876.   more;
  877.   FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
  878.   WRITE(position(21,1),esc,'[J',attr([bold])); {clear_eos}
  879.   WRITE(position(2,85),'The game  ends when  one player  runs out  of');
  880.   WRITE(position(3,85),'pegs, and cannot make a move.  The player who');
  881.   WRITE(position(4,85),'has pegs  remaining,  gets those  pegs  moved');
  882.   WRITE(position(5,85),'into his Kalah.');
  883.  
  884.   WRITE(position(7,85),'Be careful!  The  winner is  the player  with');
  885.   WRITE(position(8,85),'the most pegs in their Kalah, not necessarily');
  886.   WRITE(position(9,85),'the one who finishes first.');
  887.   more;
  888.   FOR i:=2 TO 20 DO WRITE(position(i,85),clear_eoln);
  889.   WRITE(attr([bold]),position(2,85),'Helpful strategies:');
  890.   WRITE(position(3,85),' o Your best offense is a good defense!');
  891.   WRITE(position(4,85),' o Try to limit the number of free moves your');
  892.   WRITE(position(5,85),'   opponent  takes.   You can  block  him  by');
  893.   WRITE(position(6,85),'   moving alot of pegs.');
  894.   WRITE(position(7,85),' o Make sure you are free of any captures.');
  895.   WRITE(position(8,85),' o Keep your eyes out for free moves.');
  896.   WRITE(position(9,85),' o Check  to see if you  can make a  capture.');
  897.   WRITE(position(10,85),'   Remember, a capture ends your turn so look');
  898.   WRITE(position(11,85),'   for free moves first!');
  899.   more;
  900.   WRITE(attr([bold]));
  901.   WRITE(position(13,85),'These instructions can be viewed at any  time');
  902.   WRITE(position(14,85),'after the game starts with the "I" command.');
  903.  
  904.   WRITE(position(16,85),'Good  luck!   If you are  a  beginner, may  I');
  905.   WRITE(position(17,85),'suggest  starting off  with  level  1.  ');
  906.  
  907.   WRITE(position(19,85),'Please send your comments to: Brian Sietz');
  908.   WRITE(position(20,85),'[609] 429-6630 (300/1200 Baud)');
  909.   more;
  910.   WRITE(attr([col_80]));
  911.   board:=temp_board;
  912. END; {instructions}
  913.  
  914. BEGIN {main}
  915.     init_vars; {do only once!}
  916.     REPEAT
  917.         init_game;
  918.         REPEAT
  919.             make_move(computer);
  920.             make_move(user);
  921.         UNTIL game_is_over(board) OR quit_game;
  922.         END_game;
  923.     UNTIL user_is_bored;
  924.     WRITE(clear_screen,attr([txt,normal]));
  925. END.
  926.