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