+! Z-Chess: two-player chess for the Z-machine\r
+! Copyright (C) 2002, 2003, 2004 Eric Schmidt\r
+\r
+! This program is free software; you can redistribute it and/or modify\r
+! it under the terms of the GNU General Public License as published by\r
+! the Free Software Foundation; either version 2 of the License, or\r
+! (at your option) any later version.\r
+\r
+! This program is distributed in the hope that it will be useful,\r
+! but WITHOUT ANY WARRANTY; without even the implied warranty of\r
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
+! GNU General Public License for more details.\r
+! You should have received a copy of the GNU General Public License\r
+! along with this program; if not, write to the Free Software\r
+! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA\r
+\r
+! The author may be contacted at <eschmidt@safeaccess.com>.\r
+\r
+Release 4;\r
+Serial "040124";\r
+\r
+! ---------------------------------------\r
+! Constants, Arrays, and Global Variables\r
+! ---------------------------------------\r
+\r
+Constant NULL = -1;\r
+\r
+! The screen size\r
+\r
+Global width; Global height;\r
+\r
+! The board position\r
+\r
+Global bleft; Global btop;\r
+\r
+! The board colors\r
+\r
+Global colorflag;\r
+Constant normal = 1;\r
+Constant black = 2;\r
+Constant red = 3;\r
+Constant cyan = 8;\r
+Constant white = 9;\r
+\r
+! Unicode\r
+\r
+Global unicode_support = false;\r
+\r
+! Code points for chess symbols\r
+\r
+Constant uni_wKing = $2654;\r
+Constant uni_wQueen = $2655;\r
+Constant uni_wRook = $2656;\r
+Constant uni_wBishop = $2657;\r
+Constant uni_wKnight = $2658;\r
+Constant uni_wPawn = $2659;\r
+Constant uni_bKing = $265a;\r
+Constant uni_bQueen = $265b;\r
+Constant uni_bRook = $265c;\r
+Constant uni_bBishop = $265d;\r
+Constant uni_bKnight = $265e;\r
+Constant uni_bPawn = $265f;\r
+\r
+! Reading from the keyboard\r
+\r
+Constant uKey = $81;\r
+Constant dKey = $82;\r
+Constant lKey = $83;\r
+Constant rKey = $84;\r
+Constant EnterKey = $0d;\r
+\r
+! The board caption system\r
+\r
+Global mrow;\r
+\r
+Constant whitemove = 0;\r
+Constant blackmove = 1;\r
+Constant promote = 2;\r
+Constant illegal = 3;\r
+Constant cillegal = 4;\r
+Constant check = 5;\r
+Constant checkmate = 6;\r
+Constant stalemate = 7;\r
+Constant lowpieces = 8;\r
+Constant saveyes = 9;\r
+Constant loadyes = 10;\r
+Constant saveno = 11;\r
+Constant loadno = 12;\r
+\r
+! Notice that all the messages the game displays are of even length.\r
+! This is deliberate. The window is likely to be of even width\r
+! and so only even-lengthed messages can be perfectly centered.\r
+\r
+Array mArray -->\r
+! message length\r
+ "White's turn to move" 20\r
+ "Black's turn to move" 20\r
+ "Type letter of piece" 20\r
+ "Illegal move" 12\r
+ "Illegal move - check" 20\r
+ "Check!" 6\r
+ "Checkmate!" 10\r
+ "Stalemate!" 10\r
+ "Draw by too few pieces" 22\r
+ "Save succeeded" 14\r
+ "Load succeeded" 14\r
+ "Unable to save" 14\r
+ "Unable to load" 14;\r
+\r
+! Cursor location\r
+\r
+Global rank = 6; Global file = 0; ! This defaults to WQRP\r
+\r
+! Currently selected piece;\r
+\r
+Global mover = NULL;\r
+\r
+! The position\r
+\r
+Constant wPawn = 1;\r
+Constant wKnight = 2;\r
+Constant wBishop = 3;\r
+Constant wRook = 4;\r
+Constant wQueen = 5;\r
+Constant wKing = 6;\r
+\r
+Constant threshold = 7; ! If (a_piece < threshold), it is white.\r
+\r
+Constant bPawn = 7;\r
+Constant bKnight = 8;\r
+Constant bBishop = 9;\r
+Constant bRook = 10;\r
+Constant bQueen = 11;\r
+Constant bKing = 12;\r
+\r
+Array position ->\r
+ bRook bKnight bBishop bQueen bKing bBishop bKnight bRook\r
+ bPawn bPawn bPawn bPawn bPawn bPawn bPawn bPawn\r
+ nothing nothing nothing nothing nothing nothing nothing nothing\r
+ nothing nothing nothing nothing nothing nothing nothing nothing\r
+ nothing nothing nothing nothing nothing nothing nothing nothing\r
+ nothing nothing nothing nothing nothing nothing nothing nothing\r
+ wPawn wPawn wPawn wPawn wPawn wPawn wPawn wPawn\r
+ wRook wKnight wBishop wQueen wKing wBishop wKnight wRook;\r
+\r
+Array working_position -> 64;\r
+\r
+Global WhiteToMove = true;\r
+\r
+Constant e1 = 60;\r
+Constant e8 = 4;\r
+\r
+! For calculating check\r
+! We define "old" variables for backups\r
+\r
+Global wKingPos = e1; Global owKingPos;\r
+Global bKingPos = e8; Global obKingPos;\r
+\r
+! Castling\r
+\r
+Global just_castled;\r
+\r
+Global wking_moved; Global owking_moved;\r
+Global bking_moved; Global obking_moved;\r
+Global a1rook_moved; Global oa1rook_moved;\r
+Global h1rook_moved; Global oh1rook_moved;\r
+Global a8rook_moved; Global oa8rook_moved;\r
+Global h8rook_moved; Global oh8rook_moved;\r
+\r
+! The numbers of squares to do with castling\r
+! (It would be nice if Inform had octal numbers.)\r
+\r
+Constant a8 = 0;\r
+Constant a1 = 56;\r
+Constant h1 = 63;\r
+Constant h8 = 7;\r
+\r
+Constant f1 = 61;\r
+Constant g1 = 62;\r
+Constant d1 = 59;\r
+Constant c1 = 58;\r
+\r
+Constant f8 = 5;\r
+Constant g8 = 6;\r
+Constant d8 = 3;\r
+Constant c8 = 2;\r
+\r
+! En passant\r
+\r
+Global epPawn = NULL; Global oepPawn = NULL;\r
+\r
+! The current game status\r
+\r
+Global GameOver;\r
+\r
+! ------------\r
+! The Routines\r
+! ------------\r
+\r
+! The main routine: set game up and receive input\r
+\r
+[ Main input square piece i j;\r
+\r
+ ! Check for large enough screen\r
+\r
+ height = 0->$20;\r
+ width = 0->$21;\r
+ if (width < 22) "Regretably, this interpreter has not provided a\r
+ wide enough window for this program.";\r
+ if (height < 10) "Regretably, this interpreter has not provided a\r
+ tall enough window for this program.";\r
+\r
+ ! Check for color. If the fixed-pitch font bit is set in the header, we got\r
+ ! here from a restart and shouldn't warn about the color.\r
+\r
+ if (0->1 & 1) colorflag = true;\r
+ else if (0-->$8 & $$10) font on; ! Turn bit back off\r
+ else {\r
+ print "WARNING: This interpreter has not provided color.\r
+ The game may not perform optimally.^";\r
+ @read_char 1 -> input;\r
+ }\r
+\r
+ ! Locate board\r
+\r
+ bleft = (width - 16) / 2 + 1;\r
+ btop = (height - 10) / 2 + 2;\r
+ if (height % 2) btop++; ! Favor lower row\r
+ mrow = btop + 8;\r
+\r
+ CheckUnicode();\r
+\r
+ CompleteRedraw();\r
+\r
+ ! Main gain loop\r
+\r
+ while (1) {\r
+ ! Set cursor position\r
+\r
+ i = btop + rank;\r
+ j = file * 2 + bleft;\r
+ @set_cursor i j;\r
+\r
+ ! Receive input\r
+\r
+ @read_char 1 -> input;\r
+ switch (input) {\r
+ 'c', 'C':\r
+ @erase_window -1;\r
+ print "^^Release 1 - Initial release^^\r
+ Release 2\r
+ ^ * Added color support\r
+ ^ * Fixed two castling bugs^^\r
+ Release 3\r
+ ^ * Unicode support\r
+ ^ * Changed license to GPL^^\r
+ Release 4\r
+ ^ * Added ability to save and restore game";\r
+ @read_char 1 -> input;\r
+ CompleteRedraw();\r
+\r
+ 'd', 'D':\r
+ @erase_window -1;\r
+ print "Use the arrow keys to move the cursor around.\r
+ Press space bar (or enter) to select a piece. \r
+ Move the cursor to the square you want to move the\r
+ piece, and press space bar (or enter) again to move.\r
+ To castle, move the king to its destination, and the\r
+ rook will automatically move to its. To deselect the \r
+ piece you've selected, press space bar when the cursor\r
+ is on the piece.^^\r
+ White pieces are indicated by the letter W and black pieces by\r
+ B. If supported by your system, the piece type will be shown as\r
+ a chess figurine. If not, a letter is used. This is the first\r
+ letter of the piece's name, except that a knight is represented\r
+ by N.^^\r
+ When a pawn promotion occurs, you must specify which type of\r
+ piece to promote it to. Do this by typing the letter of the\r
+ piece you want to promote it to.^^\r
+ At the main display, you can type D to view these directions,\r
+ I to view legal information, C to view major changes between\r
+ versions, Q to quit, N to start a new game, S to save a game,\r
+ or L to load a game from disk.^^\r
+ The author may be contacted at <eschmidt@@64safeaccess.com>.";\r
+ @read_char 1 -> input;\r
+ CompleteRedraw();\r
+\r
+ 'i', 'I':\r
+ @erase_window -1;\r
+ print "Z-Chess: Chess for the Z-Machine^\r
+ Copyright (C) 2002, 2003, 2004 Eric Schmidt^^\r
+ This program is free software. It may be distributed\r
+ under the terms of the GNU General Public License\r
+ version 2, or (at your option) any later version.^^\r
+ This program is distributed in the hope that it will be\r
+ useful, but WITHOUT ANY WARRANTY; without even the implied\r
+ warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\r
+ See the GNU General Public License for more details. You should\r
+ have received a copy of the GNU General Public License along\r
+ with this program; if not, write to the Free Software\r
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston,\r
+ MA 02111-1307 USA"; \r
+ @read_char 1 -> input;\r
+ CompleteRedraw();\r
+\r
+ 'l', 'L':\r
+ @erase_window -1;\r
+ @restore -> i;\r
+ CompleteRedraw();\r
+ Message(loadno); ! Load failed if we get here\r
+\r
+ 'n', 'N':\r
+ font off; ! Hack: We use the fixed-pitch font bit to\r
+ @restart; ! signal that a restart is taking place\r
+\r
+ 'q', 'Q':\r
+ @set_cursor height 1;\r
+ @erase_line 1;\r
+ quit;\r
+\r
+ 'r', 'R':\r
+ @erase_window -1;\r
+ @restore -> i;\r
+ CompleteRedraw();\r
+ Message(loadno); ! Cannot reach here if succeeded\r
+\r
+ 's', 'S':\r
+ @erase_window -1;\r
+ @save -> i;\r
+ CompleteRedraw(); \r
+ switch (i) {\r
+ 0: Message(saveno);\r
+ 1: Message(saveyes);\r
+ 2: Message(loadyes);\r
+ }\r
+ \r
+ uKey: if (rank > 0) { rank--; PrintCaption(); }\r
+ dKey: if (rank < 7) { rank++; PrintCaption(); }\r
+ lKey: if (file > 0) { file--; PrintCaption(); }\r
+ rKey: if (file < 7) { file++; PrintCaption(); }\r
+ EnterKey, ' ':\r
+ if (GameOver) break;\r
+ square = rank * 8 + file;\r
+ piece = position->square;\r
+ if (mover == NULL && piece\r
+ && WhiteToMove == (piece < threshold)) mover = square;\r
+ else if (mover == square) mover = NULL;\r
+ else if (mover ~= NULL) {\r
+ if (~~AttemptToMove(mover,square)) PrintCaption();\r
+ mover = NULL;\r
+ }\r
+ PrintPos();\r
+ }\r
+ }\r
+];\r
+\r
+[ CheckUnicode i;\r
+ ! Pre 1.0 terps won't allow @check_unicode\r
+ if (~~(0->$32)) return;\r
+\r
+ @split_window height;\r
+ @set_window 1;\r
+\r
+ ! Would there be support for one chess glyph but not the\r
+ ! others? Well, we might as well be on the safe side.\r
+ @"EXT:12S" uni_wKing -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_wQueen -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_wRook -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_wBishop -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_wKnight -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_wPawn -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_bKing -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_bQueen -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_bRook -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_bBishop -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_bKnight -> i; if (~~(i & 1)) return;\r
+ @"EXT:12S" uni_bPawn -> i; if (~~(i & 1)) return;\r
+\r
+ ! The interpreter has passed the sieve.\r
+ unicode_support = true;\r
+];\r
+\r
+[ CompleteRedraw;\r
+ @split_window height;\r
+ @set_window 1;\r
+ @erase_window -2;\r
+ style reverse; \r
+ print "(D)irections"; spaces width - 18; print "(I)nfo";\r
+ style roman;\r
+\r
+ PrintPos();\r
+ PrintCaption();\r
+];\r
+\r
+! Routine to print the position\r
+\r
+[ PrintPos i;\r
+ @set_cursor btop bleft;\r
+\r
+ for (: i < 64: i++) {\r
+ \r
+ ! Set printing colors, considering color support\r
+\r
+ if (colorflag) {\r
+ if (i / 8 % 2 == i % 2) @push cyan; else @push red;\r
+ if (position->i < threshold) @push white; else @push black;\r
+ @set_colour sp sp;\r
+ }\r
+ else\r
+ if (i / 8 % 2 == i % 2) style roman; else style reverse;\r
+ \r
+ ! Print the piece symbol\r
+\r
+ ! Could look weird if system does not support color or both reverse and\r
+ ! bold type\r
+ if (i == mover) style bold;\r
+\r
+ if (~~position->i) print (char) ' ';\r
+ else if (position->i < threshold) print (char) 'W';\r
+ else print (char) 'B';\r
+\r
+ if (unicode_support) {\r
+ switch (position->i) {\r
+ nothing: print (char) ' ';\r
+ wPawn: @"EXT:11" uni_wPawn;\r
+ wKnight: @"EXT:11" uni_wKnight;\r
+ wBishop: @"EXT:11" uni_wBishop;\r
+ wRook: @"EXT:11" uni_wRook;\r
+ wQueen: @"EXT:11" uni_wQueen;\r
+ wKing: @"EXT:11" uni_wKing;\r
+ bPawn: @"EXT:11" uni_bPawn;\r
+ bKnight: @"EXT:11" uni_bKnight;\r
+ bBishop: @"EXT:11" uni_bBishop;\r
+ bRook: @"EXT:11" uni_bRook;\r
+ bQueen: @"EXT:11" uni_bQueen;\r
+ bKing: @"EXT:11" uni_bKing;\r
+ }\r
+ } else {\r
+ switch (position->i) {\r
+ nothing: print (char) ' ';\r
+ wPawn, bPawn: print (char) 'P';\r
+ wKnight, bKnight: print (char) 'N';\r
+ wBishop, bBishop: print (char) 'B';\r
+ wRook, bRook: print (char) 'R';\r
+ wQueen, bQueen: print (char) 'Q';\r
+ wKing, bKing: print (char) 'K';\r
+ }\r
+ if (i == mover) style roman;\r
+ }\r
+\r
+ ! If at the end of a row, move to the next line\r
+\r
+ if (i % 8 == 7) {\r
+ style roman;\r
+ @set_colour normal normal;\r
+ if (i < 63) {\r
+ new_line;\r
+ spaces bleft - 1;\r
+ }\r
+ }\r
+ }\r
+];\r
+\r
+! The board caption\r
+\r
+[ PrintCaption;\r
+ if (GameOver) Message(GameOver);\r
+ else {\r
+ if (WhiteToMove) Message(whitemove);\r
+ else Message(blackmove);\r
+ }\r
+];\r
+\r
+! AttemptToMove evaluates the move and makes it if legal\r
+! It returns true if it prints a message, false if not\r
+\r
+[ AttemptToMove start end;\r
+\r
+ ! First, the basic test\r
+\r
+ if (~~MovePrimitive(start, end, position)) {\r
+ Message(illegal); return;\r
+ }\r
+ \r
+ ! Make the move\r
+\r
+ TransferPos(position, working_position);\r
+ DoMove(start, end, working_position);\r
+\r
+ ! If the move is illegal due to check, restore the old game status\r
+\r
+ if (InCheck(working_position)) {\r
+ TransferVarsToNew();\r
+ Message(cillegal);\r
+ return;\r
+ }\r
+\r
+ ! Do promotion if needed\r
+\r
+ if ((end <= h8 || end >= a1) && working_position->end == wPawn or bPawn)\r
+ Promotion(end);\r
+\r
+ ! Update the board\r
+\r
+ TransferPos(working_position, position);\r
+ TransferVarsToOld();\r
+ WhiteToMove = ~~WhiteToMove;\r
+\r
+ ! Finally, evaulate for a draw, win, or check\r
+\r
+ if (HasntLegal()) rfalse;\r
+ if (InCheck(position)) return Message(check);\r
+ rfalse;\r
+];\r
+\r
+! Moving data around\r
+\r
+[ TransferPos p_array1 p_array2 i;\r
+ for (: i < 64: i++) p_array2->i = p_array1->i;\r
+];\r
+\r
+[ TransferVarsToNew;\r
+ wKingPos = owKingPos;\r
+ bKingPos = obKingPos;\r
+ wking_moved = owking_moved;\r
+ bking_moved = obking_moved;\r
+ a1rook_moved = oa1rook_moved;\r
+ h1rook_moved = oh1rook_moved;\r
+ a8rook_moved = oa8rook_moved;\r
+ h8rook_moved = oh8rook_moved;\r
+ epPawn = oepPawn;\r
+];\r
+\r
+[ TransferVarsToOld;\r
+ owKingPos = wKingPos;\r
+ obKingPos = bKingPos;\r
+ owking_moved = wking_moved;\r
+ obking_moved = bking_moved;\r
+ oa1rook_moved = a1rook_moved;\r
+ oh1rook_moved = h1rook_moved;\r
+ oa8rook_moved = a8rook_moved;\r
+ oh8rook_moved = h8rook_moved;\r
+ oepPawn = epPawn;\r
+];\r
+\r
+! MovePrimitive tests if a move is legal, but doesn't\r
+! consider check. Returns true if the move seems legal,\r
+! false if it seems illegal.\r
+\r
+[ MovePrimitive start end p_array side otherside\r
+ srank sfile erank efile a b c d;\r
+\r
+ ! Find the sides of the pieces on the starting\r
+ ! and ending squares\r
+\r
+ side = p_array->start < threshold;\r
+ if (p_array->end == nothing) otherside = NULL;\r
+ else otherside = (p_array->end < threshold);\r
+\r
+ ! If they are the same, stop now\r
+\r
+ if (side == otherside) rfalse;\r
+\r
+ ! Locate the pieces on the board\r
+\r
+ srank = start / 8;\r
+ sfile = start % 8;\r
+ erank = end / 8;\r
+ efile = end % 8;\r
+\r
+ ! Now, the actual evaluation\r
+\r
+ switch (p_array->start) {\r
+ wPawn, bPawn:\r
+ \r
+ ! For pawns, the rules are different for each side\r
+ ! so test and set key numbers appropriately.\r
+ \r
+ if (side) {\r
+ a = 1; b = 6; c = 4; d = 8;\r
+ }\r
+ else {\r
+ a = -1; b = 1; c = 3; d = -8;\r
+ }\r
+ \r
+ if (srank - erank == a) {\r
+ \r
+ ! Standard move?\r
+ \r
+ if (sfile == efile && otherside == NULL) rtrue;\r
+ \r
+ ! Capture?\r
+ \r
+ if (sfile - efile == -1 or 1 &&\r
+ (otherside ~= NULL || eppawn == end+d)) rtrue;\r
+ }\r
+ \r
+ ! Two square move?\r
+\r
+ if (srank == b && erank == c && sfile == efile && (~~p_array->(start-d))\r
+ && otherside == NULL) rtrue;\r
+ \r
+ ! The knights, bishops, rooks, queens, and kings\r
+\r
+ wKnight, bKnight:\r
+ if ((srank - erank == 1 or -1 && sfile - efile == 2 or -2) ||\r
+ (srank - erank == 2 or -2 && sfile - efile == 1 or -1)) rtrue;\r
+ wBishop, bBishop:\r
+ return DiagonalMove(srank, sfile, erank, efile, p_array);\r
+ wRook, bRook:\r
+ return StraightMove(srank, sfile, erank, efile, p_array);\r
+ wQueen, bQueen:\r
+ return DiagonalMove(srank, sfile, erank, efile, p_array)\r
+ || StraightMove(srank, sfile, erank, efile, p_array);\r
+ wKing, bKing:\r
+ if (srank - erank < 2 && erank - srank < 2\r
+ && sfile - efile < 2 && efile - sfile < 2) rtrue;\r
+ }\r
+\r
+ ! Castling?\r
+\r
+ if (p_array->start == wKing && ~~wking_moved) {\r
+ if (end == g1 && ~~h1rook_moved)\r
+ return StraightMove(7, 4, 7, 7, p_array);\r
+ if (end == c1 && ~~a1rook_moved)\r
+ return StraightMove(7, 4, 7, 0, p_array);\r
+ }\r
+ if (p_array->start == bKing && ~~bking_moved) {\r
+ if (end == g8 && ~~h8rook_moved)\r
+ return StraightMove(0, 4, 0, 7, p_array);\r
+ if (end == c8 && ~~a8rook_moved)\r
+ return StraightMove(0, 4, 0, 0, p_array);\r
+ }\r
+ rfalse;\r
+];\r
+\r
+! DiagonalMove tests if a diagonal move is valid.\r
+! That is, that the squares are diagonal from each other\r
+! and nothing is in the way. Returns true if valid, false if not.\r
+\r
+[ DiagonalMove srank sfile erank efile p_array i j;\r
+\r
+ ! Make sure squares are diagonal from each other\r
+\r
+ if (srank - erank ~= sfile - efile or efile - sfile) rfalse;\r
+\r
+ ! Before testing for obstacles, find the direction of the move\r
+\r
+ if (srank < erank) i = 1; else i = -1;\r
+ if (sfile < efile) j = 1; else j = -1;\r
+\r
+ ! Now test for obstacles\r
+\r
+ for (::) {\r
+ srank = srank + i; sfile = sfile + j;\r
+ if (srank == erank) break;\r
+ if (p_array->(srank * 8 + sfile)) rfalse;\r
+ }\r
+];\r
+\r
+! StraightMove is similar to DiagonalMove\r
+\r
+[ StraightMove srank sfile erank efile p_array i;\r
+ if (srank ~= erank && sfile ~= efile) rfalse;\r
+ if (srank == erank) {\r
+ if (sfile < efile) i = 1; else i = -1;\r
+ for (::) {\r
+ sfile = sfile + i;\r
+ if (sfile == efile) break;\r
+ if (p_array->(srank * 8 + sfile)) rfalse;\r
+ }\r
+ }\r
+ else {\r
+ if (srank < erank) i = 1; else i = -1;\r
+ for (::) {\r
+ srank = srank + i;\r
+ if (srank == erank) break;\r
+ if (p_array->(srank * 8 + sfile)) rfalse;\r
+ }\r
+ }\r
+];\r
+\r
+! DoMove actually performs the move, taking special note of\r
+! castling and en passant.\r
+\r
+[ DoMove start end p_array;\r
+\r
+ ! If en passant, remove the pawn being taken\r
+\r
+ if (p_array->end == nothing && (start - end) % 8 &&\r
+ p_array->start == wPawn or bPawn)\r
+ p_array->(epPawn) = nothing;\r
+ \r
+ ! If a pawn is being moved 2 squares, store it in epPawn\r
+ ! If not, we clear it\r
+\r
+ epPawn = NULL;\r
+ \r
+ if (p_array->start == wPawn or bPawn && start - end == 16 or -16)\r
+ epPawn = end;\r
+ \r
+ ! Set movement variables if necessary\r
+\r
+ if (start == a1) a1rook_moved = true;\r
+ else if (start == h1) h1rook_moved = true;\r
+ else if (start == a8) a8rook_moved = true;\r
+ else if (start == h8) h8rook_moved = true;\r
+ else if (start == e1) wKing_moved = true;\r
+ else if (start == e8) bKing_moved = true;\r
+\r
+ ! The move\r
+\r
+ p_array->end = p_array->start;\r
+ p_array->start = nothing;\r
+ \r
+ ! Set variable if a king moved\r
+\r
+ if (p_array->end == wKing) wKingPos = end;\r
+ else if (p_array->end == bKing) bKingPos = end;\r
+\r
+ ! If castling, move the rooks also, and set just_castled\r
+\r
+ just_castled = false;\r
+ if (p_array->end == wKing && start == e1) {\r
+ if (end == g1) {DoMove(h1, f1, p_array); just_castled = true;}\r
+ else if (end == c1) {DoMove(a1, d1, p_array); just_castled = true;}\r
+ }\r
+ else if (p_array->end == bKing && start == e8) {\r
+ if (end == g8) {DoMove(h8, f8, p_array); just_castled = true;}\r
+ else if (end == c8) {DoMove(a8, d8, p_array); just_castled = true;}\r
+ }\r
+];\r
+ \r
+! Promotion finds from the player the piece to promote to and executes\r
+! the promotion.\r
+\r
+[ Promotion pawn input a i;\r
+ if (working_position->pawn == bPawn) a = 6;\r
+ message(promote);\r
+ i = (width - 20) / 2 + 21;\r
+ @set_cursor mrow i;\r
+\r
+ while (1) {\r
+ @read_char 1 -> input;\r
+ switch (input) {\r
+ 'q', 'Q': working_position->pawn = wQueen + a; return;\r
+ 'n', 'N': working_position->pawn = wKnight + a; return;\r
+ 'b', 'B': working_position->pawn = wBishop + a; return;\r
+ 'r', 'R': working_position->pawn = wRook + a; return;\r
+ }\r
+ }\r
+];\r
+\r
+! InCheck tests if the current side to move is in check.\r
+! Returns true if in check, false if not.\r
+\r
+[ InCheck p_array king kstart kmiddle i s_ep; \r
+\r
+ ! First, find the king\r
+\r
+ if (WhiteToMove) king = wKingPos; else king = bKingPos;\r
+\r
+ ! If castling, check the starting and middle squares too.\r
+\r
+ if (just_castled) {\r
+ if (king == g1) { kstart = e1; kmiddle = f1; }\r
+ else if (king == c1) { kstart = e1; kmiddle = d1; }\r
+ else if (king == g8) { kstart = e8; kmiddle = f8; }\r
+ else if (king == c8) { kstart = e8; kmiddle = d8; }\r
+ }\r
+\r
+ if (kstart) {\r
+ s_ep = epPawn; ! DoMove wrecks epPawn. Save a backup.\r
+ DoMove(king, kstart, p_array);\r
+ if (InCheck(p_array)) i = true;\r
+ DoMove(kstart, kmiddle, p_array);\r
+ if (InCheck(p_array)) i = true;\r
+ DoMove(kmiddle, king, p_array);\r
+ if (WhiteToMove) p_array->kmiddle = wRook;\r
+ else p_array->kmiddle = bRook;\r
+ epPawn = s_ep;\r
+ if (i) rtrue;\r
+ }\r
+\r
+ ! Now, find all enemy pieces, and use MovePrimitive\r
+ ! to see if they can take the king\r
+\r
+ if (WhiteToMove)\r
+ for (: i < 64: i++) {\r
+ if (p_array->i < threshold) continue;\r
+ if (MovePrimitive(i, king, p_array)) rtrue;\r
+ }\r
+ else\r
+ for (: i < 64: i++) {\r
+ if (p_array->i == nothing) continue;\r
+ if (p_array->i < threshold\r
+ && MovePrimitive(i, king, p_array)) rtrue;\r
+ }\r
+ rfalse;\r
+];\r
+\r
+! HasntLegal tests if the game is over due to checkmate, stalemate,\r
+! or insufficiant material to mate, and sets gameover accordingly.\r
+\r
+[ HasntLegal i j k knight lbishop dbishop;\r
+\r
+ ! Try to find a legal move for side to move with MovePrimitive, DoMove, and InCheck.\r
+\r
+ if (WhiteToMove)\r
+ for (: i < 64: i++) {\r
+ if (position->i == nothing ||\r
+ position->i >= threshold) continue;\r
+ for (j = 0: j < 64: j++) {\r
+ if (MovePrimitive(i, j, position) && DoMove(i, j, position)\r
+ && (~~InCheck(position))) k = true;\r
+ TransferPos(working_position, position);\r
+ TransferVarsToNew();\r
+ if (k) jump out;\r
+ }\r
+ }\r
+ else\r
+ for (: i < 64: i++) {\r
+ if (position->i < threshold) continue;\r
+ for (j = 0: j < 64: j++) {\r
+ if (MovePrimitive(i, j, position) && DoMove(i, j, position)\r
+ && (~~InCheck(position))) k = true;\r
+ TransferPos(working_position, position);\r
+ TransferVarsToNew();\r
+ if (k) jump out;\r
+ }\r
+ }\r
+\r
+ .out;\r
+\r
+ ! If i is 64, the entire loop found no legal move\r
+\r
+ if (i == 64) {\r
+ if (InCheck(position)) gameover = checkmate;\r
+ else gameover = stalemate;\r
+ rtrue;\r
+ }\r
+\r
+ ! The final task is to check for low pieces. Anything other than\r
+ ! a minor piece or king means no draw. Two minor pieces\r
+ ! mean no draw, unless they are two bishops found on the same\r
+ ! color square. The same is true of any number of bishops\r
+ ! of the same color square.\r
+\r
+ for (i = 0: i < 64: i++)\r
+ switch (position->i) {\r
+ wPawn, bPawn, wRook, bRook, wQueen, bQueen: rfalse;\r
+ wKnight, bKnight:\r
+ if (knight || lbishop || dbishop) rfalse;\r
+ knight = true;\r
+ wBishop, bBishop:\r
+ if (i / 8 % 2 == i % 2) lbishop = true;\r
+ else dbishop = true;\r
+ if (knight || (lbishop && dbishop)) rfalse;\r
+ }\r
+ gameover = lowpieces;\r
+]; \r
+\r
+! A routine to center all the messages neatly under the board\r
+\r
+[ Message num start;\r
+ num = num * 2;\r
+ start = (width - mArray-->(num+1)) / 2;\r
+ @set_cursor mrow 1;\r
+ spaces start;\r
+ print (string) mArray-->num;\r
+ spaces start;\r
+];\r