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