program othello; {The following program incorporates data structures and game strategies to produce a computerized version of othello (reversi) for educational and entertainment purposes. This program was originally written on turbo pascal 4.0 but is fully compatable with 5.0 and all IBM PC compatable computers. Editing Programmer : Erich J Spengler. Programmers : Andy Collinson, Mark Bensley, Brett Bensley Karla Richter, Erich Spengler. Procedure Programmers : 1) Erich J Spengler : cursor, set_window, print_menu, print_board_frame, count, finalcount, print_board, init_game, reverse_board, findmoves, value_print, locate_square, getcoord, ((((chk_A_add, recommend, lookahead---- replaced by Karla's lookahead)))), first_move, second_move_1, second_move_2, deter_winner, check_game_done, pick_option, execute_first_move, execute_second_move, terminate_game, Main-Routine. (many of the above came from reference material) 2) Andy Collinson : initweigharray, findbestmove. 3) Mark Bensley : makemoves, getcoord. 4) Brett Bensley : unmove, title_and_instructions, getcoord. 4) Karla Richter : LookAhead( Can be beaten in 8 moves every time???? ). Cooperation Time : Andy - 4.0 Hours. (Time spent with Mark - 4.0 Hours. Editor) Brett - 4.0 Hours. Karla - 1.0 Hours. } uses crt, { standard i/o } dos; { for register manipulation } type string2 = string[2]; {string type of length 2} makmovetype = record {record type containing..} imm, {..a single move} jmm : shortint; end; squaretype = record {record type containing..} data : shortint; {..data in each board square} end; possmvsrectype = record {record type containing..} row, {..possible moves and..} col, {..corresponding flips} nflps : shortint; end; bestmvetype = record {record type containing..} xcoord, {..best move and board value} ycoord, val : longint; end; on_off_type = (on,off); {on,off switch type} movetype = (good,bad); {good or bad move type} playtype = (first,second); {which player is moving} coordstatustype= (ok,non_avail); {status for empty board square} actiontype = (save,return); {choice for saving a board} gamestatus = (first_win,second_win,tie,continue); {type for who wins} a1type = array[1..8] of shortint; a2type = array[1..10,1..10] of shortint; a3type = array[1..10,1..10] of squaretype; a4type = array[1..30] of possmvsrectype; a5type = array[2..9,2..9] of shortint; xorbtype = a1type; {type for x board orbiting} yorbtype = a1type; {type for y board orbiting} flparrytype = a2type; {array for temp storage of flips} boardarrytype = a3type; {board storage array} posmvarrytype = a4type; {possible move storage} weigharraytype = a5type; {weight of possible moves storage} const empty = ' '; {empty color} firstchr = '°°'; {first piece color} secondchr = 'ÛÛ'; {second piece color} firstnum = 1; {first number} secondnum = -1; {second number} var ch : char; {keyboard character} xorb : a1type; {x orbiting array} yorb : a1type; {y orbiting array} play_1, {boolean for one or two players} quit, {for quitting game} pass, {for passing turn} done : boolean; {when game is done} level : integer; {level of computer tree search} play : playtype; {which player is playing} game : gamestatus; {what status game is in} board, {playing board} board2, {tree searching board} tempboard, {tempoary boards 1-3} tempboard2, tempboard3 : boardarrytype; weigharr : weigharraytype; {weight array for move value} {************************ PASCAL CODE FOR OTHELLO ***************************} procedure cursor(stype:char;switch:on_off_type); {shuts off or on cursor using interrupt and register change} var regs : registers; begin with regs do begin ah := $01; if switch = on then {turn on} begin case stype of 'M' : begin {for mono board} ch := 12; cl := 13; end; {for color board} 'C' : begin ch := 6; cl := 7; end; else ; end; end else begin case stype of {turn off} 'M' : begin {for mono board} ch := 14; cl := 14; end; 'C' : begin {for color board} ch := 8; cl := 8; end; else ; end; end; end; intr($10,regs); {call interrupt} end; procedure title_and_instructions; {print title page and game instructions} var inccount : 2..24; key : string; begin clrscr; write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); for inccount := 2 to 23 do write('º º'); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ'); gotoxy(34,2); write(' ºÊÊʺ '); gotoxy(34,3); write('ÉÍÍÊ» ÉÊËÍ» '); gotoxy(34,4); write('º ͹ º º º '); gotoxy(34,5); write('º ͹ º Ð º '); gotoxy(34,6); write('ÈÍÍÍÊÍÊÍÍͼ'); highvideo; gotoxy(19,8); write('ÛÛÛÛÛ ÛÛÛÛÛ Û Û ÛÛÛÛÛ Û Û ÛÛÛÛÛ (R)'); gotoxy(19,9); write('Û±±±Û± ±Û±±±Û± Û±Û±±±±±Û± Û± Û±±±Û±'); gotoxy(19,10); write('Û± Û± Û± ÛÛÛÛ±ÛÛÛÛ Û± Û± Û± Û±'); gotoxy(19,11); write('Û± Û± Û± Û±±Û±Û±±±± Û± Û± Û± Û±'); gotoxy(19,12); write('ÛÛÛÛÛ± Û± Û± Û±ÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛ±'); gotoxy(19,13); write(' ±±±±± ± ± ± ±±±±± ±±±±± ±±±±± ±±±±±'); gotoxy(15,15); lowvideo; write('Produced by students of MAT 4870 "Data Structures"'); gotoxy(18,16); write('Eastern Illinois University, Charleston, IL'); gotoxy(31,17); write('Fall Semester 1988'); gotoxy(14,20); write('(R) Registered Trademark of Gabriel Industries, Inc.'); gotoxy(22,22); write('(C) Game Copyright MCMLXXVII Gabriel'); gotoxy(26,24); highvideo; textattr := textattr+128; write(' Press any key to continue. '); normvideo; gotoxy(19,12); repeat until keypressed; key := readkey; clrscr; writeln('Rules :'); writeln; writeln('1. Black moves first.'); writeln; writeln('2. A move consists of "outflanking" (border a row of your opponent',chr(39),'s disc(s)'); writeln(' with your discs) your opponent',chr(39),'s disc(s) to flip the outflanked disc(s) to'); writeln(' your color.'); writeln; writeln('3. If a player cannot outflank and flip at least one opponent',chr(39),'s disc, the'); writeln(' turn is forfeited and the opponent moves again.'); writeln; writeln('4. A disc may outflank any number of discs in one or more rows.'); writeln; writeln('5. A disc may outflank in any direction: horizontal, vertical, diagonal.'); writeln; writeln('6. A disc may outflank in any number of directions at the same time.'); writeln; writeln('7. A disc may only be outflanked as a direct result of a move and must fall'); writeln(' in the direct line of the disc placed down.'); writeln; writeln('8. The game is over when either no more moves can be made by either player,'); writeln(' or you quit the game.'); writeln; writeln('9. The player with the most discs of his or her color wins.'); gotoxy(26,1); highvideo; textattr := textattr+128; write(' Press any key to continue. '); normvideo; repeat until keypressed; key := readkey; lowvideo; clrscr; end; procedure set_window(x1,y1,x2,y2:shortint); {draw a two bar frame window around given coordinates} const ulc = #201; {upper left corner} hb = #205; {horiz bar} urc = #187; {upper right corner} vb = #186; {vert bar} llc = #200; {lower left corner} lrc = #188; {lower right corner} var i : shortint; {loop variable} begin gotoxy(x1+1,y1); write(ulc); for i := x1+1 to x2-2 do {draw top} write(hb); write(urc); for i := y1+1 to y2-3 do begin gotoxy(x1+1,i);write(vb); {draw vert sides} gotoxy(x2,i);write(vb); end; gotoxy(x1+1,y2-2); write(llc); for i := x1+1 to x2-2 do {draw bottom} write(hb); write(lrc); end; procedure print_menu; {draw menu to choose in-play game options} begin set_window(3,2,37,7); gotoxy(4,6); write(' Message Block '); gotoxy(4,8); write('< Move Selector Using Arrow Keys. >'); gotoxy(4,9); write('< Choose Option Before Moving. >'); gotoxy(6,11); write('Game Options'); gotoxy(11,12); write('During Play :'); gotoxy(8,14); write('(Q)uit : End Game.'); {quit} gotoxy(8,16); write('(P)ass : Pass Turn.'); {pass} gotoxy(8,18); write('(U)ndo : Undo Last Move.'); {undo move} gotoxy(8,20); write('(S)witch : Change Players.'); {reverse board} gotoxy(8,22); write('(H)int : Hint From Computer.'); {give player hint} end; procedure print_board_frame; {print playing board on the screen - this is only done once} var x, y : shortint; begin print_menu; set_window(1,1,80,25); {draw screen frame} gotoxy(49,3); write(firstchr,' ','Player #1 Score : '); gotoxy(49,5); write(secondchr,' ','Player #2 Score : '); x := 40; y := 7; gotoxy(x,y); write('ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍ͹'); gotoxy(x,y+1); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+2); write('ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄĶ'); gotoxy(x,y+3); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+4); write('ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄĶ'); gotoxy(x,y+5); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+6); write('ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄĶ'); gotoxy(x,y+7); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+8); write('ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄĶ'); gotoxy(x,y+9); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+10); write('ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄĶ'); gotoxy(x,y+11); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+12); write('ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄĶ'); gotoxy(x,y+13); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+14); write('ÇÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄÄÅÄÄÄĶ'); gotoxy(x,y+15); write('º ³ ³ ³ ³ ³ ³ ³ º'); gotoxy(x,y+16); write('ÊÍÍÍÍÏÍÍÍÍÏÍÍÍÍÏÍÍÍÍÏÍÍÍÍÏÍÍÍÍÏÍÍÍÍÏÍÍÍͼ'); end; procedure unmove(var board,tempboard:boardarrytype;action:actiontype); {save or return a board into or from another board} var x,y : shortint; begin if action = save then begin for x := 1 to 10 do for y := 1 to 10 do tempboard[x,y].data := board[x,y].data; end else begin for x := 1 to 10 do for y := 1 to 10 do board[x,y].data := tempboard[x,y].data; end; end; procedure count(board:boardarrytype;var game:gamestatus); {count pieces of each player and set game to whos winning} var i, j, {loop variables} ply_pieces, {first players pieces} cmp_pieces : shortint; {second players pieces} begin ply_pieces := 0; cmp_pieces := 0; for i := 2 to 9 do for j := 2 to 9 do with board[i,j] do begin if data = 1 then inc(ply_pieces) else if data = -1 then inc(cmp_pieces); end; if ply_pieces + cmp_pieces = 64 then {check total pieces} if ply_pieces > cmp_pieces then {compare....} game := first_win else if ply_pieces < cmp_pieces then game := second_win else if ply_pieces=cmp_pieces then game := tie; if ply_pieces + cmp_pieces <> 64 then if (ply_pieces=0) then game := second_win else if (cmp_pieces=0) then game := first_win else game := continue; end; procedure finalcount(board:boardarrytype; var ply_pieces,cmp_pieces:shortint); {count each number of players in a given board} var i,j : shortint; {loop variables} begin ply_pieces := 0; cmp_pieces := 0; for i := 2 to 9 do {loop until board counted} for j := 2 to 9 do with board[i,j] do begin if data = 1 then inc(ply_pieces) else if data = -1 then inc(cmp_pieces); end; end; procedure print_board(board:boardarrytype;var game:gamestatus); {print board and current scores for each player} var i, j, x, y, plyscr, cmpscr : shortint; {board values and loop variables} chstr : string2; begin x := 42; y := 8; plyscr := 0; cmpscr := 0; for i := 2 to 9 do begin for j := 2 to 9 do begin with board[i,j] do begin if data = 0 then chstr := empty else if data = -1 then begin chstr := secondchr; inc(cmpscr); end else if data = 1 then begin chstr := firstchr; inc(plyscr); end; gotoxy(x,y); write(chstr); x := x + 5; end; end; x := 42; y := y+2; end; gotoxy(70,3); {write scores} write(plyscr:2); gotoxy(70,5); write(cmpscr:2); end; procedure initweigharray(var weigharr:weigharraytype); {initialize weight array for board values during computer play} {each square is given a special strategy weight} begin weigharr[2,2] := 26 ;weigharr[2,3] := 1 ;weigharr[2,4] := 17; weigharr[2,5] := 15 ;weigharr[2,6] := 15 ;weigharr[2,7] := 17; weigharr[2,8] := 1 ;weigharr[2,9] := 26 ;weigharr[3,2] := 1; weigharr[3,3] := 1 ;weigharr[3,4] := 5 ;weigharr[3,5] := 6; weigharr[3,6] := 6 ;weigharr[3,7] := 5 ;weigharr[3,8] := 1; weigharr[3,9] := 1 ;weigharr[4,2] := 17 ;weigharr[4,3] := 5; weigharr[4,4] := 8 ;weigharr[4,5] := 9 ;weigharr[4,6] := 9; weigharr[4,7] := 8 ;weigharr[4,8] := 5 ;weigharr[4,9] := 17; weigharr[5,2] := 15 ;weigharr[5,3] := 6 ;weigharr[5,4] := 9; weigharr[5,7] := 9 ;weigharr[5,8] := 6 ;weigharr[5,9] := 15; weigharr[6,2] := 15 ;weigharr[6,3] := 6 ;weigharr[6,4] := 9; weigharr[6,7] := 9 ;weigharr[6,8] := 6 ;weigharr[6,9] := 15; weigharr[7,2] := 17 ;weigharr[7,3] := 5 ;weigharr[7,4] := 8; weigharr[7,5] := 9 ;weigharr[7,6] := 9 ;weigharr[7,7] := 8; weigharr[7,8] := 5 ;weigharr[7,9] := 17 ;weigharr[8,2] := 1; weigharr[8,3] := 1 ;weigharr[8,4] := 5 ;weigharr[8,5] := 6; weigharr[8,6] := 6 ;weigharr[8,7] := 5 ;weigharr[8,8] := 1; weigharr[8,9] := 1 ;weigharr[9,2] := 26 ;weigharr[9,3] := 1; weigharr[9,4] := 17 ;weigharr[9,5] := 15 ;weigharr[9,6] := 15; weigharr[9,7] := 17 ;weigharr[9,8] := 1 ;weigharr[9,9] := 26; end; procedure init_game(var board:boardarrytype); {initialize game and all necessary variables} var e : integer; {error code for val call} i, j, {loop variables} plyscr, {players score} num_play, {number of players} cmpscr : shortint; {second players score} begin clrscr; {clear screen} randomize; {have extra ramdom numbers if needed} quit:=false; {set quit to false} pass:=false; {set pass to false} done := false; {set done to no} game := continue; {let game continue} cursor('M',off); {shut off cursor} cursor('M',off); {just making sure} title_and_instructions; {print title page and instructions} initweigharray(weigharr); {initialize weight array} {initialize orbit arrays} xorb[1] := -1;xorb[2] := -1;xorb[3] := 0;xorb[4] := 1; yorb[1] := 0;yorb[2] := 1;yorb[3] := 1;yorb[4] := 1; xorb[5] := 1;xorb[6] := 1;xorb[7] := 0;xorb[8] := -1; yorb[5] := 0;yorb[6] := -1;yorb[7] := -1;yorb[8] := -1; {set board pieces to blank} for i := 1 to 10 do begin for j := 1 to 10 do begin with board[i,j] do begin data := 0; end; end; end; plyscr := 2; {initialize player 1 score} cmpscr := 2; {initialize player 2 score} board[5,5].data := 1; {first initialization} board[6,6].data := 1; board[5,6].data := -1; {second initialization} board[6,5].data := -1; unmove(board,tempboard,save); {set temporary boards to original} unmove(board,tempboard2,save); unmove(board,tempboard3,save); for i := 1 to 10 do begin {set boarder of board...} with board[1,i] do {...values to 2} data := 2; with board[10,i] do data := 2; with board[i,1] do data := 2; with board[i,10] do data := 2; end; print_board_frame; {print board frame} print_board(board,game); {print board} gotoxy(6,3); write('Enter # of Players (1,2) : '); {ask number of players} repeat {read in # of players} gotoxy(33,3); write(' '); gotoxy(33,3); read(ch); until ch in ['1'..'2']; val(ch,num_play,e); {change character to numeric} gotoxy(6,3); write(' ':30); case num_play of {set boolean for player #} 1 : play_1 := true; 2 : play_1 := false; end; if play_1 then {if computer plays set level} begin gotoxy(6,3); write('Enter Play Level (1-4) : '); repeat gotoxy(31,3); {read in player level} write(' '); gotoxy(31,3); read(ch); until ch in ['1'..'4']; val(ch,level,e); {change char to numeric} gotoxy(6,3); write(' ':30); case level of {set level of tree search} 1 : level := 0; {*****no pruning procedure,...} 2 : level := 1; {...therefore a search greater than 3...} 3 : level := 2; {...takes an extremely long time...} 4 : level := 3; {...but lookahead does not work...} end {...correctly at search level 3********} end else {should never leave un set variables} level:=1; {else set level to 1} end; procedure reverse_board(var board:boardarrytype); {procedure will reverse a given board} var i, j : shortint; value : shortint; begin for i := 2 to 9 do {loop through board} begin for j := 2 to 9 do begin with board[i,j] do begin if data=-1 then value := 1 {switch numbers of board} else if data=1 then value := -1 else value := 0; data := value; end; end; end; print_board(board,game); {print reversed board} gotoxy(6,4); {goto message block for message set up} end; procedure findmoves(board:boardarrytype;player:shortint; var possmvs : posmvarrytype); {find all possible moves for a given player and then load an array with those moves and corresponding possible flips} {this will be done by using the orbit arrays to circle around and search all possible directions until a move is found to be good or bad} var i, j, k, {loop variables} x, y, z, {more loop variables} nflips, {flips possible for each move} mvi, mvj, {move values for directional search} imov, jmov, {temp values for mvi and mvj} value : shortint; {value of board piece} done : boolean; {indicates end of directional search} move : movetype; {type set if move is good} flipcnt : flparrytype; {array of flips for each direction} begin count(board,game); if game <> continue then done := true else begin for i := 1 to 30 do {set possible array to 0} with possmvs[i] do begin row := 0; col := 0; nflps := 0; end; for i := 1 to 10 do {set flip array to 0} for j := 1 to 10 do flipcnt[i,j]:=0; for i := 2 to 9 do {use 2 loops to cover all moves} begin for j := 2 to 9 do begin with board[i,j] do {extract value from board} value := data; if value = player then {check value of player} begin for k := 1 to 8 do {search 8 poss directions} begin move := bad; {initialize move to bad} mvi := i + xorb[k];{go first direction} mvj := j + yorb[k];{go second direct} with board[mvi,mvj] do {get value from direction search} value := data; {make sure it is a good direct} if value = -(player) then begin {set flip counter to one} nflips := 1; {repeat search until move is over } repeat {continue to scan} mvi := mvi + xorb[k]; mvj := mvj + yorb[k]; {get next square value} with board[mvi,mvj] do {if value is 0 then a move can be made} value := data; if value = 0 then begin {set move to good} done := true; {indicate done with search for direction} move := good; {reset to original square for next search} imov := mvi; jmov := mvj; end {if value is still opposite of ...} else if value = -(player) then {...player, continue to search} begin done := false; move := bad; inc(nflips); end {if value is not good then move is bad} else if (value=player) or (value=2) then begin done := true; move := bad; end; until done; end; {if move is good load into array} if move = good then flipcnt[imov,jmov]:= flipcnt[imov,jmov] + nflips; end; end; end; end; z := 0; for x := 1 to 10 do {load possible move array} for y := 1 to 10 do if flipcnt[x,y] <> 0 then begin z := z+1; with possmvs[z] do begin row := x; col := y; nflps := flipcnt[x,y]; end; end; end; end; procedure findbestmove(var value:bestmvetype; possmvs:posmvarrytype; board:boardarrytype;whosturn:integer); {using weight array, find the best possible move} var finalval, tempvalue, row1, col1, nflps1, i : integer; begin if whosturn = board[2,2].data then begin weigharr[2,3] := 10; weigharr[3,2] := 10; weigharr[3,3] := 10; end; if whosturn = board[2,9].data then begin weigharr[2,8] := 10; weigharr[3,8] := 10; weigharr[3,9] := 10; end; if whosturn = board[9,2].data then begin weigharr[8,2] := 10; weigharr[8,3] := 10; weigharr[9,3] := 10; end; if whosturn = board[9,9].data then begin weigharr[8,8] := 10; weigharr[8,9] := 10; weigharr[9,8] := 10; end; value.xcoord := 0; value.ycoord := 0; value.val := 0; i := 1; while possmvs[i].nflps <> 0 do begin row1 := possmvs[i].row; col1 := possmvs[i].col; nflps1 := possmvs[i].nflps; tempvalue := weigharr[row1,col1] + nflps1; if tempvalue > value.val then begin value.val := tempvalue; value.xcoord := possmvs[i].row; value.ycoord := possmvs[i].col; end; i := i + 1; end; end; PROCEDURE MAKEMOVES(MAKMOVE:MAKMOVETYPE; VAR BOARD:BOARDARRYTYPE;ITEM:SHORTINT); {make a given move and flip all corresponding pieces} TYPE DIAGONALNEGTYPE=2..20; DIAGONALPOSTYPE=-9..9; VAR I2,I1,{USE FOR INCREMENTS} POSHORZ,POSVERT, TEMPORARYHORZ, TEMPORARYVERT, TEMPORARYITEM:SHORTINT; DIAGONALNEG:DIAGONALNEGTYPE; DIAGONALPOS:DIAGONALPOSTYPE; ITEMINDICATOR:BOOLEAN; BEGIN POSHORZ := MAKMOVE.IMM; POSVERT := MAKMOVE.JMM; IF (POSHORZ>1) AND (POSHORZ<10) {MAKES SURE THE POSITION IS} AND (POSVERT>1) AND (POSVERT<10) THEN {ON THE BOARD. } BEGIN IF ITEM=-1 THEN {TEMPORARILY STORES VALUE OF} TEMPORARYITEM := 1 {OPPOSITE COLOR FOR LATER } ELSE {REFERENCE } TEMPORARYITEM := -1; {END IF THEN} I2 := -1; WHILE I2<2 DO {CHECKS HORIZONTAL TO SEE IF ANY PIECES} BEGIN {CAN BE FLIPPED. } ITEMINDICATOR := FALSE; TEMPORARYHORZ := POSHORZ+I2; WHILE BOARD[TEMPORARYHORZ,POSVERT].DATA =TEMPORARYITEM DO BEGIN TEMPORARYHORZ := TEMPORARYHORZ+I2; ITEMINDICATOR := TRUE; END;{WHILE} IF (ITEMINDICATOR AND (BOARD[TEMPORARYHORZ,POSVERT].DATA =ITEM)) THEN BEGIN {MAKE FLIP} I1 := POSHORZ; WHILE I1<>TEMPORARYHORZ DO BEGIN BOARD[I1,POSVERT].DATA := ITEM; I1 := I1+I2; END;{WHILE} END;{IF THEN} I2 := I2+2; END;{WHILE} I2 := -1; WHILE I2<2 DO {CHECKS VERTICAL TO SEE IF ANY} BEGIN {PIECES CAN BE FLIPPED. } TEMPORARYVERT := POSVERT+I2; ITEMINDICATOR := FALSE; WHILE BOARD[POSHORZ,TEMPORARYVERT].DATA =TEMPORARYITEM DO BEGIN TEMPORARYVERT := TEMPORARYVERT+I2; ITEMINDICATOR := TRUE; END;{WHILE} IF (ITEMINDICATOR AND (BOARD[POSHORZ,TEMPORARYVERT].DATA=ITEM)) THEN BEGIN {MAKE FLIP} I1 := POSVERT; WHILE I1<>TEMPORARYVERT DO BEGIN BOARD[POSHORZ,I1].DATA := ITEM; I1 := I1+I2; END;{WHILE} END;{IF THEN} I2 := I2+2; END;{WHILE} DIAGONALPOS := POSHORZ-POSVERT; I2 := -2; WHILE I2<3 DO {CHECKS NEGHTIVE DIAGONAL TO SEE IF ANY} BEGIN {PIECES CAN BE FLIPPED. } DIAGONALNEG := POSHORZ+POSVERT+I2; ITEMINDICATOR := FALSE; WHILE BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2) ,((DIAGONALNEG-DIAGONALPOS) DIV 2)]. DATA=TEMPORARYITEM DO BEGIN DIAGONALNEG := DIAGONALNEG+I2; ITEMINDICATOR := TRUE; END;{WHILE} IF (ITEMINDICATOR AND (BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2), ((DIAGONALNEG-DIAGONALPOS) DIV 2)].DATA=ITEM)) THEN BEGIN {MAKE FLIP} I1 := POSHORZ+POSVERT; WHILE I1<>DIAGONALNEG DO BEGIN BOARD[((I1+DIAGONALPOS) DIV 2),((I1- DIAGONALPOS) DIV 2)]. DATA := ITEM; I1 := I1+I2; END;{WHILE} END;{IF THEN} I2 := I2+4; END;{WHILE} DIAGONALNEG := POSHORZ+POSVERT; I2 := -2; WHILE I2<3 DO {CHECKS POSITIVE DIAGONAL TO SEE} BEGIN {IF ANY PIECES CAN BE FLIPPED. } DIAGONALPOS := POSHORZ-POSVERT+I2; ITEMINDICATOR := FALSE; WHILE BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2),((DIAGONALNEG-DIAGONALPOS) DIV 2)].DATA=TEMPORARYITEM DO BEGIN DIAGONALPOS := DIAGONALPOS+I2; ITEMINDICATOR := TRUE; END;{WHILE} IF (ITEMINDICATOR AND (BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2), ((DIAGONALNEG-DIAGONALPOS) DIV 2)] .DATA=ITEM)) THEN BEGIN {MAKE FLIP} I1 := POSHORZ-POSVERT; WHILE I1<> DIAGONALPOS DO BEGIN BOARD[((DIAGONALNEG+I1) DIV 2),((DIAGONALNEG -I1) DIV 2)].DATA := ITEM; I1 := I1+I2; END;{WHILE} END;{IF THEN} I2 := I2+4; END;{WHILE} END;{IF THEN} END;{PROCEDURE} procedure value_print(value:bestmvetype;possmvs:posmvarrytype); {special proc for debugging, will print all poss moves and best move} var i,j:integer; {loop variables} begin {blank out section of screen} for i := 10 to 25 do begin gotoxy(5,i); write(' ':33); end; j:=1; {set increment variables} i:=10; gotoxy(5,9); write('mvs & flips'); while possmvs[j].nflps<>0 do begin gotoxy(5,i); with possmvs[j] do write(row,' ',col,' ',nflps); {write move and # of flips} inc(i); {increment loop variables} inc(j); end; gotoxy(20,9); write('best move & value'); gotoxy(20,10); with value do write(xcoord,' ',ycoord,' ',val); {print best move } end; procedure locate_square(var x,y:shortint;var coordstatus:coordstatustype; var findempty:boolean;board:boardarrytype; player:shortint); {locate an open square on the board and write a char in it} var i, j, temparrw, xarrw, yarrw, tempx, tempy, value1, tempplay : shortint; {loop and tempory values} playchr, tempplaychr : string2; {character being played} possmvs : posmvarrytype; {possible move array} value : bestmvetype; {value for best possibla move} begin xarrw := 42; {indicate who's turn in message block} tempplay := player; if player = 1 then begin tempplaychr := '°°'; yarrw := 3; temparrw := 5; gotoxy(6,4); write(tempplaychr,' ''s turn.'); end else begin yarrw := 5; tempplaychr := 'ÛÛ'; temparrw := 3; gotoxy(6,4); write(tempplaychr,' ''s turn.'); end; gotoxy(xarrw,yarrw); {place arrow at players score} write('¯ÍÍÍÍ>'); gotoxy(xarrw,temparrw); write(' '); playchr := '[]'; {def pick char} x := 42; y := 8; gotoxy(6,3); write(' ':30); i := 2; j := 2; coordstatus := ok; findempty := false; while i < 10 do {loop until open square found or not found} begin repeat with board[i,j] do value1 := data; if value1 = 0 then {open square found} begin coordstatus := ok; findempty := true; i := 10; tempx := x; tempy := y; gotoxy(x,y); write(playchr:2); end else begin {open square not found} coordstatus := non_avail; x := x+5; j := j+1; end; until (findempty) or (j=10); x := 42; y := y+2; i := i+1; j := 2; end; x := tempx; {set coordinates of found square} y := tempy; {*************** for debuggung *********************************} {findmoves(board,player,possmvs); findbestmove(value,possmvs,board,player); value_print(value,possmvs);} {***************************************************************} end; procedure getcoord(player:shortint;possmvs:posmvarrytype; var makmove:makmovetype); {select a position on the board for a possible move, if move is good then exit procedure else write message and repeat procedure} var x, y, i, j, num1, num2, yinc, xinc, xarrw, yarrw, tempx, tempy, value1, value2, ply_piece, cmp_piece : shortint; coordstatus : coordstatustype; ch : char; findempty, fk : boolean; move : movetype; tempplay : shortint; playchr, tempplaychr : string2; begin xarrw := 42; tempplay := player; if player = 1 then begin tempplaychr := '°°'; yarrw := 3; end else begin yarrw := 5; tempplaychr := 'ÛÛ'; end; playchr := '[]'; locate_square(x,y,coordstatus,findempty,board,player); repeat if coordstatus = ok then begin repeat i := x;j := y; fk := false; ch := readkey; if ch = #0 then begin fk := true; ch := readkey; end; yinc := 0;xinc := 0; case ch of 'H': begin {left arrow key} y := y-2; yinc := -2; end; 'P': begin {right arrow key} y := y+2; yinc := +2; end; 'K': begin {up arrow key} x := x-5; xinc := -5; end; {down arrow key} 'M': begin x := x+5; xinc := +5; end; end; if (x>77) and (y>22) then begin x := 42; y := 8; end else if x > 77 then begin x := 42; y := y+2; end else if x < 42 then begin x := 77; y := y - 2; end; if y > 22 then y := 8 else if y < 8 then y := 22; with board[(y-4) div 2,(x-32) div 5] do value1 := data; if value1 = 0 then begin gotoxy(i,j); write(empty:2); gotoxy(x,y); write(playchr:2); num1 := (y-4) div 2; num2 := (x-32) div 5; end else if (value1 = 1) or (value1 = -1) then begin repeat gotoxy(i,j); write(empty:2); x := x+xinc; y := y+yinc; if (x>77) and (y>22) then begin x := 42; y := 8; end else if x > 77 then begin x := 42; y := y + 2; end else if x < 42 then begin x := 77; y := y - 2; end; if y > 22 then y := 8 else if y < 8 then y := 22; with board[(y-4) div 2,(x-32) div 5] do value2 := data; until value2 = 0; gotoxy(x,y); write(playchr:2); num1 := (y-4) div 2; num2 := (x-32) div 5; end; until (not fk) and (ch = #13); end; i := 1; move := bad; repeat with possmvs[i] do if (num1=row) and (num2=col) then move := good else begin move := bad; inc(i); end; until (i=30) or (move=good); if move <> good then begin gotoxy(6,3); write('Move is bad : ',tempplaychr); repeat ch := readkey; until (ch <> #13); gotoxy(6,3); write(' ':30); end; until move = good; gotoxy(xarrw,yarrw); write(' '); makmove.imm := num1; {set final move selected by player} makmove.jmm := num2; end; Procedure Lookahead(var value:bestmvetype; iterations:shortint; possmvs:posmvarrytype; board2:boardarrytype;whosturn:shortint; var done:boolean); var pass : boolean; o : shortint; ov : bestmvetype; tempm : makmovetype; tm : possmvsrectype; opponentposibles : posmvarrytype; m : possmvsrectype; k : integer; size : integer; begin findmoves(board2,-whosturn,opponentposibles); findbestmove(value,possmvs,board2,whosturn); size := 0; while possmvs[size+1].nflps<>0 do size := size + 1; if size <= 0 then pass := true else if (size = 1) or (iterations = 0) then done := true else begin if whosturn = 1 then begin o := -1; ov.val := -3500; end else begin o := 1; ov.val := 3500; end; tm.row := value.xcoord; tm.col := value.ycoord; tempm.imm := tm.row; tempm.imm := tm.col; k:=1; if not pass then while (possmvs[k].nflps<>0) do begin unmove(board2,tempboard2,save); makemoves(tempm,board2,whosturn); Lookahead(ov,iterations-1,opponentposibles, board2,-whosturn,done); unmove(board2,tempboard2,return); if (whosturn = 1) and (ov.val > value.val) then begin value := ov; m := tm; end else if (whosturn = -1) and (ov.val < value.val) then begin value := ov; m := tm end; k:=k+1; tm.row := possmvs[k].row; tm.col := possmvs[k].col; tempm.imm := tm.row; tempm.imm := tm.col; end; end; end; procedure first_move(var board:boardarrytype); {control the players move, if none then pass} var level, {search level} xarrw, yarrw, num1, num2 : shortint; possmvs : posmvarrytype; value : bestmvetype; makmove : makmovetype; begin findmoves(board,firstnum,possmvs); {make sure move is possible} if possmvs[1].nflps = 0 then begin gotoxy(6,3); write('No moves, turn passed. Wait...'); gotoxy(6,4); write(' ':30); delay(2000); end else begin unmove(board,tempboard,save); getcoord(firstnum,possmvs,makmove); {************for debuggung purposes****************************} { findbestmove(value,possmvs,board,firstnum); with makmove do begin imm:=value.xcoord; jmm:=value.ycoord; end;} {**************************************************************} makemoves(makmove,board,firstnum); end; end; procedure second_move_1_(var board:boardarrytype); {control computers move if none then pass} var xarrw, yarrw, num1, num2 : shortint; possmvs : posmvarrytype; makmove : makmovetype; value : bestmvetype; done : boolean; begin findmoves(board,secondnum,possmvs); if possmvs[1].nflps = 0 then begin gotoxy(6,3); write('No moves, turn passed. Wait...'); gotoxy(6,4); write(' ':30); delay(1500); end else begin finalcount(board,num1,num2); gotoxy(6,3); write(' ':30); xarrw := 42; yarrw := 3; gotoxy(xarrw,yarrw); write(' '); yarrw := 5; gotoxy(xarrw,yarrw); write('¯ÍÍÍÍ>'); gotoxy(6,4); write('Thinking...',' ':20); {******** For debugging purposes *******************************} {findmoves(board,secondnum,possmvs); findbestmove(value,possmvs,board,secondnum); value_print(value,possmvs);} {Andy} {unmove(board,board2,save); findbestmove(value,possmvs,board2,secondnum); gotoxy(6,3); write('Andy : ',value.xcoord,' ',value.ycoord);} {Erich} {gotoxy(6,4); write('Erich : ',makmove.imm,' ',makmove.jmm);} {***************************************************************} unmove(board,board2,save); lookahead(value,level,possmvs,board2,secondnum,done); makmove.imm := value.xcoord; makmove.jmm := value.ycoord; delay(500); gotoxy(6,4); write(' ':30); gotoxy(6,3); write(' ':30); gotoxy(xarrw,yarrw); write(' '); makemoves(makmove,board,secondnum); end; end; procedure second_move_2_(var board:boardarrytype); {if computer is not playing then this controls second players move} var level, xarrw, yarrw, num1, num2 : shortint; possmvs : posmvarrytype; value : bestmvetype; makmove : makmovetype; begin findmoves(board,secondnum,possmvs); if possmvs[1].nflps = 0 then begin gotoxy(6,3); write('No moves, turn passed. Wait...'); gotoxy(6,4); write(' ':30); delay(1500); end else begin unmove(board,tempboard2,save); getcoord(secondnum,possmvs,makmove); makemoves(makmove,board,secondnum); end; end; procedure deter_winner(game:gamestatus); {this procedure will determine a winner at the end of the game} var i, j : shortint; begin finalcount(board,i,j); gotoxy(6,3); write(' ':30); gotoxy(6,3); if (i+j<>64) then begin if quit = true then write('Game Stopped. ') else write('No moves for either player.'); if i>j then begin gotoxy(6,4); write('Player #1 Wins!!!'); end else if i'); normvideo; lowvideo; delay(1500); end; end; end; end; procedure execute_first_move; {execute first players move} begin if (game = continue) and (not pass) then begin first_move(board); print_board(board,game); end; pass := false; end; procedure execute_second_move; {execute second players move-computer or person is determined} var i, j : shortint; begin if not play_1 then begin play := second; finalcount(board,i,j); if i+j<>64 then pick_option(play) else game:=tie; end; if (game = continue) and (not pass) then begin if play_1 then begin finalcount(board,i,j); if i+j<>64 then second_move_1_(board); print_board(board,game); pass := false; end else begin second_move_2_(board); print_board(board,game); end end; end; procedure terminate_game; {termination procedures of game} var ch : char; begin ch := readkey; cursor('M',on); cursor('M',on); end; { MAIN-ROUTINE } { Controls Initializing, Processing, and Termination } Begin init_game(board); repeat pick_option(first); execute_first_move; execute_second_move; check_game_done(done); until (game <> continue) or (done); deter_winner(game); terminate_game; End.