chess_board = cluster is create, pieces, board_location, spot_empty, make_move, move_legal, undo_move, parse, unparse, all_possible_moves, can_move, count_possible_moves, set_teleport, get_teleport, equal, lt % Overview: chess_board is a mutable data type which represents a chess % board for anti-chess. It keeps track of the location of all the % pieces, checks for the legality of the moves, and provides the % capability to undo moves. It also has some utility procedures which % are of use to computer strategy algorithms. % written by stevenj, twm rep = record[pieceList: ap, board: bm, tstate: teleportState] ap = array[piece] piece = record[kind: pieceKind, color: pieceColor, taken: bool, location: boardPt, id: int] boardPt = record[row,col: int] ai = array[int] bm = array[ai] % A typical chess_board is a pair of sets. The first set in the % pair is aset of 4-tuples representing pieces that are % currently on the board: where kind of % piece is king, queen, etcetera, color is black or white, and row and col % range from 1 to 8. The second set in the pair is a set which is % empty {} if no "teleport" spots are designated, or equals % {r1, c1, r2, c2}, where these are the rows and columns of the two % teleport spots when they are being used. % The abstraction function A(r) yields a pair of sets corresponding % to a chess_board, as described above. The first set of this pair % is the set, for all p:piece in elements(r.pieceList) with % p.taken = false, of the n-tuples . Recall from chess_board.equ that p.kind is a oneof % record whose elements are king, queen, etcetera, and that p.color is % either whitePiece or blackPiece. The second set of the pair is % the empty set if teleportState$is_off(r.tstate), or otherwise % is {r.tstate.on.r1, r.tstate.on.c1, r.tstate.on.r2, % r.tstate.spots.c2}. % Rep. Invariants: % * size(r.whites) = size(r.blacks) % * for all i in indices of rep.pieceList % rep.pieceList[i].id = i % * all elements of rep.pieceList are unique % * for any piece p in rep.pieceList % p.location.row and p.location.col are in [1, boardSize] % * all non-taken elements are at unique boardPt's % * r.board is a boardSize x boardSize matrix % * for any piece p in r.pieceList, % r.board[p.location.row][p.location.col] = p.id % * for entries in r.board which are not specified by the previous % condition, that r.board[i][j] = -1 % * if teleportState$is_on(r.tstate) is true, then the two % locations in the teleportSpots struct are different, valid % board locations. create = proc() returns(cvt) % effects: returns a new board with all the pieces in their initial % positions for a chess/antichess game w: ap := ap$create(1) ap$addh(w,piece${kind: pieceKind$make_knight(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 2}, id: 1}) ap$addh(w,piece${kind: pieceKind$make_rook(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 1}, id: 1}) ap$addh(w,piece${kind: pieceKind$make_bishop(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 3}, id: 1}) ap$addh(w,piece${kind: pieceKind$make_king(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 5}, id: 1}) ap$addh(w,piece${kind: pieceKind$make_knight(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 7}, id: 1}) for i:int in int$from_to(1,boardSize) do ap$addh(w,piece${kind: pieceKind$make_pawn(nil), taken: false, color: whitePiece, location: boardPt${row: 2, col: boardSize-i+1}, id: 1}) end ap$addh(w,piece${kind: pieceKind$make_queen(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 4}, id: 1}) ap$addh(w,piece${kind: pieceKind$make_bishop(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 6}, id: 1}) ap$addh(w,piece${kind: pieceKind$make_rook(nil), taken: false, color: whitePiece, location: boardPt${row: 1, col: 8}, id: 1}) % The black pieces are the mirror image of the white ones: for i:int in int$from_to(ap$low(w),ap$high(w)) do b:piece := piece$copy(w[i]) b.location.row := boardSize + 1 - b.location.row b.location.col := b.location.col b.color := blackPiece ap$addh(w,b) end for i:int in ap$indexes(w) do w[i].id := i end bd: bm := bm$create(1) for i:int in int$from_to(1,boardSize) do bm$addh(bd,ai$create(1)) for j:int in int$from_to(1,boardSize) do ai$addh(bd[i],-1) end end for p:piece in ap$elements(w) do bd[p.location.row][p.location.col] := p.id end return(rep${pieceList: w, board: bd, tstate: teleportState$make_off(nil)}) end create set_teleport = proc(b: cvt, newtel:teleportState) signals(illegal_location) % effects: Sets the teleport state to newtel. If the % state is not off, and if the locations are not % distinct or are not legal board locations, % signals illegal_location. tagcase newtel tag off: tag on(locs:teleportSpots): if (locs.r1 = locs.r2 cand locs.c1 = locs.c2) cor ~inbounds(locs.r1,locs.c1) cor ~inbounds(locs.r2,locs.c2) then signal illegal_location end end % note: does not expose rep since teleportState is immutable b.tstate := newtel end set_teleport get_teleport = proc(b: cvt) returns(teleportState) % effects: returns the current teleport state of the board return(b.tstate) % tstate is immutable so doesn't expose the rep. end get_teleport pieces = iter(b: cvt) yields(pieceColor,pieceKind,int,int) % effects: this iterator yields all the pieces on the chess board % one by one. The pieceColor is whitePiece or blackPiece, % depending upon whether a piece is white or black. % The pieceKind tells what kind of piece it is (rook, % pawn, etc.). The two integers are the row and column % number of the piece's location, in that order. Row and % column numbers run from 1 to 8, and start at the % lower-left corner of the board. for p: piece in ap$elements(b.pieceList) do if ~p.taken then yield(p.color,p.kind,p.location.row,p.location.col) end end end pieces get_spot_piece = proc(b: rep, row,col: int) returns(piece) signals(no_piece) % requires: row and col must be a valid board location % effects: Returns the piece located at the spot given by row % and col (and its color), or signals no_piece if there % isn't one. p_id:int := b.board[row][col] if p_id < ap$low(b.pieceList) then signal no_piece else return(b.pieceList[p_id]) end end get_spot_piece inbounds = proc(r,c:int) returns(bool) % effects: returns true iff (r,c) is a location on the chessboard. return(r >= 1 cand r <= boardSize cand c >= 1 cand c <= boardSize) end inbounds board_location = proc(b: cvt, row,col: int) returns(pieceColor,pieceKind) signals(no_piece, illegal_location) % effects: Tells what kind of piece is located at the specified % row and column of the board (rows/columns numbered as % specified in the pieces iterator). The pieceColor is % whitePiece or blackPiece depending upon whether the % piece is white or black, and the pieceKind tells what % sort of piece it is. If there is no piece at that location, % signals no_piece. If the row or col is not in the % legal range, signals illegal_location. if ~inbounds(row,col) then signal illegal_location end p: piece p := get_spot_piece(b, row,col) resignal no_piece return(p.color,p.kind) end board_location spot_empty = proc(b:cvt, r,c:int) returns(bool) signals(no_piece, illegal_location) % effects: returns true iff there is no piece at the location % on the board given by r and c. Signals illegal_location % if the location (r,c) is not on the board. if ~inbounds(r,c) then signal illegal_location end return(b.board[r][c] < ap$low(b.pieceList)) end spot_empty empty_line = proc(b:rep, atrow,atcol,torow,tocol:int) returns(bool) % requires: (atrow,atcol) and (torow,tocol) be valid board locations % separated by a diagonal, horizontal, or vertical line. % effects: returns true iff the line between the two points, % *not* inclusive, is empty of pieces cdir,rdir:int if (tocol > atcol) then cdir := 1 elseif (tocol < atcol) then cdir := -1 else cdir := 0 end if (torow > atrow) then rdir := 1 elseif (torow < atrow) then rdir := -1 else rdir := 0 end for step:int in int$from_to(1,int$max(int$abs(atrow-torow), int$abs(atcol-tocol)) - 1) do r:int := atrow + rdir*step c:int := atcol + cdir*step if ~spot_empty(up(b),r,c) then return(false) end end return(true) end empty_line get_other_teleport_spot = proc(tspots:teleportSpots, r,c: int) returns(int,int) signals(not_a_teleport_spot) % effects: If (r,c) is one of the locations in tspots, then % returns the row and column of the other location; % otherwise signals not_a_teleport_spot if r = tspots.r1 cand c = tspots.c1 then return(tspots.r2,tspots.c2) elseif r = tspots.r2 cand c = tspots.c2 then return(tspots.r1,tspots.c1) else signal not_a_teleport_spot end end get_other_teleport_spot spot_is_color = proc(b:rep, ignorer,ignorec:int, colour: pieceColor, r,c:int) returns(bool) % effects: returns true iff the location (r,c) on the chess board % is occupied by a piece of color "colour." Returns false % if this is not true or if the given location is not on % the chess board. If this spot is one of the teleport % spots, then returns true if all pieces on both spots are % of color "colour", and there is a piece on at least one % of the spots. If the other teleport spot % equals (ignorer,ignorec), however, we ignore it. if r < 1 cor r > boardSize cor c < 1 cor c > boardSize then return(false) end tagcase b.tstate tag off: if b.board[r][c] = -1 then return(false) else return(b.pieceList[b.board[r][c]].color = colour) end tag on(tspots:teleportSpots): r2,c2:int := get_other_teleport_spot(tspots,r,c) except when not_a_teleport_spot: if b.board[r][c] = -1 then return(false) else return(b.pieceList[b.board[r][c]].color = colour) end end if r2 = ignorer cand c2 = ignorec then return(b.board[r][c] ~= -1 cand b.pieceList[b.board[r][c]].color = colour) end if b.board[r][c] ~= -1 then if b.board[r2][c2] ~= -1 then return(b.pieceList[b.board[r][c]].color = colour cand b.pieceList[b.board[r2][c2]].color = colour) else return(b.pieceList[b.board[r][c]].color = colour) end else return(b.board[r2][c2] ~= -1 cand b.pieceList[b.board[r2][c2]].color = colour) end end end spot_is_color legal_taking_moves = iter(b: rep, color: pieceColor, k: pieceKind, atrow, atcol: int) yields(int,int) % requires: atrow and atcol must be a legal board location % effects: yields all legal chess moves for a piece of that kind and % color which take enemy pieces, one by one (i.e. yields % the destination row,col of the piece in each move), for % the chess_board b. tagcase k tag king: if spot_is_color(b,atrow,atcol,~color,atrow,atcol+1) then yield(atrow,atcol+1) end if spot_is_color(b,atrow,atcol,~color,atrow,atcol-1) then yield(atrow,atcol-1) end if spot_is_color(b,atrow,atcol,~color,atrow+1,atcol) then yield(atrow+1,atcol) end if spot_is_color(b,atrow,atcol,~color,atrow-1,atcol) then yield(atrow-1,atcol) end if spot_is_color(b,atrow,atcol,~color,atrow+1,atcol+1) then yield(atrow+1,atcol+1) end if spot_is_color(b,atrow,atcol,~color,atrow-1,atcol+1) then yield(atrow-1,atcol+1) end if spot_is_color(b,atrow,atcol,~color,atrow+1,atcol-1) then yield(atrow+1,atcol-1) end if spot_is_color(b,atrow,atcol,~color,atrow-1,atcol-1) then yield(atrow-1,atcol-1) end tag pawn: dir:int if color = whitePiece then dir := 1 else dir := -1 end if inbounds(atrow+dir,atcol) cand b.board[atrow+dir][atcol] = -1 then tagcase b.tstate tag off: tag on(tspots:teleportSpots): ok:bool := true r2,c2:int := get_other_teleport_spot(tspots, atrow+dir,atcol) except when not_a_teleport_spot: ok := false end if ok then if (r2 ~= atrow cor c2 ~= atcol) cand b.board[r2][c2] ~= -1 cand b.pieceList[b.board[r2][c2]].color = ~color then yield(atrow+dir,atcol) end end end end if ((color=whitePiece cand atrow=2) cor (color=blackPiece cand atrow=7)) cand inbounds(atrow+dir+dir,atcol) cand b.board[atrow+dir][atcol] = -1 cand b.board[atrow+dir+dir][atcol] = -1 then tagcase b.tstate tag off: tag on(tspots:teleportSpots): ok:bool := true r2,c2:int := get_other_teleport_spot(tspots, atrow+dir+dir,atcol) except when not_a_teleport_spot: ok := false end if ok then if (r2 ~= atrow cor c2 ~= atcol) cand b.board[r2][c2] ~= -1 cand b.pieceList[b.board[r2][c2]].color = ~color then yield(atrow+dir+dir,atcol) end end end end if inbounds(atrow+dir,atcol+1) cand b.board[atrow+dir][atcol+1] ~= -1 cand spot_is_color(b,atrow,atcol,~color,atrow+dir,atcol+1) then yield(atrow+dir,atcol+1) end if inbounds(atrow+dir,atcol-1) cand b.board[atrow+dir][atcol-1] ~= -1 cand spot_is_color(b,atrow,atcol,~color,atrow+dir,atcol-1) then yield(atrow+dir,atcol-1) end tag knight: if spot_is_color(b,atrow,atcol,~color,atrow+2,atcol+1) then yield(atrow+2,atcol+1) end if spot_is_color(b,atrow,atcol,~color,atrow+2,atcol-1) then yield(atrow+2,atcol-1) end if spot_is_color(b,atrow,atcol,~color,atrow-2,atcol+1) then yield(atrow-2,atcol+1) end if spot_is_color(b,atrow,atcol,~color,atrow-2,atcol-1) then yield(atrow-2,atcol-1) end if spot_is_color(b,atrow,atcol,~color,atrow+1,atcol+2) then yield(atrow+1,atcol+2) end if spot_is_color(b,atrow,atcol,~color,atrow-1,atcol+2) then yield(atrow-1,atcol+2) end if spot_is_color(b,atrow,atcol,~color,atrow+1,atcol-2) then yield(atrow+1,atcol-2) end if spot_is_color(b,atrow,atcol,~color,atrow-1,atcol-2) then yield(atrow-1,atcol-2) end tag rook,bishop,queen: if pieceKind$is_rook(k) cor pieceKind$is_queen(k) then for r:int in int$from_to(atrow+1,boardSize) do if spot_is_color(b,atrow,atcol,~color,r,atcol) then yield(r,atcol) break elseif b.board[r][atcol] ~= -1 then break end end for r:int in int$from_to_by(atrow-1,1,-1) do if spot_is_color(b,atrow,atcol,~color,r,atcol) then yield(r,atcol) break elseif b.board[r][atcol] ~= -1 then break end end for c:int in int$from_to(atcol+1,boardSize) do if spot_is_color(b,atrow,atcol,~color,atrow,c) then yield(atrow,c) break elseif b.board[atrow][c] ~= -1 then break end end for c:int in int$from_to_by(atcol-1,1,-1) do if spot_is_color(b,atrow,atcol,~color,atrow,c) then yield(atrow,c) break elseif b.board[atrow][c] ~= -1 then break end end end if pieceKind$is_bishop(k) cor pieceKind$is_queen(k) then diff:int := 1 while atrow+diff <= boardSize cand atcol+diff <= boardSize do if spot_is_color(b,atrow,atcol,~color,atrow+diff, atcol+diff) then yield(atrow+diff,atcol+diff) break elseif b.board[atrow+diff][atcol+diff] ~= -1 then break end diff := diff + 1 end diff := 1 while atrow-diff >= 1 cand atcol+diff <= boardSize do if spot_is_color(b,atrow,atcol,~color,atrow-diff, atcol+diff) then yield(atrow-diff,atcol+diff) break elseif b.board[atrow-diff][atcol+diff] ~= -1 then break end diff := diff + 1 end diff := 1 while atrow+diff <= boardSize cand atcol-diff >= 1 do if spot_is_color(b,atrow,atcol,~color,atrow+diff, atcol-diff) then yield(atrow+diff,atcol-diff) break elseif b.board[atrow+diff][atcol-diff] ~= -1 then break end diff := diff + 1 end diff := 1 while atrow-diff >= 1 cand atcol-diff >= 1 do if spot_is_color(b,atrow,atcol,~color,atrow-diff, atcol-diff) then yield(atrow-diff,atcol-diff) break elseif b.board[atrow-diff][atcol-diff] ~= -1 then break end diff := diff + 1 end end end end legal_taking_moves spot_empty_not_invalid = proc(b:rep, ignorer,ignorec,r,c:int) returns(bool) % effects: returns true iff the spot (r,c) is not an invalid % location and is not occupied by a piece on the board b. % If the spot is a teleport location, then the other % teleport spot must be empty also. If the other teleport % spot equals (ignorer,ignorec), however, we ignore it. if r < 1 cor r > boardSize cor c < 1 cor c > boardSize then return(false) end tagcase b.tstate tag off: return(b.board[r][c] = -1) tag on(tspots:teleportSpots): r2,c2:int := get_other_teleport_spot(tspots,r,c) except when not_a_teleport_spot: return(b.board[r][c] = -1) end if r2 = ignorer cand c2 = ignorec then return(b.board[r][c] = -1) end return(b.board[r][c] = -1 cand b.board[r2][c2] = -1) end end spot_empty_not_invalid legal_non_taking_moves = iter(b: rep, color: pieceColor, k: pieceKind, atrow, atcol: int) yields(int,int) % requires: atrow and atcol must be a legal board location % effects: yields all legal chess moves for a piece of that kind and % color which don't take pieces, one by one (i.e. yields % the destination row,col of the piece in each move), for % the chess_board b. tagcase k tag king: if spot_empty_not_invalid(b,atrow,atcol,atrow,atcol+1) then yield(atrow,atcol+1) end if spot_empty_not_invalid(b,atrow,atcol,atrow,atcol-1) then yield(atrow,atcol-1) end if spot_empty_not_invalid(b,atrow,atcol,atrow+1,atcol) then yield(atrow+1,atcol) end if spot_empty_not_invalid(b,atrow,atcol,atrow-1,atcol) then yield(atrow-1,atcol) end if spot_empty_not_invalid(b,atrow,atcol,atrow+1,atcol+1) then yield(atrow+1,atcol+1) end if spot_empty_not_invalid(b,atrow,atcol,atrow-1,atcol+1) then yield(atrow-1,atcol+1) end if spot_empty_not_invalid(b,atrow,atcol,atrow+1,atcol-1) then yield(atrow+1,atcol-1) end if spot_empty_not_invalid(b,atrow,atcol,atrow-1,atcol-1) then yield(atrow-1,atcol-1) end tag pawn: dir:int if color = whitePiece then dir := 1 else dir := -1 end if spot_empty_not_invalid(b,atrow,atcol,atrow+dir,atcol) then yield(atrow+dir,atcol) end if ((color = whitePiece cand atrow = 2) cor (color = blackPiece cand atrow = 7)) cand spot_empty_not_invalid(b,atrow,atcol,atrow+dir+dir,atcol) cand b.board[atrow+dir][atcol] = -1 then yield(atrow+dir+dir,atcol) end tag knight: if spot_empty_not_invalid(b,atrow,atcol,atrow+2,atcol+1) then yield(atrow+2,atcol+1) end if spot_empty_not_invalid(b,atrow,atcol,atrow+2,atcol-1) then yield(atrow+2,atcol-1) end if spot_empty_not_invalid(b,atrow,atcol,atrow-2,atcol+1) then yield(atrow-2,atcol+1) end if spot_empty_not_invalid(b,atrow,atcol,atrow-2,atcol-1) then yield(atrow-2,atcol-1) end if spot_empty_not_invalid(b,atrow,atcol,atrow+1,atcol+2) then yield(atrow+1,atcol+2) end if spot_empty_not_invalid(b,atrow,atcol,atrow-1,atcol+2) then yield(atrow-1,atcol+2) end if spot_empty_not_invalid(b,atrow,atcol,atrow+1,atcol-2) then yield(atrow+1,atcol-2) end if spot_empty_not_invalid(b,atrow,atcol,atrow-1,atcol-2) then yield(atrow-1,atcol-2) end tag rook,bishop,queen: if pieceKind$is_rook(k) cor pieceKind$is_queen(k) then for r:int in int$from_to(atrow+1,boardSize) do if spot_empty_not_invalid(b,atrow,atcol,r,atcol) then yield(r,atcol) elseif b.board[r][atcol] ~= -1 then break end end for r:int in int$from_to_by(atrow-1,1,-1) do if spot_empty_not_invalid(b,atrow,atcol,r,atcol) then yield(r,atcol) elseif b.board[r][atcol] ~= -1 then break end end for c:int in int$from_to(atcol+1,boardSize) do if spot_empty_not_invalid(b,atrow,atcol,atrow,c) then yield(atrow,c) elseif b.board[atrow][c] ~= -1 then break end end for c:int in int$from_to_by(atcol-1,1,-1) do if spot_empty_not_invalid(b,atrow,atcol,atrow,c) then yield(atrow,c) elseif b.board[atrow][c] ~= -1 then break end end end if pieceKind$is_bishop(k) cor pieceKind$is_queen(k) then diff:int := 1 while atrow+diff <= boardSize cand atcol+diff <= boardSize do if spot_empty_not_invalid(b,atrow,atcol, atrow+diff,atcol+diff) then yield(atrow+diff,atcol+diff) elseif b.board[atrow+diff][atcol+diff] ~= -1 then break end diff := diff + 1 end diff := 1 while atrow-diff >= 1 cand atcol+diff <= boardSize do if spot_empty_not_invalid(b,atrow,atcol, atrow-diff,atcol+diff) then yield(atrow-diff,atcol+diff) elseif b.board[atrow-diff][atcol+diff] ~= -1 then break end diff := diff + 1 end diff := 1 while atrow+diff <= boardSize cand atcol-diff >= 1 do if spot_empty_not_invalid(b,atrow,atcol, atrow+diff,atcol-diff) then yield(atrow+diff,atcol-diff) elseif b.board[atrow+diff][atcol-diff] ~= -1 then break end diff := diff + 1 end diff := 1 while atrow-diff >= 1 cand atcol-diff >= 1 do if spot_empty_not_invalid(b,atrow,atcol, atrow-diff,atcol-diff) then yield(atrow-diff,atcol-diff) elseif b.board[atrow-diff][atcol-diff] ~= -1 then break end diff := diff + 1 end end end end legal_non_taking_moves can_move = proc(b: cvt, color: pieceColor) returns(bool) % effects: returns true iff there is some legal move that can % be made by the pieces of color "color". for p:piece in ap$elements(b.pieceList) do if ~p.taken cand p.color = color then for r,c:int in legal_taking_moves(b, p.color, p.kind, p.location.row, p.location.col) do return(true) % there is some legal move! yay! end end end for p:piece in ap$elements(b.pieceList) do if ~p.taken cand p.color = color then for r,c:int in legal_non_taking_moves(b, p.color, p.kind, p.location.row, p.location.col) do return(true) % there is some legal move! yay! end end end return(false) % darn, we're stuck...no moves are possible end can_move can_take_piece = proc(b: rep, color: pieceColor) returns(bool,string) % effects: returns true iff the pieces of color "color" can % take an opposing piece by some legal move. The second % return value is a string which describes the piece-taking % move, if it exists (the string is empty otherwise). for p:piece in ap$elements(b.pieceList) do if ~p.taken cand p.color = color then for r,c:int in legal_taking_moves(b, p.color, p.kind, p.location.row, p.location.col) do % we can take a piece! return(true,move_unparse(moveData${fromrow:p.location.row, fromcol:p.location.col, torow:r, tocol:c})) end end end return(false,"") % darn, we're stuck...no pieces are takeable end can_take_piece move_legal = proc(b: cvt, cur_color: pieceColor, m:movedata) returns(bool,string) signals(no_piece,illegal_location,wrongColor) % effects: returns true iff moving the piece at the location % (m.fromrow,m.fromcol) to (m.torow,m.tocol) is legal. % If the move is not legal, returns a descriptive string. % Signals illegal_location if the the specified locations are % not on the board. Signals no_piece if there is no piece % at location (m.fromrow,m.fromcol) on the board. Signals % wrongColor if the piece being moved isn't of color % cur_color. if ~(inbounds(m.fromrow,m.fromcol) cand inbounds(m.torow,m.tocol)) then signal illegal_location end p:piece := get_spot_piece(b,m.fromrow,m.fromcol) resignal no_piece if p.color ~= cur_color then signal wrongColor end noreplace: bool := false rp: piece rp := get_spot_piece(b,m.torow,m.tocol) except when no_piece: noreplace := true end if ~noreplace cand rp.color = p.color then return(false,"you can't take your own piece") end teleport_take:bool := false trp:piece tagcase b.tstate tag off: tag on(tspots:teleportSpots): teleport_take := true r2,c2:int := get_other_teleport_spot(tspots,m.torow,m.tocol) except when not_a_teleport_spot: teleport_take := false end if teleport_take then trp := get_spot_piece(b,r2,c2) except when no_piece: teleport_take := false end if teleport_take cand trp = p then teleport_take := false % pathological case: we are on the teleport spot % and are moving to the other teleport spot end if teleport_take cand trp.color = p.color then return(false,"you can't teleport and take your own piece") end end end % Must take a piece if we can: if noreplace cand ~teleport_take then ok:bool,mv:string := can_take_piece(b, p.color) if ok then return(false,"you can (and must) take an opposing piece (" ||mv||")") end end tagcase p.kind tag king: if (m.tocol = m.fromcol cand m.torow = m.fromrow) cor int$abs(m.tocol-m.fromcol) > 1 cor int$abs(m.torow-m.fromrow) > 1 then return(false,"kings can't move that way") end tag queen: if ((m.tocol - m.fromcol ~= m.torow - m.fromrow) cand (m.tocol - m.fromcol ~= m.fromrow - m.torow)) cand ((m.tocol - m.fromcol = 0 cand m.torow - m.fromrow = 0) cor (m.tocol - m.fromcol ~= 0 cand m.fromrow - m.torow ~= 0)) then return(false,"queens can't move that way") elseif ~empty_line(b,m.fromrow,m.fromcol,m.torow,m.tocol) then return(false,"queens can't jump over pieces") end tag rook: if (m.tocol - m.fromcol = 0 cand m.torow - m.fromrow = 0) cor (m.tocol - m.fromcol ~= 0 cand m.fromrow - m.torow ~= 0) then return(false,"rooks can't move that way") elseif ~empty_line(b,m.fromrow,m.fromcol,m.torow,m.tocol) then return(false,"rooks can't jump over pieces") end tag bishop: if m.tocol - m.fromcol ~= m.torow - m.fromrow cand m.tocol - m.fromcol ~= m.fromrow - m.torow then return(false,"bishops can't move that way") elseif ~empty_line(b,m.fromrow,m.fromcol,m.torow,m.tocol) then return(false,"bishops can't jump over pieces") end tag knight: if (m.tocol ~= m.fromcol + 2 cor m.torow ~= m.fromrow + 1) cand (m.tocol ~= m.fromcol - 2 cor m.torow ~= m.fromrow + 1) cand (m.tocol ~= m.fromcol - 2 cor m.torow ~= m.fromrow - 1) cand (m.tocol ~= m.fromcol + 2 cor m.torow ~= m.fromrow - 1) cand (m.torow ~= m.fromrow + 2 cor m.tocol ~= m.fromcol + 1) cand (m.torow ~= m.fromrow - 2 cor m.tocol ~= m.fromcol + 1) cand (m.torow ~= m.fromrow - 2 cor m.tocol ~= m.fromcol - 1) cand (m.torow ~= m.fromrow + 2 cor m.tocol ~= m.fromcol - 1) then return(false,"knights can't move that way") end tag pawn: dir: int if p.color = whitePiece then dir := 1 else dir := -1 end if noreplace cand ~(m.tocol = m.fromcol cand (m.torow = m.fromrow + dir cor (m.torow = m.fromrow + dir*2 cand ((p.color=whitePiece cand m.fromrow=2) cor (p.color=blackPiece cand m.fromrow=7)) cand b.board[m.fromrow+dir][m.fromcol]=-1))) then return(false,"pawns can't move that way") elseif ~noreplace cand ~((m.tocol = m.fromcol + 1 cor m.tocol = m.fromcol - 1) cand m.torow = m.fromrow + dir) then return(false,"pawns can't take a piece that way") end end return(true,"move is okay") end move_legal move_piece_no_checks = proc(b: rep, p: piece, torow,tocol: int) returns(undoMoveInfo) % requires: (torow,tocol) must be a valid location and % moving p there must be legal. % modifies: b % effects: moves p to (torow,tocol), taking any enemy piece % that might be there. Returns the information % necessary to undo the move. Note: will queen pawns, % if possible. noreplace: bool := false rp:piece teleport:bool := false teleport_take:bool := false trp:piece r2,c2,rpid,trpid:int rp := get_spot_piece(b,torow,tocol) except when no_piece: noreplace := true end if noreplace then rpid := -1 else rpid := rp.id end tagcase b.tstate tag off: tag on(tspots:teleportSpots): teleport := true r2,c2 := get_other_teleport_spot(tspots,torow,tocol) except when not_a_teleport_spot: teleport := false end if teleport then teleport_take := true trp := get_spot_piece(b,r2,c2) except when no_piece: teleport_take := false end if trp = p then teleport_take := false end end end if teleport_take then trpid := trp.id else trpid := -1 end makequeen:bool if teleport then makequeen := pieceKind$is_pawn(p.kind) cand (r2 = boardSize cand p.color = whitePiece cor r2 = 1 cand p.color = blackPiece cor torow = boardSize cand p.color = whitePiece cor torow = 1 cand p.color = blackPiece) else makequeen := pieceKind$is_pawn(p.kind) cand (torow = boardSize cand p.color = whitePiece cor torow = 1 cand p.color = blackPiece) end uinfo:undoMoveInfo := undoMoveInfo${movedPieceID:p.id, takenPieceID:rpid, takenPiece2ID: trpid, origRow:p.location.row, origCol:p.location.col, queenedPawn:makequeen} b.board[p.location.row][p.location.col] := -1 if teleport then b.board[torow][tocol] := -1 b.board[r2][c2] := p.id p.location.row := r2 p.location.col := c2 else b.board[torow][tocol] := p.id p.location.row := torow p.location.col := tocol end if ~noreplace then rp.taken := true end if teleport_take then trp.taken := true end if makequeen then p.kind := pieceKind$make_queen(nil) end return(uinfo) end move_piece_no_checks make_move = proc(b:cvt, cur_color: pieceColor, m:moveData) returns(undoMoveInfo) signals(no_piece,illegal_move(string),illegal_location,wrongColor) % modifies: b % effects: Moves a piece according to the move data in m. % If there is no such piece, signals no_piece. If % the move is illegal, signals illegal_move and % includes a string telling what went wrong. If % either of the two locations is not on the board, % then signals illegal_location. Signals wrongColor % if the color of the piece being moved is not equal % to the color cur_color. Note that any enemy % piece at (m.torow,m.tocol) is taken. The return value % is the information needed to undo the move. Note: % will queen pawns, if possible. if ~(inbounds(m.fromrow,m.fromcol) cand inbounds(m.torow,m.tocol)) then signal illegal_location end p:piece := get_spot_piece(b,m.fromrow,m.fromcol) resignal no_piece if p.color ~= cur_color then signal wrongColor end leg: bool err: string leg,err := move_legal(up(b),p.color,m) if leg then return(move_piece_no_checks(b,p,m.torow,m.tocol)) else signal illegal_move(err) end end make_move undo_move = proc(b: cvt, uinfo: undoMoveInfo) % requires: uinfo must be the undoMoveInfo returned by the most % recent call to make_move % modifies: b % effects: will undo the effects of the most recent call to % make_move p:piece := b.pieceList[uinfo.movedPieceID] b.board[p.location.row][p.location.col] := -1 p.location.row := uinfo.origRow p.location.col := uinfo.origCol b.board[p.location.row][p.location.col] := p.id if uinfo.queenedPawn then p.kind := pieceKind$make_pawn(nil) end if uinfo.takenPieceID > -1 then rp:piece := b.pieceList[uinfo.takenPieceID] rp.taken := false b.board[rp.location.row][rp.location.col] := rp.id end if uinfo.takenPiece2ID > -1 then rp:piece := b.pieceList[uinfo.takenPiece2ID] rp.taken := false b.board[rp.location.row][rp.location.col] := rp.id end end undo_move tspots_unparse = proc(ts:teleportSpots) returns(string) % effects: returns a string representing the teleport spots % ts in the format of the problem set % amendment 2 handout. s:string := "" s := string$append(s,char$i2c(ts.c1 - 1 + char$c2i('a'))) s := s || int$unparse(ts.r1) s := string$append(s,char$i2c(ts.c2 - 1 + char$c2i('a'))) s := s || int$unparse(ts.r2) return(s) end tspots_unparse tspots_parse = proc(s: string) returns(teleportSpots) signals(bad_format) % effects: returns the teleportSpots represented by the string % s, which is expected to be in the format % from above (signals bad_format otherwise) if string$size(s) ~= 4 then signal bad_format end fr,fc,tr,tc: int if string$indexc(s[1],"ABCDEFGH") > 0 then fc := char$c2i(s[1]) - char$c2i('A') + 1 elseif string$indexc(s[1],"abcdefgh") > 0 then fc := char$c2i(s[1]) - char$c2i('a') + 1 else signal bad_format end if string$indexc(s[2],"12345678") > 0 then fr := char$c2i(s[2]) - char$c2i('1') + 1 else signal bad_format end if string$indexc(s[3],"ABCDEFGH") > 0 then tc := char$c2i(s[3]) - char$c2i('A') + 1 elseif string$indexc(s[3],"abcdefgh") > 0 then tc := char$c2i(s[3]) - char$c2i('a') + 1 else signal bad_format end if string$indexc(s[4],"12345678") > 0 then tr := char$c2i(s[4]) - char$c2i('1') + 1 else signal bad_format end return(teleportSpots${r1:fr,c1:fc,r2:tr,c2:tc}) end tspots_parse parse = proc(b_string: string) returns(cvt) signals(bad_format(string)) % effects: parse takes a string representing a game board, as % described by the format on page 9 of problem % set #5, and returns the associated chess board % object. Signals bad_format if the format is wrong, % returns a descriptive error string. plist:ap := ap$create(1) % cut off any final newline characters from the string: while string$size(b_string) > 0 cand b_string[string$size(b_string)] = '\n' do b_string := string$substr(b_string,1,string$size(b_string) - 1) end telstate:teleportState := teleportState$make_off(nil) r:int := boardSize c:int := 0 for ind:int in int$from_to(1,string$size(b_string)) do ch:char := b_string[ind] if ch = '\n' then if c < boardSize then signal bad_format("Not enough columns in row #" || int$unparse(r) || ".") end if r = 1 then ind := ind + 1 tel:string := string$substr(b_string,ind, string$size(b_string)-ind+1) ts:teleportSpots := tspots_parse(tel) except when bad_format: signal bad_format("Wrong format for teleport spots!") end telstate := teleportState$make_on(ts) break end r := r - 1; c := 0 elseif c = boardSize then signal bad_format("Too many columns in row #"|| int$unparse(r)||".") else c := c + 1 if ch ~= '-' then pk: pieceKind pc: pieceColor pc,pk := piece_parse(string$c2s(ch)) except when not_a_piece: signal bad_format("Illegal piece "||string$c2s(ch) ||" in row #"||int$unparse(r)||".") end if pieceKind$is_pawn(pk) cand ((r = 8 cand pc=whitePiece) cor (r = 1 cand pc=blackPiece)) then signal bad_format("There is a pawn "|| "in the last row, where it should"|| " be promoted into a queen.") end ap$addh(plist, piece${kind:pk, color:pc, taken:false, location:boardPt${row:r,col:c}, id: ap$high(plist)+1}) end end end if r > 1 then signal bad_format("Not enough rows!") end new_board:bm := bm$create(1) % Fix the contents of the board data structure: for r in int$from_to(1,boardSize) do bm$addh(new_board,ai$create(1)) for c in int$from_to(1,boardSize) do ai$addh(new_board[r],-1) end end for p:piece in ap$elements(plist) do if ~p.taken then new_board[p.location.row][p.location.col] := p.id end end new_chess_board:rep := rep${pieceList:plist, board:new_board, tstate:teleportState$make_off(nil)} set_teleport(up(new_chess_board),telstate) except when illegal_location: signal bad_format("Illegal teleport locations!") end return(new_chess_board) end parse unparse = proc(b: cvt) returns(string) % effects: returns a string representing a game board, as % described by the format on page 9 of problem % set #5, given a chess board object b. s: string := "" for r:int in int$from_to_by(boardSize,1,-1) do for c:int in int$from_to(1,boardSize) do ok:bool := true p:piece := b.pieceList[b.board[r][c]] except when bounds: ok := false end if ok then s := s || piece_unparse(p.color,p.kind) else s := s || "-" end end s := s || "\n" end tagcase b.tstate tag off: tag on(tspots:teleportSpots): s := s||tspots_unparse(tspots)||"\n" end return(s) end unparse all_possible_moves = iter(b: cvt, pcolor:pieceColor) yields(int,int,int,int,undoMoveInfo) % requires: When control reaches the end of the body of the for loop % calling this iterator, the board must be in the % state it was in at the beginning of the body of the % for loop. i.e. Any moves which were made in the body % must be undone! % modifies: b % effects: Finds all possible moves that may be made by the % player whose pieces are the color "pcolor". One by one % it makes them, yielding the row and column of the % original piece location, the row and column of the % new location, and the information necessary to undo % the move. The move is undone automatically when control % reaches the end of the body of the for loop, however! % The undo information is only provided in case the % caller breaks out of the for loop and wants to undo % the move. As can be seen, this iterator must be called % with care; its interface is the way it is because it % is designed to be called in a min-max search for the % best move, and has to be efficient. could_take_some: bool := false for p:piece in ap$elements(b.pieceList) do if ~p.taken cand p.color = pcolor then for r,c:int in legal_taking_moves(b, p.color, p.kind, p.location.row, p.location.col) do could_take_some := true % save current location before we move: atrow:int := p.location.row atcol:int := p.location.col uinfo:undoMoveInfo := move_piece_no_checks(b,p,r,c) yield(atrow,atcol,r,c,uinfo) undo_move(up(b),uinfo) end end end if ~could_take_some then for p:piece in ap$elements(b.pieceList) do if ~p.taken cand p.color = pcolor then for r,c:int in legal_non_taking_moves(b, p.color, p.kind, p.location.row, p.location.col) do % save current location before we move: atrow:int := p.location.row atcol:int := p.location.col uinfo:undoMoveInfo := move_piece_no_checks(b,p,r,c) yield(atrow,atcol,r,c,uinfo) undo_move(up(b),uinfo) end end end end end all_possible_moves count_possible_moves = proc(b:cvt, pcolor:pieceColor) returns(int) % effects: returns the total number of moves that the player of % color pcolor can currently make on the chess board b num_moves:int := 0 for p:piece in ap$elements(b.pieceList) do if ~p.taken cand p.color = pcolor then for r,c:int in legal_taking_moves(b, p.color, p.kind, p.location.row, p.location.col) do num_moves := num_moves + 1 end end end if num_moves = 0 then for p:piece in ap$elements(b.pieceList) do if ~p.taken cand p.color = pcolor then for r,c:int in legal_non_taking_moves(b, p.color, p.kind, p.location.row, p.location.col) do num_moves := num_moves + 1 end end end end return(num_moves) end count_possible_moves equal = proc(b1, b2: cvt) returns(bool) % effects: Returns whether the current board configuration of % b1 matches the current board configuration of b2. Note - % this procedure does not distinguish between natural queens % and queened pawns, and therefore two boards with different % pieces could be considered equal, but they still must have % the same "look" when unparsed. Different teleport states % will cause false to be returned. % written by twm for i: int in bm$indexes(b1.board) do for x: int in ai$indexes(b1.board[i]) do if b1.board[i][x] ~= b2.board[i][x] then c1: pieceColor, k1: pieceKind:= board_location(up(b1), x, i) except when no_piece: return(false) end c2: pieceColor, k2: pieceKind:= board_location(up(b2), x, i) except when no_piece: return(false) end if c1 ~= c2 then return(false) end tagcase k1 tag queen: tagcase k2 tag queen: continue others: return(false) end others: return(false) end end % if b1.board[i][x] ... end % for x ... end % for i ... tagcase b1.tstate tag off: tagcase b2.tstate tag off: return(true) tag on: return(false) end tag on(b1spots:teleportSpots): tagcase b2.tstate tag off: return(false) tag on(b2spots:teleportSpots): return((b1spots.r1 = b2spots.r1) cand (b1spots.c1 = b2spots.c1) cand (b1spots.r2 = b2spots.r2) cand (b1spots.c2 = b2spots.c2)) end end end equal lt = proc(b1, b2: cvt) returns(bool) % effects: This procedure can be used to order two % chess_boards. The result has not physical significance % per se, but for two chess_boards, b1 and b2, that satisfy % b1 ~= b2, (b1 < b2) = ~(b2 < b1) always holds true and % (b1 < b2) will always return the same value. (For b1 = b2, % b1 < b2 returns false and b2 < b1 returns false). Note - % this procedure does not distinguish between natural queens % and queened pawns, and therefore two boards with different % pieces could be considered equal, but they still must have % the same "look" when unparsed. Different teleport states % are distinguished. % written by twm for i: int in bm$indexes(b1.board) do for x: int in ai$indexes(b1.board[i]) do if b1.board[i][x] ~= b2.board[i][x] then % black < white c1: pieceColor, k1: pieceKind:= board_location(up(b1), x, i) except when no_piece: return(b1.board[i][x] < b2.board[i][x]) end c2: pieceColor, k2: pieceKind:= board_location(up(b2), x, i) except when no_piece: return(b1.board[i][x] < b2.board[i][x]) end if c1 ~= c2 then return(c1 = blackPiece) end tagcase k1 tag queen: tagcase k2 tag queen: continue others: return(b1.board[i][x] < b2.board[i][x]) end others: return(b1.board[i][x] < b2.board[i][x]) end end % if b1.board[i][x] ... end end % off < on and then rows and columns are compared tagcase b1.tstate tag off: tagcase b2.tstate tag off: return(false) tag on: return(true) end tag on(b1spots:teleportSpots): tagcase b2.tstate tag off: return(false) tag on(b2spots:teleportSpots): if (b1spots.r1 ~= b2spots.r1) then return(b1spots.r1 < b2spots.r1) end if (b1spots.c1 ~= b2spots.c1) then return(b1spots.c1 < b2spots.c1) end if (b1spots.r2 ~= b2spots.r2) then return(b1spots.r2 < b2spots.r2) end if (b1spots.c2 ~= b2spots.c2) then return(b1spots.c2 < b2spots.c2) end end end end lt end chess_board