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 3, 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 see http://www.gnu.org/licenses/";\r
 300         @read_char 1 -> input;\r
 301         CompleteRedraw();\r
 302 \r
 303       'l', 'L':\r
 304         @erase_window -1;\r
 305         @restore -> i;\r
 306         CompleteRedraw();\r
 307         Message(loadno);          ! Load failed if we get here\r
 308 \r
 309       'n', 'N':\r
 310          font off;                ! Hack: We use the fixed-pitch font bit to\r
 311          @restart;                ! signal that a restart is taking place\r
 312 \r
 313       'q', 'Q':\r
 314         @set_cursor height 1;\r
 315         @erase_line 1;\r
 316         quit;\r
 317 \r
 318       'r', 'R':\r
 319         @erase_window -1;\r
 320         @restore -> i;\r
 321         CompleteRedraw();\r
 322         Message(loadno);         ! Cannot reach here if succeeded\r
 323 \r
 324       's', 'S':\r
 325         @erase_window -1;\r
 326         @save -> i;\r
 327         CompleteRedraw();  \r
 328         switch (i) {\r
 329           0: Message(saveno);\r
 330           1: Message(saveyes);\r
 331           2: Message(loadyes);\r
 332         }\r
 333  \r
 334       uKey: if (rank > 0) { rank--; PrintCaption(); }\r
 335       dKey: if (rank < 7) { rank++; PrintCaption(); }\r
 336       lKey: if (file > 0) { file--; PrintCaption(); }\r
 337       rKey: if (file < 7) { file++; PrintCaption(); }\r
 338       EnterKey, ' ':\r
 339         if (GameOver) break;\r
 340         square = rank * 8 + file;\r
 341         piece = position->square;\r
 342         if (mover == NULL && piece\r
 343           && WhiteToMove == (piece < threshold)) mover = square;\r
 344         else if (mover == square) mover = NULL;\r
 345         else if (mover ~= NULL) {\r
 346           if (~~AttemptToMove(mover,square)) PrintCaption();\r
 347           mover = NULL;\r
 348         }\r
 349         PrintPos();\r
 350     }\r
 351   }\r
 352 ];\r
 353 \r
 354 [ CheckUnicode i;\r
 355   ! Pre 1.0 terps won't allow @check_unicode\r
 356   if (~~(0->$32)) return;\r
 357 \r
 358   @split_window height;\r
 359   @set_window 1;\r
 360 \r
 361   ! Would there be support for one chess glyph but not the\r
 362   ! others? Well, we might as well be on the safe side.\r
 363   @"EXT:12S" uni_wKing   -> i; if (~~(i & 1)) return;\r
 364   @"EXT:12S" uni_wQueen  -> i; if (~~(i & 1)) return;\r
 365   @"EXT:12S" uni_wRook   -> i; if (~~(i & 1)) return;\r
 366   @"EXT:12S" uni_wBishop -> i; if (~~(i & 1)) return;\r
 367   @"EXT:12S" uni_wKnight -> i; if (~~(i & 1)) return;\r
 368   @"EXT:12S" uni_wPawn   -> i; if (~~(i & 1)) return;\r
 369   @"EXT:12S" uni_bKing   -> i; if (~~(i & 1)) return;\r
 370   @"EXT:12S" uni_bQueen  -> i; if (~~(i & 1)) return;\r
 371   @"EXT:12S" uni_bRook   -> i; if (~~(i & 1)) return;\r
 372   @"EXT:12S" uni_bBishop -> i; if (~~(i & 1)) return;\r
 373   @"EXT:12S" uni_bKnight -> i; if (~~(i & 1)) return;\r
 374   @"EXT:12S" uni_bPawn   -> i; if (~~(i & 1)) return;\r
 375 \r
 376   ! The interpreter has passed the sieve.\r
 377   unicode_support = true;\r
 378 ];\r
 379 \r
 380 [ CompleteRedraw;\r
 381   @split_window height;\r
 382   @set_window 1;\r
 383   @erase_window -2;\r
 384   style reverse;                                  \r
 385   print "(D)irections"; spaces width - 18; print "(I)nfo";\r
 386   style roman;\r
 387 \r
 388   PrintPos();\r
 389   PrintCaption();\r
 390 ];\r
 391 \r
 392 ! Routine to print the position\r
 393 \r
 394 [ PrintPos i;\r
 395   @set_cursor btop bleft;\r
 396 \r
 397   for (: i < 64: i++) {\r
 398     \r
 399     ! Set printing colors, considering color support\r
 400 \r
 401     if (colorflag) {\r
 402       if (i / 8 % 2 == i % 2) @push cyan; else @push red;\r
 403       if (position->i < threshold) @push white; else @push black;\r
 404       @set_colour sp sp;\r
 405     }\r
 406     else\r
 407       if (i / 8 % 2 == i % 2) style roman; else style reverse;\r
 408  \r
 409     ! Print the piece symbol\r
 410 \r
 411     ! Could look weird if system does not support color or both reverse and\r
 412     ! bold type\r
 413     if (i == mover) style bold;\r
 414 \r
 415     if (~~position->i) print (char) ' ';\r
 416     else if (position->i < threshold) print (char) 'W';\r
 417     else print (char) 'B';\r
 418 \r
 419     if (unicode_support) {\r
 420       switch (position->i) {\r
 421         nothing: print (char) ' ';\r
 422         wPawn:   @"EXT:11" uni_wPawn;\r
 423         wKnight: @"EXT:11" uni_wKnight;\r
 424         wBishop: @"EXT:11" uni_wBishop;\r
 425         wRook:   @"EXT:11" uni_wRook;\r
 426         wQueen:  @"EXT:11" uni_wQueen;\r
 427         wKing:   @"EXT:11" uni_wKing;\r
 428         bPawn:   @"EXT:11" uni_bPawn;\r
 429         bKnight: @"EXT:11" uni_bKnight;\r
 430         bBishop: @"EXT:11" uni_bBishop;\r
 431         bRook:   @"EXT:11" uni_bRook;\r
 432         bQueen:  @"EXT:11" uni_bQueen;\r
 433         bKing:   @"EXT:11" uni_bKing;\r
 434       }\r
 435     } else {\r
 436       switch (position->i) {\r
 437         nothing: print (char) ' ';\r
 438         wPawn, bPawn:     print (char) 'P';\r
 439         wKnight, bKnight: print (char) 'N';\r
 440         wBishop, bBishop: print (char) 'B';\r
 441         wRook, bRook:     print (char) 'R';\r
 442         wQueen, bQueen:   print (char) 'Q';\r
 443         wKing, bKing:     print (char) 'K';\r
 444       }\r
 445     if (i == mover) style roman;\r
 446     }\r
 447 \r
 448     ! If at the end of a row, move to the next line\r
 449 \r
 450     if (i % 8 == 7) {\r
 451       style roman;\r
 452       @set_colour normal normal;\r
 453       if (i < 63) {\r
 454         new_line;\r
 455         spaces bleft - 1;\r
 456       }\r
 457     }\r
 458   }\r
 459 ];\r
 460 \r
 461 ! The board caption\r
 462 \r
 463 [ PrintCaption;\r
 464     if (GameOver) Message(GameOver);\r
 465     else {\r
 466       if (WhiteToMove) Message(whitemove);\r
 467       else Message(blackmove);\r
 468     }\r
 469 ];\r
 470 \r
 471 ! AttemptToMove evaluates the move and makes it if legal\r
 472 ! It returns true if it prints a message, false if not\r
 473 \r
 474 [ AttemptToMove start end;\r
 475 \r
 476   ! First, the basic test\r
 477 \r
 478   if (~~MovePrimitive(start, end, position)) {\r
 479     Message(illegal); return;\r
 480   }\r
 481     \r
 482   ! Make the move\r
 483 \r
 484   TransferPos(position, working_position);\r
 485   DoMove(start, end, working_position);\r
 486 \r
 487   ! If the move is illegal due to check, restore the old game status\r
 488 \r
 489   if (InCheck(working_position)) {\r
 490     TransferVarsToNew();\r
 491     Message(cillegal);\r
 492     return;\r
 493   }\r
 494 \r
 495   ! Do promotion if needed\r
 496 \r
 497   if ((end <= h8 || end >= a1) && working_position->end == wPawn or bPawn)\r
 498     Promotion(end);\r
 499 \r
 500   ! Update the board\r
 501 \r
 502   TransferPos(working_position, position);\r
 503   TransferVarsToOld();\r
 504   WhiteToMove = ~~WhiteToMove;\r
 505 \r
 506   ! Finally, evaulate for a draw, win, or check\r
 507 \r
 508   if (HasntLegal()) rfalse;\r
 509   if (InCheck(position)) return Message(check);\r
 510   rfalse;\r
 511 ];\r
 512 \r
 513 ! Moving data around\r
 514 \r
 515 [ TransferPos p_array1 p_array2 i;\r
 516   for (: i < 64: i++) p_array2->i = p_array1->i;\r
 517 ];\r
 518 \r
 519 [ TransferVarsToNew;\r
 520   wKingPos     = owKingPos;\r
 521   bKingPos     = obKingPos;\r
 522   wking_moved  = owking_moved;\r
 523   bking_moved  = obking_moved;\r
 524   a1rook_moved = oa1rook_moved;\r
 525   h1rook_moved = oh1rook_moved;\r
 526   a8rook_moved = oa8rook_moved;\r
 527   h8rook_moved = oh8rook_moved;\r
 528   epPawn       = oepPawn;\r
 529 ];\r
 530 \r
 531 [ TransferVarsToOld;\r
 532   owKingPos     = wKingPos;\r
 533   obKingPos     = bKingPos;\r
 534   owking_moved  = wking_moved;\r
 535   obking_moved  = bking_moved;\r
 536   oa1rook_moved = a1rook_moved;\r
 537   oh1rook_moved = h1rook_moved;\r
 538   oa8rook_moved = a8rook_moved;\r
 539   oh8rook_moved = h8rook_moved;\r
 540   oepPawn       = epPawn;\r
 541 ];\r
 542 \r
 543 ! MovePrimitive tests if a move is legal, but doesn't\r
 544 ! consider check. Returns true if the move seems legal,\r
 545 ! false if it seems illegal.\r
 546 \r
 547 [ MovePrimitive start end p_array side otherside\r
 548                 srank sfile erank efile a b c d;\r
 549 \r
 550   ! Find the sides of the pieces on the starting\r
 551   ! and ending squares\r
 552 \r
 553   side = p_array->start < threshold;\r
 554   if (p_array->end == nothing) otherside = NULL;\r
 555     else otherside = (p_array->end < threshold);\r
 556 \r
 557   ! If they are the same, stop now\r
 558 \r
 559   if (side == otherside) rfalse;\r
 560 \r
 561   ! Locate the pieces on the board\r
 562 \r
 563   srank = start / 8;\r
 564   sfile = start % 8;\r
 565   erank = end / 8;\r
 566   efile = end % 8;\r
 567 \r
 568   ! Now, the actual evaluation\r
 569 \r
 570   switch (p_array->start) {\r
 571     wPawn, bPawn:\r
 572       \r
 573       ! For pawns, the rules are different for each side\r
 574       ! so test and set key numbers appropriately.\r
 575       \r
 576       if (side) {\r
 577         a = 1; b = 6; c = 4; d = 8;\r
 578       }\r
 579       else {\r
 580         a = -1; b = 1; c = 3; d = -8;\r
 581       }\r
 582       \r
 583       if (srank - erank == a) {\r
 584       \r
 585         ! Standard move?\r
 586       \r
 587         if (sfile == efile && otherside == NULL) rtrue;\r
 588        \r
 589         ! Capture?\r
 590  \r
 591         if (sfile - efile == -1 or 1 &&\r
 592            (otherside ~= NULL || eppawn == end+d)) rtrue;\r
 593       }\r
 594       \r
 595       ! Two square move?\r
 596 \r
 597       if (srank == b && erank == c && sfile == efile && (~~p_array->(start-d))\r
 598           && otherside == NULL) rtrue;\r
 599     \r
 600     ! The knights, bishops, rooks, queens, and kings\r
 601 \r
 602     wKnight, bKnight:\r
 603       if ((srank - erank == 1 or -1 && sfile - efile == 2 or -2) ||\r
 604           (srank - erank == 2 or -2 && sfile - efile == 1 or -1)) rtrue;\r
 605     wBishop, bBishop:\r
 606       return DiagonalMove(srank, sfile, erank, efile, p_array);\r
 607     wRook, bRook:\r
 608       return StraightMove(srank, sfile, erank, efile, p_array);\r
 609     wQueen, bQueen:\r
 610       return DiagonalMove(srank, sfile, erank, efile, p_array)\r
 611           || StraightMove(srank, sfile, erank, efile, p_array);\r
 612     wKing, bKing:\r
 613      if (srank - erank < 2 && erank - srank < 2\r
 614       && sfile - efile < 2 && efile - sfile < 2) rtrue;\r
 615   }\r
 616 \r
 617   ! Castling?\r
 618 \r
 619   if (p_array->start == wKing && ~~wking_moved) {\r
 620       if (end == g1 && ~~h1rook_moved)\r
 621         return StraightMove(7, 4, 7, 7, p_array);\r
 622       if (end == c1 && ~~a1rook_moved)\r
 623         return StraightMove(7, 4, 7, 0, p_array);\r
 624   }\r
 625   if (p_array->start == bKing && ~~bking_moved) {\r
 626       if (end == g8 && ~~h8rook_moved)\r
 627         return StraightMove(0, 4, 0, 7, p_array);\r
 628       if (end == c8 && ~~a8rook_moved)\r
 629         return StraightMove(0, 4, 0, 0, p_array);\r
 630   }\r
 631   rfalse;\r
 632 ];\r
 633 \r
 634 ! DiagonalMove tests if a diagonal move is valid.\r
 635 ! That is, that the squares are diagonal from each other\r
 636 ! and nothing is in the way. Returns true if valid, false if not.\r
 637 \r
 638 [ DiagonalMove srank sfile erank efile p_array i j;\r
 639 \r
 640   ! Make sure squares are diagonal from each other\r
 641 \r
 642   if (srank - erank ~= sfile - efile or efile - sfile) rfalse;\r
 643 \r
 644   ! Before testing for obstacles, find the direction of the move\r
 645 \r
 646   if (srank < erank) i = 1; else i = -1;\r
 647   if (sfile < efile) j = 1; else j = -1;\r
 648 \r
 649   ! Now test for obstacles\r
 650 \r
 651   for (::) {\r
 652     srank = srank + i; sfile = sfile + j;\r
 653     if (srank == erank) break;\r
 654     if (p_array->(srank * 8 + sfile)) rfalse;\r
 655   }\r
 656 ];\r
 657 \r
 658 ! StraightMove is similar to DiagonalMove\r
 659 \r
 660 [ StraightMove srank sfile erank efile p_array i;\r
 661   if (srank ~= erank && sfile ~= efile) rfalse;\r
 662   if (srank == erank) {\r
 663     if (sfile < efile) i = 1; else i = -1;\r
 664     for (::) {\r
 665       sfile = sfile + i;\r
 666       if (sfile == efile) break;\r
 667       if (p_array->(srank * 8 + sfile)) rfalse;\r
 668     }\r
 669   }\r
 670   else {\r
 671     if (srank < erank) i = 1; else i = -1;\r
 672     for (::) {\r
 673       srank = srank + i;\r
 674       if (srank == erank) break;\r
 675       if (p_array->(srank * 8 + sfile)) rfalse;\r
 676     }\r
 677   }\r
 678 ];\r
 679 \r
 680 ! DoMove actually performs the move, taking special note of\r
 681 ! castling and en passant.\r
 682 \r
 683 [ DoMove start end p_array;\r
 684 \r
 685   ! If en passant, remove the pawn being taken\r
 686 \r
 687   if (p_array->end == nothing && (start - end) % 8 &&\r
 688        p_array->start == wPawn or bPawn)\r
 689           p_array->(epPawn) = nothing;\r
 690   \r
 691   ! If a pawn is being moved 2 squares, store it in epPawn\r
 692   ! If not, we clear it\r
 693 \r
 694   epPawn = NULL;\r
 695   \r
 696   if (p_array->start == wPawn or bPawn && start - end == 16 or -16)\r
 697     epPawn = end;\r
 698   \r
 699   ! Set movement variables if necessary\r
 700 \r
 701        if (start == a1) a1rook_moved = true;\r
 702   else if (start == h1) h1rook_moved = true;\r
 703   else if (start == a8) a8rook_moved = true;\r
 704   else if (start == h8) h8rook_moved = true;\r
 705   else if (start == e1) wKing_moved  = true;\r
 706   else if (start == e8) bKing_moved  = true;\r
 707 \r
 708   ! The move\r
 709 \r
 710   p_array->end = p_array->start;\r
 711   p_array->start = nothing;\r
 712   \r
 713   ! Set variable if a king moved\r
 714 \r
 715   if (p_array->end == wKing) wKingPos = end;\r
 716   else if (p_array->end == bKing) bKingPos = end;\r
 717 \r
 718   ! If castling, move the rooks also, and set just_castled\r
 719 \r
 720   just_castled = false;\r
 721   if (p_array->end == wKing && start == e1) {\r
 722      if      (end == g1) {DoMove(h1, f1, p_array); just_castled = true;}\r
 723      else if (end == c1) {DoMove(a1, d1, p_array); just_castled = true;}\r
 724   }\r
 725   else if (p_array->end == bKing && start == e8) {\r
 726     if      (end == g8) {DoMove(h8, f8, p_array); just_castled = true;}\r
 727     else if (end == c8) {DoMove(a8, d8, p_array); just_castled = true;}\r
 728   }\r
 729 ];\r
 730      \r
 731 ! Promotion finds from the player the piece to promote to and executes\r
 732 ! the promotion.\r
 733 \r
 734 [ Promotion pawn input a i;\r
 735   if (working_position->pawn == bPawn) a = 6;\r
 736   message(promote);\r
 737   i = (width - 20) / 2 + 21;\r
 738   @set_cursor mrow i;\r
 739 \r
 740   while (1) {\r
 741     @read_char 1 -> input;\r
 742     switch (input) {\r
 743       'q', 'Q': working_position->pawn = wQueen  + a; return;\r
 744       'n', 'N': working_position->pawn = wKnight + a; return;\r
 745       'b', 'B': working_position->pawn = wBishop + a; return;\r
 746       'r', 'R': working_position->pawn = wRook   + a; return;\r
 747     }\r
 748   }\r
 749 ];\r
 750 \r
 751 ! InCheck tests if the current side to move is in check.\r
 752 ! Returns true if in check, false if not.\r
 753 \r
 754 [ InCheck p_array king kstart kmiddle i s_ep;  \r
 755 \r
 756   ! First, find the king\r
 757 \r
 758   if (WhiteToMove) king = wKingPos; else king = bKingPos;\r
 759 \r
 760   ! If castling, check the starting and middle squares too.\r
 761 \r
 762   if (just_castled) {\r
 763     if      (king == g1) { kstart = e1;  kmiddle = f1; }\r
 764     else if (king == c1) { kstart = e1;  kmiddle = d1; }\r
 765     else if (king == g8) { kstart = e8;  kmiddle = f8; }\r
 766     else if (king == c8) { kstart = e8;  kmiddle = d8; }\r
 767   }\r
 768 \r
 769   if (kstart) {\r
 770     s_ep = epPawn;              ! DoMove wrecks epPawn. Save a backup.\r
 771     DoMove(king, kstart, p_array);\r
 772     if (InCheck(p_array)) i = true;\r
 773     DoMove(kstart, kmiddle, p_array);\r
 774     if (InCheck(p_array)) i = true;\r
 775     DoMove(kmiddle, king, p_array);\r
 776     if (WhiteToMove) p_array->kmiddle = wRook;\r
 777     else p_array->kmiddle = bRook;\r
 778     epPawn = s_ep;\r
 779     if (i) rtrue;\r
 780   }\r
 781 \r
 782   ! Now, find all enemy pieces, and use MovePrimitive\r
 783   ! to see if they can take the king\r
 784 \r
 785   if (WhiteToMove)\r
 786     for (: i < 64: i++) {\r
 787       if (p_array->i < threshold) continue;\r
 788       if (MovePrimitive(i, king, p_array)) rtrue;\r
 789     }\r
 790   else\r
 791     for (: i < 64: i++) {\r
 792       if (p_array->i == nothing) continue;\r
 793       if (p_array->i < threshold\r
 794           && MovePrimitive(i, king, p_array)) rtrue;\r
 795   }\r
 796   rfalse;\r
 797 ];\r
 798 \r
 799 ! HasntLegal tests if the game is over due to checkmate, stalemate,\r
 800 ! or insufficiant material to mate, and sets gameover accordingly.\r
 801 \r
 802 [ HasntLegal i j k knight lbishop dbishop;\r
 803 \r
 804   ! Try to find a legal move for side to move with MovePrimitive, DoMove, and InCheck.\r
 805 \r
 806   if (WhiteToMove)\r
 807     for (: i < 64: i++) {\r
 808       if (position->i == nothing ||\r
 809           position->i >= threshold) continue;\r
 810       for (j = 0: j < 64: j++) {\r
 811         if (MovePrimitive(i, j, position) && DoMove(i, j, position)\r
 812             && (~~InCheck(position))) k = true;\r
 813         TransferPos(working_position, position);\r
 814         TransferVarsToNew();\r
 815         if (k) jump out;\r
 816       }\r
 817     }\r
 818   else\r
 819     for (: i < 64: i++) {\r
 820       if (position->i < threshold) continue;\r
 821       for (j = 0: j < 64: j++) {\r
 822         if (MovePrimitive(i, j, position) && DoMove(i, j, position)\r
 823             && (~~InCheck(position))) k = true;\r
 824         TransferPos(working_position, position);\r
 825         TransferVarsToNew();\r
 826         if (k) jump out;\r
 827       }\r
 828     }\r
 829 \r
 830   .out;\r
 831 \r
 832   ! If i is 64, the entire loop found no legal move\r
 833 \r
 834   if (i == 64) {\r
 835     if (InCheck(position)) gameover = checkmate;\r
 836       else gameover = stalemate;\r
 837     rtrue;\r
 838   }\r
 839 \r
 840   ! The final task is to check for low pieces. Anything other than\r
 841   ! a minor piece or king means no draw. Two minor pieces\r
 842   ! mean no draw, unless they are two bishops found on the same\r
 843   ! color square. The same is true of any number of bishops\r
 844   ! of the same color square.\r
 845 \r
 846   for (i = 0: i < 64: i++)\r
 847     switch (position->i) {\r
 848       wPawn, bPawn, wRook, bRook, wQueen, bQueen: rfalse;\r
 849       wKnight, bKnight:\r
 850         if (knight || lbishop || dbishop) rfalse;\r
 851         knight = true;\r
 852       wBishop, bBishop:\r
 853         if (i / 8 % 2 == i % 2) lbishop = true;\r
 854         else dbishop = true;\r
 855         if (knight || (lbishop && dbishop)) rfalse;\r
 856     }\r
 857   gameover = lowpieces;\r
 858 ]; \r
 859 \r
 860 ! A routine to center all the messages neatly under the board\r
 861 \r
 862 [ Message num start;\r
 863   num = num * 2;\r
 864   start = (width - mArray-->(num+1)) / 2;\r
 865   @set_cursor mrow 1;\r
 866   spaces start;\r
 867   print (string) mArray-->num;\r
 868   spaces start;\r
 869 ];\r