zchess.inf

   1 ! Z-Chess: two-player chess for the Z-machine\r
   2 ! Copyright (C) 2002, 2003, 2004 Eric Schmidt\r
   3 \r
   4 ! This program is free software; you can redistribute it and/or modify\r
   5 ! it under the terms of the GNU General Public License as published by\r
   6 ! the Free Software Foundation; either version 3 of the License, or\r
   7 ! (at your option) any later version.\r
   8 \r
   9 ! This program is distributed in the hope that it will be useful,\r
  10 ! but WITHOUT ANY WARRANTY; without even the implied warranty of\r
  11 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
  12 ! GNU General Public License for more details.\r
  13 ! You should have received a copy of the GNU General Public License\r
  14 ! along with this program. If not see http://www.gnu.org/licenses/\r
  15 \r
  16 ! The author may be contacted at <eschmidt@safeaccess.com>.\r
  17 \r
  18 Release 4;\r
  19 Serial "040124";\r
  20 \r
  21 ! ---------------------------------------\r
  22 ! Constants, Arrays, and Global Variables\r
  23 ! ---------------------------------------\r
  24 \r
  25 Constant NULL = -1;\r
  26 \r
  27 ! The screen size\r
  28 \r
  29 Global width; Global height;\r
  30 \r
  31 ! The board position\r
  32 \r
  33 Global bleft; Global btop;\r
  34 \r
  35 ! The board colors\r
  36 \r
  37 Global colorflag;\r
  38 Constant normal = 1;\r
  39 Constant black  = 2;\r
  40 Constant red    = 3;\r
  41 Constant cyan   = 8;\r
  42 Constant white  = 9;\r
  43 \r
  44 ! Unicode\r
  45 \r
  46 Global unicode_support = false;\r
  47 \r
  48 ! Code points for chess symbols\r
  49 \r
  50 Constant uni_wKing   = $2654;\r
  51 Constant uni_wQueen  = $2655;\r
  52 Constant uni_wRook   = $2656;\r
  53 Constant uni_wBishop = $2657;\r
  54 Constant uni_wKnight = $2658;\r
  55 Constant uni_wPawn   = $2659;\r
  56 Constant uni_bKing   = $265a;\r
  57 Constant uni_bQueen  = $265b;\r
  58 Constant uni_bRook   = $265c;\r
  59 Constant uni_bBishop = $265d;\r
  60 Constant uni_bKnight = $265e;\r
  61 Constant uni_bPawn   = $265f;\r
  62 \r
  63 ! Reading from the keyboard\r
  64 \r
  65 Constant uKey     = $81;\r
  66 Constant dKey     = $82;\r
  67 Constant lKey     = $83;\r
  68 Constant rKey     = $84;\r
  69 Constant EnterKey = $0d;\r
  70 \r
  71 ! The board caption system\r
  72 \r
  73 Global mrow;\r
  74 \r
  75 Constant whitemove =  0;\r
  76 Constant blackmove =  1;\r
  77 Constant promote   =  2;\r
  78 Constant illegal   =  3;\r
  79 Constant cillegal  =  4;\r
  80 Constant check     =  5;\r
  81 Constant checkmate =  6;\r
  82 Constant stalemate =  7;\r
  83 Constant lowpieces =  8;\r
  84 Constant saveyes   =  9;\r
  85 Constant loadyes   = 10;\r
  86 Constant saveno    = 11;\r
  87 Constant loadno    = 12;\r
  88 \r
  89 ! Notice that all the messages the game displays are of even length.\r
  90 ! This is deliberate. The window is likely to be of even width\r
  91 ! and so only even-lengthed messages can be perfectly centered.\r
  92 \r
  93 Array mArray -->\r
  94 ! message                    length\r
  95   "White's turn to move"     20\r
  96   "Black's turn to move"     20\r
  97   "Type letter of piece"     20\r
  98   "Illegal move"             12\r
  99   "Illegal move - check"     20\r
 100   "Check!"                   6\r
 101   "Checkmate!"               10\r
 102   "Stalemate!"               10\r
 103   "Draw by too few pieces"   22\r
 104   "Save succeeded"           14\r
 105   "Load succeeded"           14\r
 106   "Unable to save"           14\r
 107   "Unable to load"           14;\r
 108 \r
 109 ! Cursor location\r
 110 \r
 111 Global rank = 6; Global file = 0; ! This defaults to WQRP\r
 112 \r
 113 ! Currently selected piece;\r
 114 \r
 115 Global mover = NULL;\r
 116 \r
 117 ! The position\r
 118 \r
 119 Constant wPawn   = 1;\r
 120 Constant wKnight = 2;\r
 121 Constant wBishop = 3;\r
 122 Constant wRook   = 4;\r
 123 Constant wQueen  = 5;\r
 124 Constant wKing   = 6;\r
 125 \r
 126 Constant threshold = 7; ! If (a_piece < threshold), it is white.\r
 127 \r
 128 Constant bPawn   = 7;\r
 129 Constant bKnight = 8;\r
 130 Constant bBishop = 9;\r
 131 Constant bRook   = 10;\r
 132 Constant bQueen  = 11;\r
 133 Constant bKing   = 12;\r
 134 \r
 135 Array position ->\r
 136   bRook   bKnight bBishop bQueen  bKing   bBishop bKnight bRook\r
 137   bPawn   bPawn   bPawn   bPawn   bPawn   bPawn   bPawn   bPawn\r
 138   nothing nothing nothing nothing nothing nothing nothing nothing\r
 139   nothing nothing nothing nothing nothing nothing nothing nothing\r
 140   nothing nothing nothing nothing nothing nothing nothing nothing\r
 141   nothing nothing nothing nothing nothing nothing nothing nothing\r
 142   wPawn   wPawn   wPawn   wPawn   wPawn   wPawn   wPawn   wPawn\r
 143   wRook   wKnight wBishop wQueen  wKing   wBishop wKnight wRook;\r
 144 \r
 145 Array working_position -> 64;\r
 146 \r
 147 Global WhiteToMove = true;\r
 148 \r
 149 Constant e1 = 60;\r
 150 Constant e8 = 4;\r
 151 \r
 152 ! For calculating check\r
 153 ! We define "old" variables for backups\r
 154 \r
 155 Global wKingPos = e1; Global owKingPos;\r
 156 Global bKingPos = e8; Global obKingPos;\r
 157 \r
 158 ! Castling\r
 159 \r
 160 Global just_castled;\r
 161 \r
 162 Global wking_moved;  Global owking_moved;\r
 163 Global bking_moved;  Global obking_moved;\r
 164 Global a1rook_moved; Global oa1rook_moved;\r
 165 Global h1rook_moved; Global oh1rook_moved;\r
 166 Global a8rook_moved; Global oa8rook_moved;\r
 167 Global h8rook_moved; Global oh8rook_moved;\r
 168 \r
 169 ! The numbers of squares to do with castling\r
 170 ! (It would be nice if Inform had octal numbers.)\r
 171 \r
 172 Constant a8 = 0;\r
 173 Constant a1 = 56;\r
 174 Constant h1 = 63;\r
 175 Constant h8 = 7;\r
 176 \r
 177 Constant f1 = 61;\r
 178 Constant g1 = 62;\r
 179 Constant d1 = 59;\r
 180 Constant c1 = 58;\r
 181 \r
 182 Constant f8 = 5;\r
 183 Constant g8 = 6;\r
 184 Constant d8 = 3;\r
 185 Constant c8 = 2;\r
 186 \r
 187 ! En passant\r
 188 \r
 189 Global epPawn = NULL; Global oepPawn = NULL;\r
 190 \r
 191 ! The current game status\r
 192 \r
 193 Global GameOver;\r
 194 \r
 195 ! ------------\r
 196 ! The Routines\r
 197 ! ------------\r
 198 \r
 199 ! The main routine: set game up and receive input\r
 200 \r
 201 [ Main input square piece i j;\r
 202 \r
 203   ! Check for large enough screen\r
 204 \r
 205   height = 0->$20;\r
 206   width = 0->$21;\r
 207   if (width < 22)  "Regretably, this interpreter has not provided a\r
 208                     wide enough window for this program.";\r
 209   if (height < 10) "Regretably, this interpreter has not provided a\r
 210                     tall enough window for this program.";\r
 211 \r
 212   ! Check for color. If the fixed-pitch font bit is set in the header, we got\r
 213   ! here from a restart and shouldn't warn about the color.\r
 214 \r
 215   if (0->1 & 1) colorflag = true;\r
 216   else if (0-->$8 & $$10) font on;            ! Turn bit back off\r
 217   else {\r
 218     print "WARNING: This interpreter has not provided color.\r
 219            The game may not perform optimally.^";\r
 220     @read_char 1 -> input;\r
 221   }\r
 222 \r
 223   ! Locate board\r
 224 \r
 225   bleft = (width - 16) / 2 + 1;\r
 226   btop  = (height - 10) / 2 + 2;\r
 227   if (height % 2) btop++;           ! Favor lower row\r
 228   mrow  = btop + 8;\r
 229 \r
 230   CheckUnicode();\r
 231 \r
 232   CompleteRedraw();\r
 233 \r
 234   ! Main gain loop\r
 235 \r
 236   while (1) {\r
 237     ! Set cursor position\r
 238 \r
 239     i = btop + rank;\r
 240     j = file * 2 + bleft;\r
 241     @set_cursor i j;\r
 242 \r
 243     ! Receive input\r
 244 \r
 245     @read_char 1 -> input;\r
 246     switch (input) {\r
 247       'c', 'C':\r
 248         @erase_window -1;\r
 249         print "^^Release 1 - Initial release^^\r
 250                Release 2\r
 251                ^  * Added color support\r
 252                ^  * Fixed two castling bugs^^\r
 253                Release 3\r
 254                ^  * Unicode support\r
 255                ^  * Changed license to GPL^^\r
 256                Release 4\r
 257                ^  * Added ability to save and restore game";\r
 258           @read_char 1 -> input;\r
 259           CompleteRedraw();\r
 260 \r
 261       'd', 'D':\r
 262         @erase_window -1;\r
 263         print "Use the arrow keys to move the cursor around.\r
 264                Press space bar (or enter) to select a piece. \r
 265                Move the cursor to the square you want to move the\r
 266                piece, and press space bar (or enter) again to move.\r
 267                To castle, move the king to its destination, and the\r
 268                rook will automatically move to its. To deselect the \r
 269                piece you've selected, press space bar when the cursor\r
 270                is on the piece.^^\r
 271                White pieces are indicated by the letter W and black pieces by\r
 272                B. If supported by your system, the piece type will be shown as\r
 273                a chess figurine. If not, a letter is used. This is the first\r
 274                letter of the piece's name, except that a knight is represented\r
 275                by N.^^\r
 276                When a pawn promotion occurs, you must specify which type of\r
 277                piece to promote it to. Do this by typing the letter of the\r
 278                piece you want to promote it to.^^\r
 279                At the main display, you can type D to view these directions,\r
 280                I to view legal information, C to view major changes between\r
 281                versions, Q to quit, N to start a new game, S to save a game,\r
 282                or L to load a game from disk.^^\r
 283                The author may be contacted at <eschmidt@@64safeaccess.com>.";\r
 284         @read_char 1 -> input;\r
 285         CompleteRedraw();\r
 286 \r
 287       'i', 'I':\r
 288         @erase_window -1;\r
 289         print "Z-Chess: Chess for the Z-Machine^\r
 290                Copyright (C) 2002, 2003, 2004 Eric Schmidt^^\r
 291                This program is free software. It may be distributed\r
 292                under the terms of the GNU General Public License\r
 293                version 2, or (at your option) any later version.^^\r
 294                This program is distributed in the hope that it will be\r
 295                useful, but WITHOUT ANY WARRANTY; without even the implied\r
 296                warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\r
 297                See the GNU General Public License for more details. You should\r
 298                have received a copy of the GNU General Public License along\r
 299                with this program; if not, write to the Free Software\r
 300                Foundation, Inc., 59 Temple Place, Suite 330, Boston,\r
 301                MA 02111-1307 USA"; \r
 302         @read_char 1 -> input;\r
 303         CompleteRedraw();\r
 304 \r
 305       'l', 'L':\r
 306         @erase_window -1;\r
 307         @restore -> i;\r
 308         CompleteRedraw();\r
 309         Message(loadno);          ! Load failed if we get here\r
 310 \r
 311       'n', 'N':\r
 312          font off;                ! Hack: We use the fixed-pitch font bit to\r
 313          @restart;                ! signal that a restart is taking place\r
 314 \r
 315       'q', 'Q':\r
 316         @set_cursor height 1;\r
 317         @erase_line 1;\r
 318         quit;\r
 319 \r
 320       'r', 'R':\r
 321         @erase_window -1;\r
 322         @restore -> i;\r
 323         CompleteRedraw();\r
 324         Message(loadno);         ! Cannot reach here if succeeded\r
 325 \r
 326       's', 'S':\r
 327         @erase_window -1;\r
 328         @save -> i;\r
 329         CompleteRedraw();  \r
 330         switch (i) {\r
 331           0: Message(saveno);\r
 332           1: Message(saveyes);\r
 333           2: Message(loadyes);\r
 334         }\r
 335  \r
 336       uKey: if (rank > 0) { rank--; PrintCaption(); }\r
 337       dKey: if (rank < 7) { rank++; PrintCaption(); }\r
 338       lKey: if (file > 0) { file--; PrintCaption(); }\r
 339       rKey: if (file < 7) { file++; PrintCaption(); }\r
 340       EnterKey, ' ':\r
 341         if (GameOver) break;\r
 342         square = rank * 8 + file;\r
 343         piece = position->square;\r
 344         if (mover == NULL && piece\r
 345           && WhiteToMove == (piece < threshold)) mover = square;\r
 346         else if (mover == square) mover = NULL;\r
 347         else if (mover ~= NULL) {\r
 348           if (~~AttemptToMove(mover,square)) PrintCaption();\r
 349           mover = NULL;\r
 350         }\r
 351         PrintPos();\r
 352     }\r
 353   }\r
 354 ];\r
 355 \r
 356 [ CheckUnicode i;\r
 357   ! Pre 1.0 terps won't allow @check_unicode\r
 358   if (~~(0->$32)) return;\r
 359 \r
 360   @split_window height;\r
 361   @set_window 1;\r
 362 \r
 363   ! Would there be support for one chess glyph but not the\r
 364   ! others? Well, we might as well be on the safe side.\r
 365   @"EXT:12S" uni_wKing   -> i; if (~~(i & 1)) return;\r
 366   @"EXT:12S" uni_wQueen  -> i; if (~~(i & 1)) return;\r
 367   @"EXT:12S" uni_wRook   -> i; if (~~(i & 1)) return;\r
 368   @"EXT:12S" uni_wBishop -> i; if (~~(i & 1)) return;\r
 369   @"EXT:12S" uni_wKnight -> i; if (~~(i & 1)) return;\r
 370   @"EXT:12S" uni_wPawn   -> i; if (~~(i & 1)) return;\r
 371   @"EXT:12S" uni_bKing   -> i; if (~~(i & 1)) return;\r
 372   @"EXT:12S" uni_bQueen  -> i; if (~~(i & 1)) return;\r
 373   @"EXT:12S" uni_bRook   -> i; if (~~(i & 1)) return;\r
 374   @"EXT:12S" uni_bBishop -> i; if (~~(i & 1)) return;\r
 375   @"EXT:12S" uni_bKnight -> i; if (~~(i & 1)) return;\r
 376   @"EXT:12S" uni_bPawn   -> i; if (~~(i & 1)) return;\r
 377 \r
 378   ! The interpreter has passed the sieve.\r
 379   unicode_support = true;\r
 380 ];\r
 381 \r
 382 [ CompleteRedraw;\r
 383   @split_window height;\r
 384   @set_window 1;\r
 385   @erase_window -2;\r
 386   style reverse;                                  \r
 387   print "(D)irections"; spaces width - 18; print "(I)nfo";\r
 388   style roman;\r
 389 \r
 390   PrintPos();\r
 391   PrintCaption();\r
 392 ];\r
 393 \r
 394 ! Routine to print the position\r
 395 \r
 396 [ PrintPos i;\r
 397   @set_cursor btop bleft;\r
 398 \r
 399   for (: i < 64: i++) {\r
 400     \r
 401     ! Set printing colors, considering color support\r
 402 \r
 403     if (colorflag) {\r
 404       if (i / 8 % 2 == i % 2) @push cyan; else @push red;\r
 405       if (position->i < threshold) @push white; else @push black;\r
 406       @set_colour sp sp;\r
 407     }\r
 408     else\r
 409       if (i / 8 % 2 == i % 2) style roman; else style reverse;\r
 410  \r
 411     ! Print the piece symbol\r
 412 \r
 413     ! Could look weird if system does not support color or both reverse and\r
 414     ! bold type\r
 415     if (i == mover) style bold;\r
 416 \r
 417     if (~~position->i) print (char) ' ';\r
 418     else if (position->i < threshold) print (char) 'W';\r
 419     else print (char) 'B';\r
 420 \r
 421     if (unicode_support) {\r
 422       switch (position->i) {\r
 423         nothing: print (char) ' ';\r
 424         wPawn:   @"EXT:11" uni_wPawn;\r
 425         wKnight: @"EXT:11" uni_wKnight;\r
 426         wBishop: @"EXT:11" uni_wBishop;\r
 427         wRook:   @"EXT:11" uni_wRook;\r
 428         wQueen:  @"EXT:11" uni_wQueen;\r
 429         wKing:   @"EXT:11" uni_wKing;\r
 430         bPawn:   @"EXT:11" uni_bPawn;\r
 431         bKnight: @"EXT:11" uni_bKnight;\r
 432         bBishop: @"EXT:11" uni_bBishop;\r
 433         bRook:   @"EXT:11" uni_bRook;\r
 434         bQueen:  @"EXT:11" uni_bQueen;\r
 435         bKing:   @"EXT:11" uni_bKing;\r
 436       }\r
 437     } else {\r
 438       switch (position->i) {\r
 439         nothing: print (char) ' ';\r
 440         wPawn, bPawn:     print (char) 'P';\r
 441         wKnight, bKnight: print (char) 'N';\r
 442         wBishop, bBishop: print (char) 'B';\r
 443         wRook, bRook:     print (char) 'R';\r
 444         wQueen, bQueen:   print (char) 'Q';\r
 445         wKing, bKing:     print (char) 'K';\r
 446       }\r
 447     if (i == mover) style roman;\r
 448     }\r
 449 \r
 450     ! If at the end of a row, move to the next line\r
 451 \r
 452     if (i % 8 == 7) {\r
 453       style roman;\r
 454       @set_colour normal normal;\r
 455       if (i < 63) {\r
 456         new_line;\r
 457         spaces bleft - 1;\r
 458       }\r
 459     }\r
 460   }\r
 461 ];\r
 462 \r
 463 ! The board caption\r
 464 \r
 465 [ PrintCaption;\r
 466     if (GameOver) Message(GameOver);\r
 467     else {\r
 468       if (WhiteToMove) Message(whitemove);\r
 469       else Message(blackmove);\r
 470     }\r
 471 ];\r
 472 \r
 473 ! AttemptToMove evaluates the move and makes it if legal\r
 474 ! It returns true if it prints a message, false if not\r
 475 \r
 476 [ AttemptToMove start end;\r
 477 \r
 478   ! First, the basic test\r
 479 \r
 480   if (~~MovePrimitive(start, end, position)) {\r
 481     Message(illegal); return;\r
 482   }\r
 483     \r
 484   ! Make the move\r
 485 \r
 486   TransferPos(position, working_position);\r
 487   DoMove(start, end, working_position);\r
 488 \r
 489   ! If the move is illegal due to check, restore the old game status\r
 490 \r
 491   if (InCheck(working_position)) {\r
 492     TransferVarsToNew();\r
 493     Message(cillegal);\r
 494     return;\r
 495   }\r
 496 \r
 497   ! Do promotion if needed\r
 498 \r
 499   if ((end <= h8 || end >= a1) && working_position->end == wPawn or bPawn)\r
 500     Promotion(end);\r
 501 \r
 502   ! Update the board\r
 503 \r
 504   TransferPos(working_position, position);\r
 505   TransferVarsToOld();\r
 506   WhiteToMove = ~~WhiteToMove;\r
 507 \r
 508   ! Finally, evaulate for a draw, win, or check\r
 509 \r
 510   if (HasntLegal()) rfalse;\r
 511   if (InCheck(position)) return Message(check);\r
 512   rfalse;\r
 513 ];\r
 514 \r
 515 ! Moving data around\r
 516 \r
 517 [ TransferPos p_array1 p_array2 i;\r
 518   for (: i < 64: i++) p_array2->i = p_array1->i;\r
 519 ];\r
 520 \r
 521 [ TransferVarsToNew;\r
 522   wKingPos     = owKingPos;\r
 523   bKingPos     = obKingPos;\r
 524   wking_moved  = owking_moved;\r
 525   bking_moved  = obking_moved;\r
 526   a1rook_moved = oa1rook_moved;\r
 527   h1rook_moved = oh1rook_moved;\r
 528   a8rook_moved = oa8rook_moved;\r
 529   h8rook_moved = oh8rook_moved;\r
 530   epPawn       = oepPawn;\r
 531 ];\r
 532 \r
 533 [ TransferVarsToOld;\r
 534   owKingPos     = wKingPos;\r
 535   obKingPos     = bKingPos;\r
 536   owking_moved  = wking_moved;\r
 537   obking_moved  = bking_moved;\r
 538   oa1rook_moved = a1rook_moved;\r
 539   oh1rook_moved = h1rook_moved;\r
 540   oa8rook_moved = a8rook_moved;\r
 541   oh8rook_moved = h8rook_moved;\r
 542   oepPawn       = epPawn;\r
 543 ];\r
 544 \r
 545 ! MovePrimitive tests if a move is legal, but doesn't\r
 546 ! consider check. Returns true if the move seems legal,\r
 547 ! false if it seems illegal.\r
 548 \r
 549 [ MovePrimitive start end p_array side otherside\r
 550                 srank sfile erank efile a b c d;\r
 551 \r
 552   ! Find the sides of the pieces on the starting\r
 553   ! and ending squares\r
 554 \r
 555   side = p_array->start < threshold;\r
 556   if (p_array->end == nothing) otherside = NULL;\r
 557     else otherside = (p_array->end < threshold);\r
 558 \r
 559   ! If they are the same, stop now\r
 560 \r
 561   if (side == otherside) rfalse;\r
 562 \r
 563   ! Locate the pieces on the board\r
 564 \r
 565   srank = start / 8;\r
 566   sfile = start % 8;\r
 567   erank = end / 8;\r
 568   efile = end % 8;\r
 569 \r
 570   ! Now, the actual evaluation\r
 571 \r
 572   switch (p_array->start) {\r
 573     wPawn, bPawn:\r
 574       \r
 575       ! For pawns, the rules are different for each side\r
 576       ! so test and set key numbers appropriately.\r
 577       \r
 578       if (side) {\r
 579         a = 1; b = 6; c = 4; d = 8;\r
 580       }\r
 581       else {\r
 582         a = -1; b = 1; c = 3; d = -8;\r
 583       }\r
 584       \r
 585       if (srank - erank == a) {\r
 586       \r
 587         ! Standard move?\r
 588       \r
 589         if (sfile == efile && otherside == NULL) rtrue;\r
 590        \r
 591         ! Capture?\r
 592  \r
 593         if (sfile - efile == -1 or 1 &&\r
 594            (otherside ~= NULL || eppawn == end+d)) rtrue;\r
 595       }\r
 596       \r
 597       ! Two square move?\r
 598 \r
 599       if (srank == b && erank == c && sfile == efile && (~~p_array->(start-d))\r
 600           && otherside == NULL) rtrue;\r
 601     \r
 602     ! The knights, bishops, rooks, queens, and kings\r
 603 \r
 604     wKnight, bKnight:\r
 605       if ((srank - erank == 1 or -1 && sfile - efile == 2 or -2) ||\r
 606           (srank - erank == 2 or -2 && sfile - efile == 1 or -1)) rtrue;\r
 607     wBishop, bBishop:\r
 608       return DiagonalMove(srank, sfile, erank, efile, p_array);\r
 609     wRook, bRook:\r
 610       return StraightMove(srank, sfile, erank, efile, p_array);\r
 611     wQueen, bQueen:\r
 612       return DiagonalMove(srank, sfile, erank, efile, p_array)\r
 613           || StraightMove(srank, sfile, erank, efile, p_array);\r
 614     wKing, bKing:\r
 615      if (srank - erank < 2 && erank - srank < 2\r
 616       && sfile - efile < 2 && efile - sfile < 2) rtrue;\r
 617   }\r
 618 \r
 619   ! Castling?\r
 620 \r
 621   if (p_array->start == wKing && ~~wking_moved) {\r
 622       if (end == g1 && ~~h1rook_moved)\r
 623         return StraightMove(7, 4, 7, 7, p_array);\r
 624       if (end == c1 && ~~a1rook_moved)\r
 625         return StraightMove(7, 4, 7, 0, p_array);\r
 626   }\r
 627   if (p_array->start == bKing && ~~bking_moved) {\r
 628       if (end == g8 && ~~h8rook_moved)\r
 629         return StraightMove(0, 4, 0, 7, p_array);\r
 630       if (end == c8 && ~~a8rook_moved)\r
 631         return StraightMove(0, 4, 0, 0, p_array);\r
 632   }\r
 633   rfalse;\r
 634 ];\r
 635 \r
 636 ! DiagonalMove tests if a diagonal move is valid.\r
 637 ! That is, that the squares are diagonal from each other\r
 638 ! and nothing is in the way. Returns true if valid, false if not.\r
 639 \r
 640 [ DiagonalMove srank sfile erank efile p_array i j;\r
 641 \r
 642   ! Make sure squares are diagonal from each other\r
 643 \r
 644   if (srank - erank ~= sfile - efile or efile - sfile) rfalse;\r
 645 \r
 646   ! Before testing for obstacles, find the direction of the move\r
 647 \r
 648   if (srank < erank) i = 1; else i = -1;\r
 649   if (sfile < efile) j = 1; else j = -1;\r
 650 \r
 651   ! Now test for obstacles\r
 652 \r
 653   for (::) {\r
 654     srank = srank + i; sfile = sfile + j;\r
 655     if (srank == erank) break;\r
 656     if (p_array->(srank * 8 + sfile)) rfalse;\r
 657   }\r
 658 ];\r
 659 \r
 660 ! StraightMove is similar to DiagonalMove\r
 661 \r
 662 [ StraightMove srank sfile erank efile p_array i;\r
 663   if (srank ~= erank && sfile ~= efile) rfalse;\r
 664   if (srank == erank) {\r
 665     if (sfile < efile) i = 1; else i = -1;\r
 666     for (::) {\r
 667       sfile = sfile + i;\r
 668       if (sfile == efile) break;\r
 669       if (p_array->(srank * 8 + sfile)) rfalse;\r
 670     }\r
 671   }\r
 672   else {\r
 673     if (srank < erank) i = 1; else i = -1;\r
 674     for (::) {\r
 675       srank = srank + i;\r
 676       if (srank == erank) break;\r
 677       if (p_array->(srank * 8 + sfile)) rfalse;\r
 678     }\r
 679   }\r
 680 ];\r
 681 \r
 682 ! DoMove actually performs the move, taking special note of\r
 683 ! castling and en passant.\r
 684 \r
 685 [ DoMove start end p_array;\r
 686 \r
 687   ! If en passant, remove the pawn being taken\r
 688 \r
 689   if (p_array->end == nothing && (start - end) % 8 &&\r
 690        p_array->start == wPawn or bPawn)\r
 691           p_array->(epPawn) = nothing;\r
 692   \r
 693   ! If a pawn is being moved 2 squares, store it in epPawn\r
 694   ! If not, we clear it\r
 695 \r
 696   epPawn = NULL;\r
 697   \r
 698   if (p_array->start == wPawn or bPawn && start - end == 16 or -16)\r
 699     epPawn = end;\r
 700   \r
 701   ! Set movement variables if necessary\r
 702 \r
 703        if (start == a1) a1rook_moved = true;\r
 704   else if (start == h1) h1rook_moved = true;\r
 705   else if (start == a8) a8rook_moved = true;\r
 706   else if (start == h8) h8rook_moved = true;\r
 707   else if (start == e1) wKing_moved  = true;\r
 708   else if (start == e8) bKing_moved  = true;\r
 709 \r
 710   ! The move\r
 711 \r
 712   p_array->end = p_array->start;\r
 713   p_array->start = nothing;\r
 714   \r
 715   ! Set variable if a king moved\r
 716 \r
 717   if (p_array->end == wKing) wKingPos = end;\r
 718   else if (p_array->end == bKing) bKingPos = end;\r
 719 \r
 720   ! If castling, move the rooks also, and set just_castled\r
 721 \r
 722   just_castled = false;\r
 723   if (p_array->end == wKing && start == e1) {\r
 724      if      (end == g1) {DoMove(h1, f1, p_array); just_castled = true;}\r
 725      else if (end == c1) {DoMove(a1, d1, p_array); just_castled = true;}\r
 726   }\r
 727   else if (p_array->end == bKing && start == e8) {\r
 728     if      (end == g8) {DoMove(h8, f8, p_array); just_castled = true;}\r
 729     else if (end == c8) {DoMove(a8, d8, p_array); just_castled = true;}\r
 730   }\r
 731 ];\r
 732      \r
 733 ! Promotion finds from the player the piece to promote to and executes\r
 734 ! the promotion.\r
 735 \r
 736 [ Promotion pawn input a i;\r
 737   if (working_position->pawn == bPawn) a = 6;\r
 738   message(promote);\r
 739   i = (width - 20) / 2 + 21;\r
 740   @set_cursor mrow i;\r
 741 \r
 742   while (1) {\r
 743     @read_char 1 -> input;\r
 744     switch (input) {\r
 745       'q', 'Q': working_position->pawn = wQueen  + a; return;\r
 746       'n', 'N': working_position->pawn = wKnight + a; return;\r
 747       'b', 'B': working_position->pawn = wBishop + a; return;\r
 748       'r', 'R': working_position->pawn = wRook   + a; return;\r
 749     }\r
 750   }\r
 751 ];\r
 752 \r
 753 ! InCheck tests if the current side to move is in check.\r
 754 ! Returns true if in check, false if not.\r
 755 \r
 756 [ InCheck p_array king kstart kmiddle i s_ep;  \r
 757 \r
 758   ! First, find the king\r
 759 \r
 760   if (WhiteToMove) king = wKingPos; else king = bKingPos;\r
 761 \r
 762   ! If castling, check the starting and middle squares too.\r
 763 \r
 764   if (just_castled) {\r
 765     if      (king == g1) { kstart = e1;  kmiddle = f1; }\r
 766     else if (king == c1) { kstart = e1;  kmiddle = d1; }\r
 767     else if (king == g8) { kstart = e8;  kmiddle = f8; }\r
 768     else if (king == c8) { kstart = e8;  kmiddle = d8; }\r
 769   }\r
 770 \r
 771   if (kstart) {\r
 772     s_ep = epPawn;              ! DoMove wrecks epPawn. Save a backup.\r
 773     DoMove(king, kstart, p_array);\r
 774     if (InCheck(p_array)) i = true;\r
 775     DoMove(kstart, kmiddle, p_array);\r
 776     if (InCheck(p_array)) i = true;\r
 777     DoMove(kmiddle, king, p_array);\r
 778     if (WhiteToMove) p_array->kmiddle = wRook;\r
 779     else p_array->kmiddle = bRook;\r
 780     epPawn = s_ep;\r
 781     if (i) rtrue;\r
 782   }\r
 783 \r
 784   ! Now, find all enemy pieces, and use MovePrimitive\r
 785   ! to see if they can take the king\r
 786 \r
 787   if (WhiteToMove)\r
 788     for (: i < 64: i++) {\r
 789       if (p_array->i < threshold) continue;\r
 790       if (MovePrimitive(i, king, p_array)) rtrue;\r
 791     }\r
 792   else\r
 793     for (: i < 64: i++) {\r
 794       if (p_array->i == nothing) continue;\r
 795       if (p_array->i < threshold\r
 796           && MovePrimitive(i, king, p_array)) rtrue;\r
 797   }\r
 798   rfalse;\r
 799 ];\r
 800 \r
 801 ! HasntLegal tests if the game is over due to checkmate, stalemate,\r
 802 ! or insufficiant material to mate, and sets gameover accordingly.\r
 803 \r
 804 [ HasntLegal i j k knight lbishop dbishop;\r
 805 \r
 806   ! Try to find a legal move for side to move with MovePrimitive, DoMove, and InCheck.\r
 807 \r
 808   if (WhiteToMove)\r
 809     for (: i < 64: i++) {\r
 810       if (position->i == nothing ||\r
 811           position->i >= threshold) continue;\r
 812       for (j = 0: j < 64: j++) {\r
 813         if (MovePrimitive(i, j, position) && DoMove(i, j, position)\r
 814             && (~~InCheck(position))) k = true;\r
 815         TransferPos(working_position, position);\r
 816         TransferVarsToNew();\r
 817         if (k) jump out;\r
 818       }\r
 819     }\r
 820   else\r
 821     for (: i < 64: i++) {\r
 822       if (position->i < threshold) continue;\r
 823       for (j = 0: j < 64: j++) {\r
 824         if (MovePrimitive(i, j, position) && DoMove(i, j, position)\r
 825             && (~~InCheck(position))) k = true;\r
 826         TransferPos(working_position, position);\r
 827         TransferVarsToNew();\r
 828         if (k) jump out;\r
 829       }\r
 830     }\r
 831 \r
 832   .out;\r
 833 \r
 834   ! If i is 64, the entire loop found no legal move\r
 835 \r
 836   if (i == 64) {\r
 837     if (InCheck(position)) gameover = checkmate;\r
 838       else gameover = stalemate;\r
 839     rtrue;\r
 840   }\r
 841 \r
 842   ! The final task is to check for low pieces. Anything other than\r
 843   ! a minor piece or king means no draw. Two minor pieces\r
 844   ! mean no draw, unless they are two bishops found on the same\r
 845   ! color square. The same is true of any number of bishops\r
 846   ! of the same color square.\r
 847 \r
 848   for (i = 0: i < 64: i++)\r
 849     switch (position->i) {\r
 850       wPawn, bPawn, wRook, bRook, wQueen, bQueen: rfalse;\r
 851       wKnight, bKnight:\r
 852         if (knight || lbishop || dbishop) rfalse;\r
 853         knight = true;\r
 854       wBishop, bBishop:\r
 855         if (i / 8 % 2 == i % 2) lbishop = true;\r
 856         else dbishop = true;\r
 857         if (knight || (lbishop && dbishop)) rfalse;\r
 858     }\r
 859   gameover = lowpieces;\r
 860 ]; \r
 861 \r
 862 ! A routine to center all the messages neatly under the board\r
 863 \r
 864 [ Message num start;\r
 865   num = num * 2;\r
 866   start = (width - mArray-->(num+1)) / 2;\r
 867   @set_cursor mrow 1;\r
 868   spaces start;\r
 869   print (string) mArray-->num;\r
 870   spaces start;\r
 871 ];\r