games-request@tekred.TEK.COM (06/09/87)
Submitted by: cwruecmp!rsilvers@hawk.CS.Ulowell.Edu (Robert Silvers)
Comp.sources.games: Volume 1, Issue 43
Archive-name: othello1/Part01
[Not having the hardware or software to try this, you're
on your own. Problems or questions to the author. -br]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 2)."
# Contents: README MANIFEST InOutExtensions.mod main.mod move.mod
# othello.mod regis.mod types.def
# Wrapped by billr@tekred on Mon Jun 8 13:57:59 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f README -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(948 characters\)
sed "s/^X//" >README <<'END_OF_README'
XThis is a version of othello that I wrote this year as a freshman computing
XII project. It requires a ReGIS compatible terminal to run. I have never
Xused Modula 2 on another system, so I hope all of the libraries are there
Xfor you. The only one you may need in the one in regis.mod that prints
Xout an escape character. If you don't have it, you can probably write it.
XThe computer plays the person with one move of look ahead. It is a respectable
Xplayer and moves extreamly fast.
X
XI would appreatiate any comments, suggestions on this program, but don't
Xwait for a reply because I am on summer vacation and won't be on the net
Xmuch. Feel free to modify this program as you wish. As long as no money
Xis made off of it, I do not care. Sorry for the lack of documentation
Xwith it, but I leave here tomorrow and I do not have time to write any.
X Have fun,
X Rob.
X
X
X
X
X
XRobert Silvers.
XThatcher Rd.
XPlymouth Ma. 02360.
X(617) 224-2821.
X
X
X
X
END_OF_README
if test 948 -ne `wc -c <README`; then
echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f MANIFEST -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"MANIFEST\"
else
echo shar: Extracting \"MANIFEST\" \(504 characters\)
sed "s/^X//" >MANIFEST <<'END_OF_MANIFEST'
X File Name Archive # Description
X-----------------------------------------------------------
X InOutExtensions.def 2
X InOutExtensions.mod 1
X MANIFEST 1 This shipping list
X README 1
X main.mod 1
X move.def 2
X move.mod 1
X othello.def 2
X othello.mod 1
X regis.def 2
X regis.mod 1
X types.def 1
X types.mod 2
END_OF_MANIFEST
if test 504 -ne `wc -c <MANIFEST`; then
echo shar: \"MANIFEST\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f InOutExtensions.mod -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"InOutExtensions.mod\"
else
echo shar: Extracting \"InOutExtensions.mod\" \(6781 characters\)
sed "s/^X//" >InOutExtensions.mod <<'END_OF_InOutExtensions.mod'
XIMPLEMENTATION MODULE InOutExtensions ;
X
X(* written by *)
X(* Jesse M. Heines *)
X(* University of Lowell *)
X
X(* Version 1.2 1/28/87 *)
X
X
X
XFROM CharCodes IMPORT
X EscapeCh ;
X
XFROM InOut IMPORT
X termCH, Read, Write, WriteInt ;
X
XFROM MathLib0 IMPORT
X log10 ;
X
XFROM SCTermStream IMPORT
X CreateInOutput ;
X
XFROM Streams IMPORT
X Delete, Stream ;
X
XFROM SYSTEM IMPORT
X MAXINT, MININT ;
X
XFROM TextIO IMPORT
X EndOfLine, ReadCHAR ;
X
X
X
XPROCEDURE GetEscapeSequence
X (VAR c : ARRAY OF CHAR ) ; (* characters read from the terminal *)
X
X(* This procedure is designed to read as escape sequnce from the terminal *)
X(* without waiting for the user to press RETURN. It begins by reading a *)
X(* single from the terminal. If the character read is ESCape, a second *)
X(* character is read. If the second characters is '[', a third character *)
X(* is read. Any characters not read are set to 0C. *)
X
XVAR
X SingleCharStream : Stream ; (* terminal stream in single character mode *)
X
XBEGIN
X
X (* Initialization *)
X
X c[0] := 0C ;
X c[1] := 0C ;
X c[2] := 0C ;
X
X (* Open input stream *)
X
X SingleCharStream := CreateInOutput () ;
X
X (* Read characters *)
X
X c[0] := ReadCHAR (SingleCharStream) ;
X IF c[0] = EscapeCh THEN
X c[1] := ReadCHAR (SingleCharStream) ;
X IF c[1] = '[' THEN
X c[2] := ReadCHAR (SingleCharStream) ;
X END ;
X END ;
X
X (* Close input stream *)
X
X Delete (SingleCharStream) ;
X
XEND GetEscapeSequence ;
X
X
X
XPROCEDURE GetOneChar
X (VAR c : CHAR ) ; (* character read from the terminal *)
X
X(* This procedure gets a single character from the terminal without *)
X(* waiting for the user to press RETURN. *)
X
XVAR
X SingleCharStream : Stream ; (* terminal stream in single character mode *)
X
XBEGIN
X
X SingleCharStream := CreateInOutput () ;
X c := ReadCHAR (SingleCharStream) ;
X Delete (SingleCharStream) ;
X
XEND GetOneChar ;
X
X
X
XPROCEDURE ReadLn ;
X
X(* This procedure reads data from the current input stream until an end *)
X(* of line character (EOL), a null character (0C), or a CTRL/D character *)
X(* (4C) is read. The data read is not saved. The purpose of this *)
X(* procedure is to skip the rest of the current line to prepare for *)
X(* reading the next line of input. *)
X
XBEGIN
X
X (* Read as long as character read is not a terminating condition *)
X
X WHILE (NOT (EndOfLine (termCH))) AND (termCH # 0C) AND (termCH # 4C) DO
X Read (termCH) ;
X END ;
X
XEND ReadLn ;
X
X
X
XPROCEDURE ReadLine
X (VAR line : ARRAY OF CHAR) ; (* the line read *)
X
X(* This procedure reads a line of data from the current input stream. *)
X(* Reading is terminated when the end of line character (EOL) is reached, *)
X(* the array into which characters are being read becomes full, a null *)
X(* character is read, or a CTRL/D character (4C) is read. *)
X
XVAR
X k : CARDINAL ; (* loop index *)
X linelen : CARDINAL ; (* number of characters read thus far *)
X
XBEGIN
X
X (* Initialization *)
X
X Read (termCH) ;
X linelen := 0 ;
X
X (* Read as long as character read is not a terminating condition *)
X
X WHILE (NOT (EndOfLine (termCH))) AND (linelen <= HIGH(line)) AND
X (termCH # 0C) AND (termCH # 4C) DO
X line[linelen] := termCH ;
X Read (termCH) ;
X INC (linelen) ;
X END ;
X
X (* Zero out the rest of the line *)
X
X FOR k := linelen TO HIGH(line) DO
X line[k] := 0C ;
X END ;
X
XEND ReadLine ;
X
X
X
XPROCEDURE WriteFormattedReal
X (r : REAL ; (* the real number to write *)
X width : CARDINAL ; (* size of output field *)
X ndecimalplaces : CARDINAL ) ; (* number of decimal places to write *)
X
X(* This procedure writes a real number to the output stream and places that *)
X(* number in a field "width" spaces wide. The field will be filled with *)
X(* blanks to pad it to the appropriate size. (The number is right justi- *)
X(* fied in the field.) WriteFormattedReal will output numbers in standard *)
X(* format with the specified number of decimal places. *)
X
XVAR
X k : CARDINAL ; (* loop index *)
X length : CARDINAL ; (* minimum field width needed to write number *)
X placevalue : REAL ; (* value of place currently being printed *)
X placedigit : [0..9] ; (* digit in place currently being printed *)
X
XBEGIN
X
X (* Compute minimum number of spaces needed to write number *)
X
X IF r > 0.0 THEN
X IF r >= 1.0 THEN
X length := TRUNC (log10 (r)) + 2 + ndecimalplaces ;
X ELSE
X length := 2 + ndecimalplaces ;
X END ;
X ELSE
X IF r <= -1.0 THEN
X length := TRUNC (log10 (ABS(r))) + 3 + ndecimalplaces ;
X ELSE
X length := 3 + ndecimalplaces ;
X END ;
X END ;
X
X (* Output padding spaces if necessary *)
X
X FOR k := length + 1 TO width DO
X Write (' ') ;
X END ;
X
X (* Write integer part *)
X
X IF (r >= FLOAT (MININT)) AND (r <= FLOAT (MAXINT)) THEN
X WriteInt (TRUNC(r), 0) ;
X
X ELSE
X IF r < 0.0 THEN
X Write ('-') ;
X r := ABS (r) ;
X END ;
X
X placevalue := Power (10.0,TRUNC(log10(r))) ;
X
X FOR k := TRUNC(log10(r)) TO 0 BY -1 DO
X placedigit := TRUNC (r/placevalue) ;
X Write (CHR (48 + placedigit)) ;
X r := r - placevalue * FLOAT(placedigit) ;
X placevalue := placevalue / 10.0 ;
X END ;
X
X END ;
X
X (* Write decimal point *)
X
X Write ('.') ;
X
X (* Write fractional part *)
X
X r := r - FLOAT(TRUNC(r)) ;
X
X FOR k := 1 TO ndecimalplaces DO
X r := 10.0 * r ;
X IF k < ndecimalplaces THEN
X WriteInt (TRUNC(r), 0) ;
X ELSE
X WriteInt (RoundDigit(r), 0) ;
X END ;
X r := r - FLOAT(TRUNC(r)) ;
X END ;
X
XEND WriteFormattedReal ;
X
X
X
XPROCEDURE Power
X (n : REAL ; (* number to compute the Power of *)
X x : CARDINAL ) (* Power to raise number to *)
X : REAL ; (* result type *)
X
X(* This procedure computes n to the x and returns the result as a real *)
X(* number. It is not exported. *)
X
XVAR
X k : CARDINAL ; (* loop index *)
X temp : REAL ; (* intermediate result *)
X
XBEGIN
X temp := 1.0 ;
X FOR k := 1 TO x DO
X temp := n * temp ;
X END ;
X RETURN temp ;
XEND Power ;
X
X
X
XPROCEDURE RoundDigit
X (n : REAL ) (* real number to round *)
X : INTEGER ; (* return type *)
X
X(* This procedure rounds a real number to the nearest 1 and returns the *)
X(* resultant value as an integer. It is not exported. *)
X
XBEGIN
X IF ABS (n - FLOAT(TRUNC(n))) < 0.5 THEN
X RETURN TRUNC(n) ;
X ELSE
X IF n > 0.0 THEN
X RETURN TRUNC(n) + 1 ;
X ELSE
X RETURN TRUNC(n) - 1 ;
X END ;
X END ;
XEND RoundDigit ;
X
X
X
XEND InOutExtensions.
END_OF_InOutExtensions.mod
if test 6781 -ne `wc -c <InOutExtensions.mod`; then
echo shar: \"InOutExtensions.mod\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f main.mod -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"main.mod\"
else
echo shar: Extracting \"main.mod\" \(4707 characters\)
sed "s/^X//" >main.mod <<'END_OF_main.mod'
XMODULE main;
X
X(*******************************************************)
X(* OTHELLO (c) 1987 Robert Silvers. *)
X(* University of Lowell. *)
X(* *)
X(* "It was hard to write, so it should be hard to read"*)
X(* *)
X(* *)
X(* VERSION HISTORY: *)
X(* *)
X(* Started at end of spring break. *)
X(* Ver. 1.0 4/04/87 First totally working version. *)
X(* Ver. 1.1 4/07/87 Computer plays person grabbing *)
X(* as many pieces as it can. *)
X(* Procedure that shows moves is *)
X(* working. *)
X(* Ver. 1.2 4/08/87 Recognizes end of game. Tells *)
X(* who won. *)
X(* Ver. 1.3 4/09/87 Goes for corners, sides, etc. *)
X(* 4/11/87 All known bugs removed. *)
X(* 4/11/27 Started Added an extra module. *)
X(* 4/17/27 Finished adding extra module. *)
X(* Ver. 1.4 4/17/87 Added one move look-ahead. *)
X(* Ver. 1.5 4/17/87 Added "SmartFlip" routine. *)
X(* Ver. 1.6 4/19/87 New move algorithm good opponent. *)
X(* Ver. 1.7 Remote Player version. *)
X(* *)
X(*******************************************************)
X
X
XFROM InOut IMPORT
X WriteString;
X
XFROM types IMPORT
X PIECES, BOARD, TEMP, field, temp, flipped, Passed, End;
X
XFROM othello IMPORT
X InitBoard, Flip, DrawBoard, ReDraw, Menu, GameOver;
X
XFROM move IMPORT
X GetMove, Move;
X
XFROM regis IMPORT
X ExitGr;
X
XFROM TextIO IMPORT
X ReadCHAR, WriteCHAR;
X
X
XFROM Goto IMPORT
X SetGoto;
X
X
XVAR
X choice: CHAR; (* Number of players selected *)
X PLAYED: BOOLEAN; (* TRUE if games has started. *)
X
X
X(* The user has selected a two player game. *)
XPROCEDURE TwoPlayer;
X
XVAR
X xval : INTEGER; (* Coords of move. *)
X yval : INTEGER;
X player: PIECES ; (* Color now moving. *)
X
XBEGIN
X
X PLAYED:= TRUE;
X player:= black; (* Black starts. *)
X DrawBoard; (* Set up graphics. *)
X InitBoard; (* Put first four chips on.*)
X ReDraw; (* Draw the chips. *)
X REPEAT
X
X IF player = white THEN (* Find opposite player. *)
X player:= black
X ELSE
X player:= white;
X END;
X
X GetMove(player, xval, yval);
X IF NOT Passed THEN
X Flip(player, xval, yval); (* Flip applicable pieces. *)
X END;
X ReDraw;
X
X UNTIL GameOver(FALSE); (* False means that it is not a player *)
X (* Vs. computer game. *)
XEND TwoPlayer; (* Used to print surprise message if *)
X (* TRUE and computer wins. *)
X
XPROCEDURE OnePlayer;
X
XVAR
X xval : INTEGER; (* Coords of move. *)
X yval : INTEGER;
X player: PIECES ;
X
XBEGIN
X
X PLAYED:= TRUE;
X Passed:= FALSE; (* Initialize. *)
X DrawBoard;
X InitBoard;
X ReDraw;
X REPEAT
X
X GetMove (white, xval, yval);
X IF NOT Passed THEN
X Flip(white, xval, yval);
X ReDraw;
X END;
X Move (black, xval, yval); (* Computer moves. *)
X IF NOT Passed THEN
X Flip(black, xval, yval);
X ReDraw
X END;
X
X UNTIL GameOver(TRUE); (* TRUE means computer did play. *)
X (* If computer wins, an insult *)
X (* will reusult. *)
X
XEND OnePlayer;
X
X
XPROCEDURE NoPlayer; (* Computer plays with itself. *)
X
XVAR
X xval : INTEGER; (* Coords of move. *)
X yval : INTEGER;
X player: PIECES ;
X
XBEGIN
X
X PLAYED:= TRUE;
X Passed:= FALSE; (* Initialize. *)
X player:= black;
X DrawBoard;
X InitBoard;
X ReDraw;
X REPEAT
X
X IF player = white THEN
X player:= black
X ELSE
X player:= white;
X END;
X Move(player, xval, yval); (* Computer move. *)
X IF NOT Passed THEN
X Flip(player, xval, yval);
X ReDraw;
X END;
X
X UNTIL GameOver(FALSE);
X
XEND NoPlayer;
X
X
X
XBEGIN (* Main Line *)
X
X PLAYED:= FALSE;
X Menu(choice); (* Get the number of players. *)
X
X SetGoto(End);
X
X(* Check if game has been played yet. If it has, then we have just *)
X(* returned from the goto and we should skip the CASE. *)
XIF NOT PLAYED THEN
X CASE choice OF
X '0' : NoPlayer;
X |'1' : OnePlayer;
X |'2' : TwoPlayer;
X |'q' : (* Quit *);
X END;
XEND;
XExitGr;
X
XEND main.
X
X
X
END_OF_main.mod
if test 4707 -ne `wc -c <main.mod`; then
echo shar: \"main.mod\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f move.mod -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"move.mod\"
else
echo shar: Extracting \"move.mod\" \(21241 characters\)
sed "s/^X//" >move.mod <<'END_OF_move.mod'
XIMPLEMENTATION MODULE move;
X
X(*************************************************************************)
X(* OTHELLO. (c) 1987 Robert Silvers. All rights reserved. *)
X(* *)
X(* This is the main set of routines that runs the othello game. The *)
X(* game is controlled from the driver. The procedures in this section *)
X(* set up the board, get the moves, check if it is valid, if so, flip *)
X(* the pieces. It then counts the pieces, and redraws the board. *)
X(*************************************************************************)
X
X
XFROM InOut IMPORT
X WriteString, Read, WriteInt;
X
XFROM InOutExtensions IMPORT
X GetEscapeSequence, GetOneChar, ReadLn;
X
XFROM regis IMPORT
X Reset, Position, ClearScreen, Plot, DrawTo, Circle, Box, Color, SetFill,
X TextSize, WriteNum, WriteText, UnsetFill, BGColor, TextSlant;
X
XFROM othello IMPORT
X Flip, ShowMoves, GameOver;
X
XFROM types IMPORT
X PIECES, BOARD, TEMP, field, temp, flipped, Passed, End;
X
XFROM Goto IMPORT
X LongGoto;
X
X
X(* NOTE: The constants below are for adjusting the way the game plays. *)
X(* The computer uses them to decide how much to weigh each move. *)
X
X(* Constants in HowMany *)
X
XCONST
X EDGEFLIP= 03;(* When it flips an edge, it adds this number to value.*)
X TWOAWF = 07;(* When it flips a piece two away from corner, adds it.*)
X
X(* In Value *)
X
X CORNER = 25;(* Add this when a move can be made in the corner. *)
X EDGE = 05;(* Add this when you can flip on an edge. *)
X ADJACENT= 15;(* Subtract this when you can move next to a corner. *)
X (* Note: not subtracted if corner already occupied. *)
X TWOAW = 10;(* Add this if move is two away from corner. *)
X
X(* In FindBest *)
X
X MULF = 03;(* Multiply this by computer's move weight before *)
X (* subtracting humans supposed (look-ahead) move. *)
X
XVAR
X Look: BOOLEAN;
X
X(*************************************************************************)
X(* This procedure gets the move from the player. *)
X(*************************************************************************)
XPROCEDURE GetMove (player: PIECES; VAR xcords, ycords: INTEGER);
X
XVAR
X ch : ARRAY [0..2] OF CHAR;
X passed : BOOLEAN; (* TRUE if player passed. *)
X illeg : BOOLEAN; (* TRUE if illegal move. *)
X TriedToPass: BOOLEAN; (* TRUE if message needs to be cleared. *)
X Delay : INTEGER;
X
XBEGIN
X xcords:= 4; (* Set to middle position of board. *)
X ycords:= 4; (* Initialize. *)
X passed:= FALSE;
X illeg := FALSE;
X TriedToPass := FALSE;
X
X IF player= white THEN (* Print out whose move it is. *)
X Color('D'); (* But first, erase previous. *)
X Position(420, 120);
X WriteText('Blacks move.');
X Color("R");
X Position(420, 120);
X WriteText('Blues move.');
X Position(180, 180);
X ELSE
X Color('D');
X Position(420, 120);
X WriteText('Blues move.');
X Color("R");
X Position(420, 120);
X WriteText('Blacks move.');
X Position(180, 180);
X END; (* IF *);
X
X LOOP
X
X LOOP
X
X Position((xcords * 50) - 20, (ycords * 50) - 20);
X GetEscapeSequence(ch); (* Read keyboard. *)
X
X IF illeg THEN (* Erase old message if nessesary. *)
X illeg:= FALSE;
X Color('D');
X TextSize(2);
X Position(420, 150);
X WriteText('ILLEGAL MOVE!');
X TextSize(1);
X END; (* IF *)
X IF TriedToPass THEN (* Erase message if TRUE. *)
X TriedToPass:= FALSE;
X Color("D");
X Position(420, 150);
X WriteText('Sorry, you cannot pass.');
X END; (* IF *)
X
X IF (ch[2]= 'D') AND (xcords > 1) THEN (* Get the moves. *)
X DEC(xcords);
X ELSIF(ch[2]= 'C') AND (xcords < 8) THEN
X INC(xcords);
X ELSIF(ch[2]= 'B') AND (ycords < 8) THEN
X INC(ycords);
X ELSIF(ch[2]= 'A') AND (ycords > 1) THEN
X DEC(ycords);
X ELSIF(ch[0]= 's') OR (ch[0]= 'S') THEN
X ShowMoves(player)
X ELSIF(ch[0]= 'p') OR (ch[0]= 'P') THEN
X IF CanPass(player) THEN
X passed:= TRUE; (* Display passed and exit. *)
X Passed:= TRUE;
X Position(420, 150);
X Color("G");
X WriteText('PASSED');
X Position((xcords * 50) - 20, (ycords * 50) - 20);
X FOR Delay:= 1 TO 300000 DO
X END;
X Position(420, 150);
X Color("D");
X WriteText('PASSED');
X EXIT; (* Leave first loop *)
X END; (* IF *)
X Color("G");
X Position(420, 150);
X WriteText('Sorry, you cannot pass.');
X Position((xcords * 50) - 20, (ycords * 50) - 20);
X TriedToPass:= TRUE;
X ELSIF(ch[0]= '1') THEN (* Drop a white piece. *)
X field[xcords][ycords]:= white;
X Color("B");
X SetFill(ycords);
X Circle(13, 13);
X UnsetFill
X ELSIF(ch[0]= '2') THEN (* Drop a black piece *)
X field[xcords][ycords]:= black;
X Color("D");
X SetFill(ycords);
X Circle(13, 13);
X UnsetFill
X ELSIF(ch[0]= '3') THEN (* Clear the space. *)
X field[xcords][ycords]:= none;
X Color("G");
X SetFill(ycords);
X Circle(13, 13);
X UnsetFill
X ELSIF ch[0]= 'q' THEN (* Quit. *)
X LongGoto(End); (* Jump to end of program. *)
X ELSIF ch[0]= 12C (*RETURN*) THEN (* Move was entered. *)
X EXIT; (* Lets get outta' here. *)
X END; (* IF *)
X
X END; (* INNER LOOP *)
X
X IF passed THEN (* If no valid moves and person has passed. *)
X EXIT;
X END;
X IF Validate(player, xcords, ycords) THEN (* Good move. *)
X EXIT;
X END;
X
X Color('G'); (* If it has gotton this far, must be bad move. *)
X TextSize(2);
X Position(420, 150); (* Print out that move is not valid. *)
X WriteText('ILLEGAL MOVE!');
X illeg:= TRUE;
X Position((xcords * 50) - 20, (ycords * 50) - 20);
X TextSize(1);
X
X END; (* outer LOOP *)
X IF NOT passed THEN (* Good move. *)
X Passed:= FALSE;
X field[xcords][ycords]:= player;
X Position((xcords * 50) - 20, (ycords * 50) - 20);
X IF player= white THEN (* Find color. Put piece on screen. *)
X Color('B')
X ELSE
X Color('D');
X END; (* IF *)
X SetFill((ycords * 50) - 20);
X Circle(13, 13);
X UnsetFill;
X END; (* IF *)
X
XEND GetMove;
X
X
X(*************************************************************************)
X(* This function reports if a move is valid for the player. *)
X(*************************************************************************)
XPROCEDURE Validate (player: PIECES; xcords, ycords: INTEGER): BOOLEAN;
XBEGIN
X
X
X (* Reject right away if space is occupied. *)
X IF (field[xcords][ycords]= white) OR (field[xcords][ycords]= black) THEN
X RETURN FALSE;
X END; (* IF *)
X
X
X IF Check(player, xcords, ycords, 1, 0) OR
X Check(player, xcords, ycords, -1, 0) OR
X Check(player, xcords, ycords, 0, 1) OR
X Check(player, xcords, ycords, 0, -1) OR
X Check(player, xcords, ycords, 1, -1) OR
X Check(player, xcords, ycords, 1, 1) OR
X Check(player, xcords, ycords, -1, 1) OR
X Check(player, xcords, ycords, -1,-1) THEN
X RETURN TRUE;
X END;
X
X RETURN FALSE;
X
XEND Validate;
X
X(* Scans in the 8 directions called in Validate. *)
XPROCEDURE Check(player: PIECES; xcords, ycords, xdirection, ydirection:INTEGER):
X BOOLEAN;
X
XVAR
X x, y : INTEGER; (* Screen coordinates. *)
X opplayer: PIECES ; (* Opponent. *)
X found : BOOLEAN; (* TRUE if other is found. *)
X
XBEGIN
X
X IF player= white THEN (* Get the other player's color. *)
X opplayer:= black
X ELSE
X opplayer:= white;
X END; (* IF *);
X
X found:= FALSE;
X x:= xcords + xdirection;
X y:= ycords + ydirection;
X
X LOOP
X IF (y= 0) OR (x= 0) OR (y= 9) OR (x= 9) THEN
X EXIT;
X END;
X IF field[x][y]= none THEN
X EXIT;
X END;
X IF (field[x][y]= opplayer) THEN
X found:= TRUE;
X END;
X IF (found= TRUE) AND (field[x][y]= player) THEN
X RETURN TRUE;
X END;
X IF field[x][y]= player THEN
X EXIT;
X END;
X x:= x + xdirection;
X y:= y + ydirection;
X END; (* LOOP *);
X RETURN FALSE;
X
XEND Check;
X
X
X(*************************************************************************)
X(* This procedure counts the number of pieces on the board. *)
X(* It is called from the redraw procedure where it is displayed. *)
X(*************************************************************************)
XPROCEDURE Count (VAR White, Black: INTEGER);
X
XVAR
X x, y: INTEGER;
X
XBEGIN
X
X White:= 0; (* Init. *)
X Black:= 0;
X FOR x:= 1 TO 8 DO;
X FOR y:= 1 TO 8 DO;
X IF field[x][y] = white THEN
X INC(White)
X ELSIF field[x][y] = black THEN
X INC(Black);
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X
XEND Count;
X
X
X(*************************************************************************)
X(* This function returns the number of pieces for a given move. *)
X(* A modified version of Flip. *)
X(*************************************************************************)
XPROCEDURE HowMany(player : PIECES; xcords, ycords: INTEGER; VAR count, weight:
X INTEGER);
X
XBEGIN
X count := 0;
X weight:= 0;
X NumFlips(player, xcords, ycords, 1, 0, count, weight);
X NumFlips(player, xcords, ycords,-1, 0, count, weight);
X NumFlips(player, xcords, ycords, 0, 1, count, weight);
X NumFlips(player, xcords, ycords, 0, -1, count, weight);
X NumFlips(player, xcords, ycords, 1, -1, count, weight);
X NumFlips(player, xcords, ycords, 1, 1, count, weight);
X NumFlips(player, xcords, ycords,-1, 1, count, weight);
X NumFlips(player, xcords, ycords,-1, -1, count, weight);
X
XEND HowMany;
X
X
X(* This procedure finds the number of flips as well as the value of *)
X(* the pieces that get fliped. For example, it will report a larger *)
X(* number for flipping an edge piece than a middle piece. *)
X(* Count is the number of pieces only. weight is count + the total *)
X(* weight. *)
XPROCEDURE NumFlips(player: PIECES; xcords, ycords, xdir, ydir: INTEGER;
X VAR count, weight:INTEGER);
X
XVAR
X opplayer: PIECES ; (* Opponent. *)
X x : INTEGER; (* Used in counters. *)
X y : INTEGER;
X foundop : BOOLEAN; (* Found opposite player. *)
X canflip : BOOLEAN; (* TRUE is at least one flip is needed. *)
X founds : BOOLEAN; (* Found space. *)
X foundp : BOOLEAN; (* Found player. *)
X
XBEGIN
X
X IF player= white THEN (* Get the other player's color. *)
X opplayer:= black
X ELSE
X opplayer:= white;
X END;
X
X field[xcords][ycords]:= player; (* Put in dummy player. *)
X
X foundop:= FALSE;
X canflip:= FALSE;
X founds := FALSE;
X foundp := FALSE;
X x:= xcords;
X y:= ycords;
X LOOP
X IF (x= 0) OR (y= 0) OR (x= 9) OR (y= 9) THEN
X EXIT;
X END;
X IF (field[x][y]= opplayer) THEN
X foundop:= TRUE;
X END;
X IF ((field[x][y]= none)) AND ((foundop= FALSE) OR
X (foundp= FALSE)) THEN
X founds:= TRUE;
X END;
X IF (field[x][y]= player) AND (foundop) AND (founds= FALSE) THEN
X canflip:= TRUE;
X END;
X x:= x + xdir;
X y:= y + ydir;
X END; (* LOOP *)
X x:= xcords;
X y:= ycords;
X IF canflip THEN
X LOOP
X x:= x + xdir;
X y:= y + ydir;
X IF (x= 0) OR (y= 0) OR (x= 9) OR (y= 9) THEN
X EXIT;
X END;
X IF (field[x][y]= player) THEN
X EXIT;
X END;
X IF (field[x][y]= opplayer) THEN
X INC(count);
X INC(weight); (* Find true weight of flipped pieces. *)
X IF Edge(x, y) THEN
X weight:= weight + EDGEFLIP;
X END;
X IF TwoAway(x, y) THEN
X weight:= weight + TWOAWF;
X END;
X END; (* IF *);
X END; (* LOOP *)
X END; (* IF *)
X
X field[xcords][ycords]:= none; (* Clear player. *)
X
XEND NumFlips;
X
X
X(* TRUE if corner piece. *)
XPROCEDURE Corner (x, y: INTEGER): BOOLEAN;
XBEGIN
X
X IF ((x=1) OR (x= 8)) AND ((y=1) OR (y=8)) THEN
X RETURN TRUE
X END;
X
X RETURN FALSE;
X
XEND Corner;
X
X
X(* TRUE if edge piece. *)
XPROCEDURE Edge (x, y: INTEGER): BOOLEAN;
XBEGIN
X
X IF ((x=1) OR (x=8)) OR ((y=1) OR (y=8)) THEN
X RETURN TRUE;
X END; (* IF *)
X
X RETURN FALSE;
X
XEND Edge;
X
X
X(* TRUE if ajacent to corner. *)
XPROCEDURE NextToCorner (x, y: INTEGER): BOOLEAN;
X
XVAR
X empty: BOOLEAN;
X xsearch, ysearch: INTEGER;
X
XBEGIN
X
X empty:= FALSE;
X FOR xsearch:= -1 TO 1 DO
X FOR ysearch:= -1 TO 1 DO
X IF Corner(x + xsearch, y + ysearch) AND
X (field[x + xsearch][y + ysearch]= none) THEN
X empty:= TRUE;
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X
X FOR xsearch:= -1 TO 1 DO
X FOR ysearch:= -1 TO 1 DO
X IF (Corner(x + xsearch, y + ysearch)) AND (NOT Corner(x, y)) AND
X (empty) THEN
X RETURN TRUE;
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X
XRETURN FALSE;
X
XEND NextToCorner;
X
X
X(* TRUE if two pieces away. *)
XPROCEDURE TwoAway (x, y: INTEGER): BOOLEAN;
X
XBEGIN
X
X IF (Corner(x - 2, y )) OR
X (Corner(x - 2, y - 2)) OR
X (Corner(x, y - 2)) OR
X (Corner(x + 2, y )) OR
X (Corner(x + 2, y - 2)) OR
X (Corner(x, y - 2)) OR
X (Corner(x, y + 2 )) OR
X (Corner(x - 2, y + 2)) OR
X (Corner(x - 2, y - 2)) OR
X (Corner(x + 2, y)) OR
X (Corner(x + 2, y + 2)) OR
X (Corner(x, y + 2 )) THEN
X RETURN TRUE;
X END; (* IF *)
X RETURN FALSE;
X
XEND TwoAway;
X
X
X(* Used all of the procedures above to find out the value of any *)
X(* spot on the board. *)
XPROCEDURE Value(player: PIECES; x, y: INTEGER): INTEGER;
X
XVAR
X number: INTEGER;
X dummy : INTEGER;
X WHITE : INTEGER;
X BLACK : INTEGER;
X
XBEGIN
X
X IF Look THEN
X HowMany(player, x, y, dummy, number)
X (* dummy is the number of pieces that can be flipped. *)
X (* number is that plus the weight of the flipped pieces. *)
X ELSE
X Count(WHITE, BLACK);
X HowMany(player, x, y, dummy, number); (* How many will flip *)
X
X (* This area does not take into consideration how many pieces it *)
X (* will flip until there are 30 pieces on thye board. *)
X
X IF WHITE + BLACK < 30 THEN
X number:= number - dummy (* Does not care how many flips. *)
X (* number:= number - (2 * dummy) Goes for least num. *)
X ELSE
X number:= number + dummy;
X END;
X END;
X
X (* Add in the weights for the corners, etc. *)
X IF Corner(x, y) THEN
X number:= number + CORNER;
X END;
X IF Edge(x, y) THEN
X number:= number + EDGE;
X END;
X IF NextToCorner(x, y) THEN
X number:= number - ADJACENT;
X END;
X IF TwoAway(x, y) THEN
X number:= number + TWOAW;
X END;
X RETURN number;
X
XEND Value;
X
X
X(* Used to find the best move. Uses Value and Howmany, plus it *)
X(* looks one move ahead. *)
XPROCEDURE FindBest(player: PIECES; VAR xcords, ycords: INTEGER);
X
XVAR
X x, y : INTEGER; (* Used in FOR loop. *)
X xx, yy: INTEGER; (* Used in FOR loop. *)
X total : INTEGER; (* Total value of current move *)
X value1: INTEGER; (* Value of computers move. *)
X value2: INTEGER; (* Value of humans best counter move *)
X best : INTEGER; (* The highest number so far. *)
X best1 : INTEGER; (* The highest number so far for humans move. *)
X opplayer: PIECES;(* Opponent. *)
X
X
XBEGIN
X
X best := -10000; (* Set low so that any move is better than it. *)
X xcords:= -1;
X
X IF player= black THEN (* Find opposite player. *)
X opplayer:= white
X ELSE
X opplayer:= black;
X END; (* IF *)
X
X FOR x:= 1 TO 8 DO
X FOR y:= 1 TO 8 DO
X IF Validate(player, x, y) THEN (* If valid move. *)
X value1:= Value(player, x, y);
X CopyToTemp; (* Back up play surface. *)
X Look:= TRUE;
X field[x][y]:= player; (* Make theoretical move. *)
X Flip(player, x, y); (* Flip pieces temporarily. *)
X best1 := -10000;
X FOR xx:= 1 TO 8 DO (* Check humans best move *)
X FOR yy:= 1 TO 8 DO
X IF Validate(opplayer, xx, yy) THEN
X value2:= Value(opplayer, xx, yy);
X IF value2 >= best1 THEN (* Get best human move. *)
X best1:= value2;
X END (* IF *)
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X
X total:= (value1 * MULF) - (best1 * 2);
X (* Get the value of a move by *)
X (* finding the weight of the *)
X (* computers best move and then *)
X (* subtract the weight of the *)
X (* humans best opposing move. *)
X
X CopyBack; (* Put the game board back *)
X Look:= FALSE;
X
X (* Find best move. *)
X IF total > best THEN
X best:= total;
X xcords:= x;
X ycords:= y;
X END (* IF *)
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X
X (*
X Position(0, 420); (* Optional: display the weight of the computers *)
X TextSize(5); (* move. *)
X Color("G");
X WriteNum(best);
X Position(0, 420);
X Color("D");
X WriteNum(best);
X TextSize(1);
X Position(180, 180);
X *)
X
XEND FindBest;
X
X
X(******************************************************************)
X(* This procedure allows the computer to make a move. *)
X(* *)
X(* First it finds all valid moves. For each one, it adds up the *)
X(* number of pieces that it will flip for taking this square. *)
X(* If the space it can move to is on the edge, it weighs this *)
X(* more. If it is a corner, it weighs it a lot more. If it is *)
X(* adjacent to a corner, it avoids it. If it is two squares away *)
X(* from a corner, it weighs it more than a side alone. I doesn't *)
X(* avoid the adjacent pieces if the corner is already taken. *)
X(* Note: it takes the above things into account for the pieces *)
X(* that it will flip also. For each valid move, it takes it's *)
X(* best shot at the counter move. It then subtracts the two. *)
X(* eg. If it has to move to a piece adjacent to a corner, it *)
X(* take the one that will give the opponent the least advantage. *)
X(* It will, for example try to keep him from getting the corner. *)
X(* *)
X(******************************************************************)
XPROCEDURE Move (player: PIECES; VAR xcords, ycords: INTEGER);
X
XVAR
X pass : BOOLEAN;
X x, y : INTEGER; (* Used in FOR loop. *)
X number: INTEGER; (* The number of pieces gained for this move. *)
X best : INTEGER; (* The highest number so far. *)
X valid : BOOLEAN;
X Delay : INTEGER;
X
XBEGIN
X
X IF player= white THEN (* Print out whose move it is. *)
X Color('D');
X Position(420, 120);
X WriteText('Blacks move.');
X Color("R");
X Position(420, 120);
X WriteText('Blues move.');
X Position(180, 180);
X ELSE
X Color('D');
X Position(420, 120);
X WriteText('Blues move.');
X Color("R");
X Position(420, 120);
X WriteText('Blacks move.');
X Position(180, 180);
X END; (* IF *);
X
X FindBest(player, xcords, ycords); (* Get the best move. *)
X
X IF xcords > 0 THEN (* If legal move has been found.*)
X field [xcords][ycords]:= player; (* Make it. *)
X flipped[xcords][ycords]:= TRUE;
X Color("R");
X Position((xcords * 50) -20, (ycords * 50) -20);
X SetFill((ycords * 50) - 20);
X Circle(13, 13);
X UnsetFill;
X Passed:= FALSE;
X ELSE (* No legal moves. *)
X Passed:= TRUE;
X xcords:= 1;
X Position(420, 150);
X Position(420, 150);
X Color("G");
X WriteText('I pass.');
X Position(180, 180);
X FOR Delay:= 1 TO 300000 DO
X END;
X Color("D");
X Position(420, 150);
X WriteText('I pass.')
X END; (* IF *)
X
XEND Move;
X
X
X(* TRUE if a player has no legal moves, and can pass. *)
XPROCEDURE CanPass (player: PIECES): BOOLEAN;
X
XVAR
X canpass: BOOLEAN;
X x, y : INTEGER;
X
XBEGIN
X
X canpass:= TRUE;
X FOR x:= 1 TO 8 DO
X FOR y:= 1 TO 8 DO
X IF Validate(player, x, y) THEN (* Just one good move, and you *)
X canpass:= FALSE; (* cannot pass. *)
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X RETURN canpass;
X
XEND CanPass;
X
X
X(* Copies board to temp. Used to make theoretical moves. *)
XPROCEDURE CopyToTemp;
XVAR
X x, y: INTEGER;
X
XBEGIN
X FOR x:= 1 TO 8 DO
X FOR y:= 1 TO 8 DO
X temp[x][y]:= field[x][y];
X END; (* FOR *)
X END; (* FOR *)
XEND CopyToTemp;
X
X
XPROCEDURE CopyBack; (* Replace board. *)
XVAR
X x, y: INTEGER;
X
XBEGIN
X FOR x:= 1 TO 8 DO
X FOR y:= 1 TO 8 DO
X field[x][y]:= temp[x][y];
X END; (* FOR *)
X END; (* FOR *)
XEND CopyBack;
X
X
XEND move.
X
X
X
END_OF_move.mod
if test 21241 -ne `wc -c <move.mod`; then
echo shar: \"move.mod\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f othello.mod -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"othello.mod\"
else
echo shar: Extracting \"othello.mod\" \(11246 characters\)
sed "s/^X//" >othello.mod <<'END_OF_othello.mod'
XIMPLEMENTATION MODULE othello;
X
X(*************************************************************************)
X(* OTHELLO. (c) 1987 Robert Silvers. All rights reserved. *)
X(* *)
X(* This is the main set of routines that runs the othello game. The *)
X(* game is controlled from the driver. The procedures in this section *)
X(* set up the board, get the moves, check if it is valid, if so, flip *)
X(* the pieces. It then counts the pieces, and redraws the board. *)
X(*************************************************************************)
X
XFROM types IMPORT
X PIECES, BOARD, TEMP, field, temp, flipped, Passed;
X
XFROM InOut IMPORT
X Read, WriteInt;
X
XFROM InOutExtensions IMPORT
X GetEscapeSequence, GetOneChar, ReadLn;
X
XFROM regis IMPORT
X Reset, Position, ClearScreen, Plot, DrawTo, Circle, Box, Color, SetFill,
X TextSize, WriteNum, WriteText, UnsetFill, BGColor, TextSlant, WriteChr,
X Scroll, TextDirection;
X
XFROM move IMPORT
X CanPass, Validate, Count, HowMany;
X
X(*************************************************************************)
X(* This function gets the game choice with the opening menu. *)
X(* RETURNS the number of players. *)
X(*************************************************************************)
XPROCEDURE Menu(VAR choice: CHAR);
X
XVAR
X x: INTEGER;
X
XBEGIN
X
X choice:= ' ';
X
X ClearScreen;
X
X (* (* Alternative opening screen *)
X TextSlant(-1);
X Color("R");
X FOR x:= 1 TO 10 BY 2 DO
X Position(80 + (x * 15), x * x * 3);
X TextSize(x);
X WriteText("OTHELLO");
X END;
X TextSlant(0);
X *)
X
X Position(80, 0); (* Draw word OTHELLO 3 times. *)
X TextSize(10);
X Color("R");
X WriteText("OTHELLO");
X
X Position(80, 120);
X TextSize(10);
X Color("G");
X WriteText("OTHELLO");
X
X Position(80, 240);
X TextSize(10);
X Color("B");
X WriteText("OTHELLO");
X
X Position(80, 400);
X Color("G");
X TextSize(2);
X WriteText("Enter the number of players (0-2) : ");
X
X (* Get the number of players. *)
X REPEAT
X Read(choice);
X UNTIL ((choice >= '0') AND (choice <= '2')) OR (choice= 'q');
X
XEND Menu;
X
X
X(*************************************************************************)
X(* This procedure sets all of the places to empty, except the center *)
X(* four. *)
X(*************************************************************************)
XPROCEDURE InitBoard();
X
XVAR x, y: INTEGER;(* Position on the surface.*)
X
XBEGIN
X
X FOR x:= 1 TO 8 DO (* Set all spaces to empty. *)
X FOR y:= 1 TO 8 DO
X field[x][y] := none;
X flipped[x][y]:= FALSE;
X END;
X END;
X
X field [4][4]:= white; (* Put in first four pieces. *)
X field [5][4]:= black;
X field [4][5]:= black;
X field [5][5]:= white;
X
X flipped [4][4]:= TRUE; (* Turn on flipped flag. *)
X flipped [5][4]:= TRUE;
X flipped [4][5]:= TRUE;
X flipped [5][5]:= TRUE;
X
XEND InitBoard;
X
X
X(*************************************************************************)
X(* This procedure draws the opening graphics. *)
X(*************************************************************************)
XPROCEDURE DrawBoard;
X
XVAR
X x, y: INTEGER;
X
XBEGIN
X
X Reset; (* Set all to default. *)
X BGColor('D'); (* Set background to black.*)
X ClearScreen;
X
X Color('B'); (* Draw blue border. *)
X Position(0, 0);
X SetFill(150);
X Box(410, 411);
X UnsetFill;
X
X Color('G'); (* Draw green background. *)
X Position(10, 9);
X SetFill(150);
X Box(390,391);
X UnsetFill;
X
X Color("D"); (* A touch of shadow. *)
X Plot(9, 402);
X DrawTo(399, 402);
X Plot(9, 10);
X DrawTo(9, 402);
X
X
X Color('D'); (* Draw black lines.*)
X FOR x:= 55 TO 400 BY 50 DO
X Plot(x, 9);
X DrawTo(x, 400);
X Plot(409 - x , 9);
X DrawTo(409 - x, 400);
X Plot(9, x);
X DrawTo(400, x);
X Plot(9, 409 - x);
X DrawTo(400, 409- x);
X END; (* FOR *)
X
X Position(419, 3); (* Write OTHELLO *)
X TextSize(5);
X Color('B');
X WriteText('OTHELLO');
X Position(421, 1);
X TextSize(5);
X Color('G');
X WriteText('OTHELLO');
X Position(422, 0);
X TextSize(5);
X Color('R');
X WriteText('OTHELLO');
X
X TextSize(1); (* Give credit where credit is due. *)
X Color('B');
X Position(646, 64);
X TextSlant(-10);
X WriteText('By Robert Silvers');
X TextSlant(0);
X
X Color('R'); (* Write out score board. *)
X Position(420, 90);
X WriteText('Blue: ');
X Position(512, 90);
X WriteText('Black: ');
X
X Color('B'); (* Give basic instructions. *)
X Position(420, 350);
X WriteText('Use arrow keys to move. RETURN to enter.');
X Color('B');
X Position(420, 370);
X WriteText('1 drops a blue, 2 a black, 3 to remove.');
X Color('B'); (* Blue. *)
X Position(420, 390);
X WriteText('Press S to show moves. P to pass.');
X
XEND DrawBoard;
X
X
X(*************************************************************************)
X(* This procedure flips the pieces for the player after a move. *)
X(*************************************************************************)
XPROCEDURE Flip (player : PIECES; xcords, ycords: INTEGER);
X
XBEGIN
X
X Flipper(player, xcords, ycords, 1, 0);
X Flipper(player, xcords, ycords, -1, 0);
X Flipper(player, xcords, ycords, 0, 1);
X Flipper(player, xcords, ycords, 0, -1);
X Flipper(player, xcords, ycords, 1, -1);
X Flipper(player, xcords, ycords, 1, 1);
X Flipper(player, xcords, ycords, -1, 1);
X Flipper(player, xcords, ycords, -1, -1);
X
XEND Flip;
X
X
XPROCEDURE Flipper(player: PIECES; xcords, ycords, xdir, ydir: INTEGER);
X
XVAR
X opplayer: PIECES ; (* The opposite player. *)
X x : INTEGER; (* Used for loop counters. *)
X y : INTEGER;
X foundop : BOOLEAN; (* Found opposite player. *)
X canflip : BOOLEAN; (* TRUE is at least one flip is needed. *)
X founds : BOOLEAN; (* Found space. *)
X foundp : BOOLEAN; (* Found player. *)
X
XBEGIN
X
X IF player= white THEN (* Get the other player's color. *)
X opplayer:= black
X ELSE
X opplayer:= white;
X END;
X
X foundop:= FALSE; (* Flip from right to left and up. *)
X canflip:= FALSE;
X founds := FALSE;
X foundp := FALSE;
X x:= xcords;
X y:= ycords;
X LOOP
X IF (x= 0) OR (y= 0) OR (x= 9) OR (y= 9) THEN
X EXIT;
X END; (* IF *)
X IF (field[x][y]= opplayer) THEN
X foundop:= TRUE;
X END; (* IF *);
X IF ((field[x][y]= none)) AND ((foundop= FALSE) OR
X (foundp= FALSE)) THEN
X founds:= TRUE;
X END; (* IF *);
X IF (field[x][y]= player) AND (foundop) AND (founds= FALSE) THEN
X canflip:= TRUE;
X END; (* IF *);
X x:= x + xdir;
X y:= y + ydir;
X END; (* LOOP *)
X x:= xcords;
X y:= ycords;
X IF canflip THEN
X LOOP
X x:= x + xdir;
X y:= y + ydir;
X IF (x= 0) OR (y= 0) OR (x= 9) OR (y= 9) THEN
X EXIT;
X END; (* IF *)
X IF (field[x][y]= player) THEN
X EXIT;
X END; (* IF *);
X IF (field[x][y]= opplayer) THEN
X field[x][y]:= player;
X flipped[x][y]:= TRUE;
X END; (* IF *);
X END; (* LOOP *)
X END; (* IF *)
X
XEND Flipper;
X
X
X(*************************************************************************)
X(* This procedure updates the board after a move. *)
X(* It used a boolean field to only ReDraw where a piece has been changed.*)
X(*************************************************************************)
XPROCEDURE ReDraw;
X
XVAR
X x : INTEGER; (* Coordinates. *)
X y : INTEGER;
X wnum: INTEGER; (* Number of each player on board. *)
X bnum: INTEGER;
X
XBEGIN
X
X Count(wnum, bnum); (* Update the number of pieces on the screen. *)
X
X Position(470, 90); (* Draw new number of pieces. *)
X Color('D') ;
X SetFill(90);
X Box(20, 15);
X UnsetFill ;
X Color('R') ;
X WriteNum(wnum);
X
X Position(570, 90);
X Color('D') ;
X SetFill(90);
X Box(20, 15);
X UnsetFill ;
X Color('R') ;
X WriteNum(bnum);
X
X FOR y:= 1 TO 8 DO; (* Go to every square and flip if TRUE. *)
X FOR x:= 1 TO 8 DO;
X IF flipped[x][y] = TRUE THEN (* If the piece has changed. *)
X IF field[x][y] = black THEN (* Set color of piece. *)
X Color('D') (* Black. *)
X ELSIF field[x][y] = white THEN
X Color('B') (* Red. *)
X ELSE (* field[x][y]:= none *)
X Color('G'); (* Green. *)
X END; (* IF *)
X Position((x * 50) - 20, (y * 50) - 20); (* Draw circle. *)
X SetFill ((y * 50) - 20);
X Circle(13, 13);
X UnsetFill;
X flipped[x][y]:= FALSE; (* Reset to FALSE *)
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X
XEND ReDraw;
X
X
X(* Shows what moves are open to player. Tells them how many pieces *)
X(* they would get if they move there also. *)
XPROCEDURE ShowMoves(player: PIECES);
X
XVAR
X x, y : INTEGER;
X number: INTEGER; (* Number of flips possible *)
X dummy : INTEGER; (* Absorbs extra parameter. *)
X
XBEGIN
X
X TextSize(1);
X FOR y:= 1 TO 8 DO
X FOR x:= 1 TO 8 DO
X IF Validate(player, x, y) THEN
X Color("R");
X Position((x * 50) -20, (y * 50) - 20);
X SetFill ((y * 50) -20);
X Circle(7, 7); (* Draws red circle where valid. *)
X UnsetFill;
X Color("D");
X HowMany(player, x, y, number, dummy); (* Get number of flips *)
X Position((x * 50) -25, (y * 50) - 28);
X WriteNum(number); (* Display number of flips. *)
X flipped[x][y]:= TRUE;
X END; (* IF *)
X END; (* FOR *)
X END; (* FOR *)
X
XEND ShowMoves;
X
X
X(* Returns TRUE if the game is over. *)
XPROCEDURE GameOver (computer: BOOLEAN): BOOLEAN;
X
XVAR
X whitenum, blacknum: INTEGER; (* Used to see who won. *)
X
XBEGIN
X
X (* Game is over if both players have no moves. *)
X IF CanPass(black) AND CanPass(white) THEN
X Position(420, 150);
X Color("G");
X TextSize(3);
X WriteText("Game Over.");
X TextSize(2);
X Count(whitenum, blacknum);
X IF whitenum > blacknum THEN
X Position(420, 200);
X Color("R");
X WriteText("Blue wins.")
X ELSIF blacknum > whitenum THEN
X Position(420, 200);
X Color("R");
X WriteText("Black wins.");
X IF computer THEN (* Computer played in game. *)
X Color("B");
X TextSize(1);
X Position(420, 240);
X WriteText("Artificial intelligence is better");
X Position(420, 260);
X WriteText("than none at all...");
X
X Color("R"); (* Redraw with different color. *)
X Position(421, 239);
X WriteText("Artificial intelligence is better");
X Position(421, 259);
X WriteText("than none at all...");
X END (* IF *)
X ELSE
X Position(420, 200);
X Color("R");
X WriteText("Its a tie!")
X END; (* IF *)
X Position(180, 180);
X RETURN TRUE (* Game over. *)
X END; (* IF *)
X
X RETURN FALSE; (* Game not over. *)
X
XEND GameOver;
X
X
XEND othello.
X
X
X
END_OF_othello.mod
if test 11246 -ne `wc -c <othello.mod`; then
echo shar: \"othello.mod\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f regis.mod -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"regis.mod\"
else
echo shar: Extracting \"regis.mod\" \(5363 characters\)
sed "s/^X//" >regis.mod <<'END_OF_regis.mod'
XIMPLEMENTATION MODULE regis;
X(* Lo-level ReGIS graphics commands. *)
X
XFROM SysStreams IMPORT sysOut;
XFROM CharCodes IMPORT EscapeCh;
XFROM TextIO IMPORT WriteCHAR;
XFROM InOut IMPORT Write;
XFROM InOut IMPORT WriteInt;
XFROM InOut IMPORT WriteString;
X
X
XPROCEDURE esc; (* Prints an escape character. *)
XBEGIN
X WriteCHAR(sysOut,EscapeCh)
XEND esc;
X
XPROCEDURE ExitGr; (* Exit ReGIS mode. *)
XBEGIN
X esc;
X Write("S");
XEND ExitGr;
X
XPROCEDURE Reset; (* Sets defaults. *)
XBEGIN
X esc;
X WriteString('Pp;S(I0N0A)W(VI7A0S0M1N0P1M2)T(I0A0D0S1)P[0,0]\\');
XEND Reset;
X
XPROCEDURE Position(x,y:INTEGER); (* Position cursor at x, y *)
XBEGIN
X esc;
X WriteString('PpP[');
X WriteInt(x ,1);
X Write(',');
X WriteInt(y,1);
X WriteString(']\\');
XEND Position;
X
XPROCEDURE Circle(x,y:INTEGER); (* Draw circle of width x, hight y. *)
XBEGIN
X esc;
X WriteString('PpC[+');
X WriteInt(x,1);
X WriteString(',+');
X WriteInt(y,1);
X WriteString(']\\');
XEND Circle;
X
XPROCEDURE Arc(x,y,angle:INTEGER); (* Draw an arc. *)
XBEGIN
X esc;
X WriteString('PpC(A');
X WriteInt(angle,1);
X WriteString(')[');
X
X IF x >=0 THEN
X Write('+');
X WriteInt(x, 1);
X ELSE
X Write('-');
X WriteInt(-x, 1);
X END;
X IF y >=0 THEN
X Write('+');
X WriteInt(y, 1);
X WriteString(']\\');
X ELSE
X Write('-');
X WriteInt(-y, 1);
X WriteString(']\\');
X END;
XEND Arc;
X
XPROCEDURE Pattern(p:String);
XBEGIN
X esc;
X WriteString('PpW(P"');
X WriteString(p);
X WriteString('")\\');
XEND Pattern;
X
XPROCEDURE Plot(x,y:INTEGER); (* Draw one pixel. *)
XBEGIN
X Position(x,y);
X esc;
X WriteString('PpV[]\\');
XEND Plot;
X
XPROCEDURE DrawTo(x,y:INTEGER); (* Used after other command, draws line *)
XBEGIN
X esc;
X WriteString('PpV[');
X WriteInt(x, 1);
X Write(',');
X WriteInt(y, 1);
X WriteString(']\\');
XEND DrawTo;
X
XPROCEDURE Color(colr: CHAR); (* Use R(ed), G(reen), B(lue), or D(ark). *)
XBEGIN
X esc;
X WriteString('Pp W(I(H');
X Write(colr);
X WriteString('))\\');
XEND Color;
X
XPROCEDURE Box(width, height: INTEGER);
XBEGIN
X esc;
X WriteString('PpV[+');
X WriteInt(width, 1);
X WriteString(',+');
X WriteInt(0, 1);
X WriteString(']\\');
X WriteString('PpV[+');
X WriteInt(0, 1);
X WriteString(',+');
X WriteInt(height, 1);
X WriteString(']\\');
X WriteString('PpV[-');
X WriteInt(width, 1);
X WriteString(',+');
X WriteInt(0, 1);
X WriteString(']\\');
X WriteString('PpV[+');
X WriteInt(0, 1);
X WriteString(',-');
X WriteInt(height, 1);
X WriteString(']\\');
XEND Box;
X
XPROCEDURE Scroll(dx,dy:INTEGER);
XBEGIN
X esc;
X WriteString('PpS[+');
X WriteInt(dx, 1);
X WriteString(',+');
X WriteInt(dy, 1);
X WriteString(']\\')
XEND Scroll;
X
XPROCEDURE ClearScreen; (* Clears graphic screen *)
XBEGIN
X esc;
X WriteString('PpS(E)\\');
XEND ClearScreen;
X
XPROCEDURE WriteText(message: String);
XBEGIN
X esc;
X WriteString('PpT"');
X WriteString(message);
X WriteString('"\\');
XEND WriteText;
X
XPROCEDURE WriteNum(num : INTEGER);
XBEGIN
X esc;
X WriteString('PpT"');
X WriteInt(num, 1);
X WriteString('"\\');
XEND WriteNum;
X
XPROCEDURE WriteChr(chr : CHAR);
XBEGIN
X esc;
X WriteString('PpT"');
X Write(chr);
X WriteString('"\\');
XEND WriteChr;
X
XPROCEDURE TextDirection(angle: INTEGER); (* Write vertically, etc. *)
XBEGIN
X esc;
X WriteString('PpT(D');
X WriteInt(angle, 1);
X WriteString(')\\');
XEND TextDirection;
X
XPROCEDURE TextSlant(angle: INTEGER); (* -10 slants to right. *)
XBEGIN
X esc;
X WriteString('PpT(I');
X WriteInt(angle, 1);
X WriteString(')\\');
XEND TextSlant;
X
XPROCEDURE TextSize(size: INTEGER); (* 2 doubles size. *)
XBEGIN
X esc;
X WriteString('PpT(S');
X WriteInt(size, 1);
X WriteString(')\\');
XEND TextSize;
X
X(*
XPROCEDURE TextMatrixSize(x,y:INTEGER);
XBEGIN
X esc;
X WriteF2(sysOut,'PpT(S[%d,%d])\\',x,y);
XEND TextMatrixSize;
X
XPROCEDURE TextPixelMultiply(x,y:INTEGER);
XBEGIN
X esc;
X WriteF2(sysOut,'[PpT(M[%d,$d])\\',x,y);
XEND TextPixelMultiply;
X
XPROCEDURE TextAttributes(Width,Height,xMult,yMult,xDir,yDir,Slant : INTEGER);
XBEGIN
X WriteF0(sysOut,'PpT(S[%d,%d] M[%d,%d] I%d ) [%d,%d]',
X Width,Height,xMult,yMult,Slant,xDir,yDir);
XEND TextAttributes;
X
XPROCEDURE TextSpacing(dx,dy:INTEGER);
XBEGIN
X esc;
X WriteF2(sysOut,'Pp[%d,%d]\\',dx,dy);
XEND TextSpacing;
X
XPROCEDURE SelectCharSet(n : INTEGER);
XBEGIN
X esc;
X WriteF1(sysOut,'PpT(A%d)\\',n);
XEND SelectCharSet;
X
XPROCEDURE RedefineChar(Cset : INTEGER; c : CHAR; pattern : String);
XVAR i : INTEGER;
XBEGIN
X esc;
X WriteF2(sysOut,'PpL(A%d) ''%c'' ',Cset,c);
X FOR i:= 0 to high(pattern) DO
X esc;
X WriteF1(sysOut,'%c',pattern[i]);
X END;
X esc;
X WriteF0(sysOut,'\\');
XEND RedefineChar;
X*)
X
XPROCEDURE SetFill(y: INTEGER); (* Turns on fill at y. *)
XBEGIN
X esc;
X WriteString('PpW(S1)(S[,');
X WriteInt(y,1);
X WriteString(';])\\');
XEND SetFill;
X
X(*
XPROCEDURE SetFillChar(c: CHAR; y:INTEGER);
XBEGIN
X esc;
X WriteF2(sysOut,'PpW(S''%c''[,%d])\\',c,y);
XEND SetFillChar;
X*)
X
XPROCEDURE UnsetFill; (* Turns off fill. *)
XBEGIN
X esc;
X WriteString('PpW(S0)\\');
XEND UnsetFill;
X
XPROCEDURE BGColor(colr:CHAR); (* Back ground color. *)
XBEGIN
X esc;
X WriteString('PpS(I(H');
X Write(colr);
X WriteString('))\\');
XEND BGColor;
X
XPROCEDURE NormalText;
XBEGIN
X esc;
X WriteString('PpT(E)\\');
XEND NormalText;
X
X
XEND regis.
X
X
END_OF_regis.mod
if test 5363 -ne `wc -c <regis.mod`; then
echo shar: \"regis.mod\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f types.def -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"types.def\"
else
echo shar: Extracting \"types.def\" \(1459 characters\)
sed "s/^X//" >types.def <<'END_OF_types.def'
XDEFINITION MODULE types;
X
X(***************************************)
X(* *)
X(* Othello. By Robert Silvers. 1987. *)
X(* *)
X(***************************************)
X
XFROM Goto IMPORT
X GotoLabel;
X
XEXPORT QUALIFIED
X PIECES, BOARD, TEMP, field, temp, flipped, Passed, oldvalue, End;
X
XTYPE
X PIECES= (black, white, none); (* Game pieces & player types. *)
X BOARD = ARRAY[1..8],[1..8] OF PIECES; (* Main arena. *)
X TEMP = ARRAY[1..8],[1..8] OF BOOLEAN; (* Keeps tract of what needs *)
X (* to be flipped. *)
X
X(*************************************************************************)
X(* The temp board is used to look ahead one move. The computer makes *)
X(* your best move on this board after he has made his move. It is like *)
X(* War Games, where the computer tries all different senerios to find *)
X(* the best one. He then makes his move one the real board. *)
X(*************************************************************************)
X
XVAR
X field : BOARD; (* The play surface. *)
X temp : BOARD; (* A temperary surface used to back *)
X (* up the real board during look-ahead. *)
X flipped: TEMP; (* TRUE for newly flipped pieces. *)
X Passed : BOOLEAN; (* TRUE if a player has passed. *)
X oldvalue: INTEGER;
X End : GotoLabel;
X
X
XEND types.
X
END_OF_types.def
if test 1459 -ne `wc -c <types.def`; then
echo shar: \"types.def\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 1 \(of 2\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked both archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0