home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / OTHELLO.ZIP / OTHELLO.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  10.5 KB  |  384 lines
  1. {  Name:  OTHELLO.PAS                                                  }
  2. {  Programmer:  Calvin A. Jones                                        }
  3. {  Date written:   11/24/84                                            }
  4. {  Date modified:    /  /                                              }
  5. {  Description:  Original PET version modified for Turbo Pascal        }
  6. {                under MS-DOS.                                         }
  7. program Othello;
  8.  
  9. const
  10.   fff = green;
  11.   bbb = black;
  12.  
  13.   c: array[1..2] of integer = (blue,red);
  14.   i4: array[0..7] of integer = (-1, 0, 1,1,1,0,-1,-1);
  15.   j4: array[0..7] of integer = (-1,-1,-1,0,1,1, 1, 0);
  16.  
  17. type
  18.   charset = set of char;
  19.  
  20. var
  21.   ch: char;
  22.   sc: array[1..2] of integer;
  23.   a: array[0..9,0..9] of integer;
  24.   player: array[1..2] of string[15];
  25.   n1,np,op,pt,s1,s2,s3,s4,s5: integer;
  26.   xl,xh,yl,yh: integer;
  27.   done,over: boolean;
  28.  
  29. procedure getchar(var ch: char; range: charset);
  30.   begin
  31.     repeat
  32.       read(kbd,ch);
  33.       if ch=#27 then halt;
  34.       ch:=upcase(ch);
  35.     until ch in range;
  36.   end;
  37.  
  38. procedure score;
  39.   var
  40.     i,j: integer;
  41.   begin
  42.     window(1,1,40,20);
  43.     textbackground(cyan);
  44.     for i:=1 to 8 do
  45.       for j:=1 to 8 do
  46.         if a[i,j]<>0 then
  47.         begin
  48.           textcolor(c[a[i,j]]);
  49.           gotoxy(4*i+1,2*j+3); write(chr(a[i,j]));
  50.         end;
  51.     textcolor(c[1]);
  52.     gotoxy(38,5); write(sc[1]:2);
  53.     textcolor(c[2]);
  54.     gotoxy(38,19); write(sc[2]:2);
  55.     textcolor(fff); textbackground(bbb);
  56.     if (sc[op]=0) or (n1=64) then
  57.     begin
  58.       window(1,21,40,24);
  59.       clrscr;
  60.       writeln(player[1],' has ',sc[1],' pieces');
  61.       writeln(player[2],' has ',sc[2],' pieces');
  62.       if sc[1]=sc[2] then writeln('It is a tie !!')
  63.       else
  64.       begin
  65.         if sc[1]>sc[2] then write(player[1]) else write(player[2]);
  66.         writeln(' won !!!');
  67.       end;
  68.       over:=true;
  69.       write('Do you want to play again? ');
  70.       getchar(ch,['Y','N']);
  71.       if ch='N' then done:=true;
  72.     end;
  73.   end;
  74.  
  75. procedure intro;
  76.   var
  77.     i: integer;
  78.   begin
  79.     textmode(c40);
  80.     textcolor(white); textbackground(cyan);
  81.     gotoxy(19,5); write('IBM');
  82.     gotoxy(12,7); write('Personal Computer');
  83.     gotoxy(8,10); write('╒═══════════════════════╕');
  84.     gotoxy(8,11); write('│  -*-   OTHELLO   -*-  │');
  85.     gotoxy(8,12); write('│                       │');
  86.     gotoxy(8,13); write('│     Author: Unkown    │');
  87.     gotoxy(8,14); write('│ Adapted by: P. Leabo  │');
  88.     gotoxy(8,15); write('│Enhanced by: R. Vollmer│');
  89.     gotoxy(8,16); write('│Pacsal Ver.: C. Jones  │');
  90.     gotoxy(8,17); write('╘═══════════════════════╛');
  91.     gotoxy(5,20); write('Orig. written for: PET computer');
  92.     gotoxy(10,21); write('Last update: 11/21/84');
  93.     i:=0;
  94.     repeat i:=i+1 until (i=maxint) or keypressed;
  95.     if keypressed then read(kbd,ch);
  96.   end;
  97.  
  98. procedure instructions;
  99.   begin
  100.     textmode(c80);
  101.     textcolor(7); textbackground(1);
  102.     clrscr;
  103.     window(10,1,70,24);
  104.     gotoxy(20,4); writeln('GREETINGS FROM OTHELLO');
  105.     writeln;
  106.     writeln('Othello is played on an 8 x 8 board, rows numbered 1 to 8');
  107.     writeln('and columns numbered A to H.  The initial configuration is');
  108.     writeln('all blank except for the four center squares.  Try to place');
  109.     writeln('your pieces so that it outflanks your opponent, creating');
  110.     writeln('horizontal, vertical, or diagonal runs of opposing pieces,');
  111.     writeln('turning them into yours.');
  112.     writeln;
  113.     writeln('Make your move by entering a number for a row and a letter');
  114.     writeln('for a column.');
  115.     writeln;
  116.     writeln('Note:  You must capture at least one of your opponent''s');
  117.     writeln('pieces.  If it is not possible, you forfeit your move by');
  118.     writeln('typing a <CR> for your move.');
  119.     writeln; writeln;
  120.     write('Press any key to continue...'); read(kbd,ch);
  121.   end;
  122.  
  123. procedure initialize;
  124.   var
  125.     i,j: integer;
  126.   begin
  127.     window(1,1,80,24);
  128.     textmode(c40);
  129.     done:=false; over:=false;
  130.     xl:=3; xh:=6;
  131.     yl:=3; yh:=6;
  132.     write('How many players? (1 or 2) ');
  133.     getchar(ch,['1','2']); writeln(ch);
  134.     np:=ord(ch)-ord('0');
  135.     writeln;
  136.     write('Player 1''s name: '); readln(player[1]);
  137.     if np=2 then
  138.     begin
  139.       write('Player 2''s name: '); readln(player[2]);
  140.     end;
  141.     if np<>2 then
  142.     begin
  143.       player[2]:='Computer';
  144.       writeln; write('Should I play my best? ');
  145.       getchar(ch,['Y','N']);
  146.       if ch='Y' then
  147.       begin
  148.         writeln('YES');
  149.         s2:=2; s4:=1; s5:=-2;
  150.       end
  151.       else
  152.       begin
  153.         writeln('NO');
  154.         s2:=0; s4:=0; s5:=0;
  155.       end;
  156.     end;
  157.     for i:=0 to 9 do
  158.       for j:=0 to 9 do a[i,j]:=0;
  159.     a[4,4]:=1; a[4,5]:=2;
  160.     a[5,4]:=2; a[5,5]:=1;
  161.     n1:=4;
  162.     for i:=1 to 2 do sc[i]:=2;
  163.   end;
  164.  
  165. procedure draw_board;
  166.   begin
  167.     clrscr;
  168.     textcolor(magenta); textbackground(blue);
  169.     gotoxy(13,1); writeln('O T H E L L O');
  170.     gotoxy(1,3);
  171.     textcolor(brown); textbackground(lightgray);
  172.     writeln('    1   2   3   4   5   6   7   8  ');
  173.     writeln('  ╔═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╗');
  174.     writeln('A ║   ║   ║   ║   ║   ║   ║   ║   ║');
  175.     writeln('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  176.     writeln('B ║   ║   ║   ║   ║   ║   ║   ║   ║');
  177.     writeln('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  178.     writeln('C ║   ║   ║   ║   ║   ║   ║   ║   ║');
  179.     writeln('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  180.     writeln('D ║   ║   ║   ║   ║   ║   ║   ║   ║');
  181.     writeln('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  182.     writeln('E ║   ║   ║   ║   ║   ║   ║   ║   ║');
  183.     writeln('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  184.     writeln('F ║   ║   ║   ║   ║   ║   ║   ║   ║');
  185.     writeln('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  186.     writeln('G ║   ║   ║   ║   ║   ║   ║   ║   ║');
  187.     writeln('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  188.     writeln('H ║   ║   ║   ║   ║   ║   ║   ║   ║');
  189.     writeln('  ╚═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╝');
  190.     textcolor(blue);
  191.     gotoxy(36,5); write(chr(1));
  192.     textcolor(red);
  193.     gotoxy(36,19); write(chr(2));
  194.     score;
  195.   end;
  196.  
  197. function test_move(x,y: integer): boolean;
  198.   var i,j: integer;
  199.   begin
  200.     test_move:=false;
  201.     for i:=-1 to 1 do
  202.       for j:=-1 to 1 do
  203.         if a[x+i,y+j]=op then test_move:=true;
  204.   end;
  205.  
  206. procedure count_flank(x,y,z: integer);
  207.   var i5,j5,i6,j6,k,k1: integer;
  208.   begin
  209.     s1:=0; k:=0;
  210.     while k<8 do
  211.     begin
  212.       s3:=0;
  213.       i5:=i4[k]; j5:=j4[k]; i6:=x+i5; j6:=y+j5;
  214.       if a[i6,j6]=op then
  215.       begin
  216.         repeat
  217.           s3:=s3+1;
  218.           i6:=i6+i5; j6:=j6+j5;
  219.         until (a[i6,j6]=0) or (a[i6,j6]=pt);
  220.         if a[i6,j6]=pt then
  221.         begin
  222.           s1:=s1+s3;
  223.           if z=1 then
  224.           begin
  225.             i6:=x; j6:=y;
  226.             for k1:=0 to s3 do
  227.             begin
  228.               a[i6,j6]:=pt;
  229.               i6:=i6+i5; j6:=j6+j5;
  230.             end;
  231.           end;
  232.         end;
  233.       end;
  234.       k:=k+1;
  235.     end;
  236.   end;
  237.  
  238. procedure show_move(x,y: integer);
  239.   begin
  240.     window(1,1,40,20);
  241.     gotoxy(4*x+1,2*y+3);
  242.     textcolor(c[pt]+blink); textbackground(lightgray);
  243.     write(chr(pt));
  244.     textcolor(fff); textbackground(bbb);
  245.     delay(2500);
  246.     window(1,21,40,24);
  247.     gotoxy(1,1);
  248.     count_flank(x,y,1);
  249.     sc[pt]:=sc[pt]+s1+1;
  250.     sc[op]:=sc[op]-s1;
  251.     n1:=n1+1;
  252.   end;
  253.  
  254. procedure computer_move;
  255.   var i,j,b1,i3,j3: integer;
  256.   begin
  257.     window(1,21,40,25);
  258.     clrscr;
  259.     writeln;
  260.     textcolor(fff+blink);
  261.     writeln('I am thinking!');
  262.     textcolor(fff);
  263.     b1:=-1; i3:=0; j3:=0;
  264.     for i:=xl to xh do
  265.       for j:=yl to yh do
  266.         if a[i,j]=0 then
  267.           if test_move(i,j) then
  268.           begin
  269.             count_flank(i,j,0);
  270.             if s1>0 then
  271.             begin
  272.               if (i=1) or (i=8) then s1:=s1+s2;
  273.               if (j=1) or (j=8) then s1:=s1+s2;
  274.               if (i=2) or (i=7) then s1:=s1+s5;
  275.               if (j=2) or (j=7) then s1:=s1+s5;
  276.               if (i=3) or (i=6) then s1:=s1+s4;
  277.               if (j=3) or (j=6) then s1:=s1+s4;
  278.               if s1>=b1 then
  279.                 if (s1>b1) or (random>0.5) then
  280.                 begin
  281.                   b1:=s1; i3:=i; j3:=j;
  282.                 end;
  283.             end;
  284.           end;
  285.     if (i3 in [1..8]) and (j3 in [1..8]) then
  286.     begin
  287.       i:=i3; j:=j3;
  288.       show_move(i,j);
  289.       if (i<=xl) and (i<>1) then xl:=xl-1;
  290.       if (i>=xh) and (i<>8) then xh:=xh+1;
  291.       if (j<=yl) and (j<>1) then yl:=yl-1;
  292.       if (j>=yh) and (j<>8) then yh:=yh+1;
  293.     end
  294.     else writeln('Computer passes.');
  295.     delay(2500);
  296.   end;
  297.  
  298. procedure player_move;
  299.   const
  300.     term: charset = ['1'..'8','A'..'H',^M];
  301.   var
  302.     i,j: integer;
  303.     goodmove: boolean;
  304.   begin
  305.     window(1,21,40,25);
  306.     clrscr;
  307.     writeln;
  308.     goodmove:=false;
  309.     repeat
  310.       write(player[pt],' ');
  311.       textcolor(c[pt]); write(chr(pt));
  312.       textcolor(fff); write(', enter your move: ');
  313.       i:=-1; j:=-1;
  314.       repeat
  315.         getchar(ch,term);
  316.         case ch of
  317.           '1'..'8': begin
  318.               write(ch,' ');
  319.               if i=-1 then i:=ord(ch)-ord('0');
  320.             end;
  321.           'A'..'H': begin
  322.               write(ch,' ');
  323.               if j=-1 then j:=ord(ch)-ord('@');
  324.             end;
  325.           ^M: begin
  326.               i:=0; j:=0;
  327.             end;
  328.         end;
  329.       until (i>-1) and (j>-1);
  330.       writeln;
  331.       if i=0 then
  332.       begin
  333.         write('Are you passing? ');
  334.         getchar(ch,['Y','N']);
  335.         if ch='Y' then
  336.         begin
  337.           writeln('YES');
  338.           goodmove:=true;
  339.         end
  340.         else writeln('NO');
  341.       end
  342.       else
  343.       begin
  344.         if a[i,j]=0 then
  345.         begin
  346.           if test_move(i,j) then
  347.           begin
  348.             count_flank(i,j,0);
  349.             if s1>0 then
  350.             begin
  351.               goodmove:=true;
  352.               show_move(i,j);
  353.             end
  354.             else writeln('Sorry, does not flank a row.')
  355.           end
  356.           else writeln('Sorry, not next to opponents pieces.')
  357.         end
  358.         else writeln('Sorry, square occupied; try again.');
  359.       end;
  360.     until goodmove;
  361.   end;
  362.  
  363. begin
  364.   intro;
  365.   instructions;
  366.   repeat
  367.     initialize;
  368.     draw_board;
  369.     repeat
  370.       pt:=1; op:=2;
  371.       player_move;
  372.       score;
  373.       if not over then
  374.       begin
  375.         pt:=2; op:=1;
  376.         if np=2 then player_move else computer_move;
  377.         score;
  378.       end;
  379.     until over;
  380.   until done;
  381.   window(1,1,80,24);
  382.   textmode(c80);
  383. end.
  384.