Fusion Chess on the Chess Variants Game Courier

0 echo Please report any bugs or errors to Fergus Duniho 1 setflag a1 a8 h1 h8 e1 e8 2 set kpos any lambda (findpiece #0 spaces) (k kr kb kn) 3 set Kpos any lambda (findpiece #0 spaces) (K KR KB KN) 4 set ep false 5 set wpr 2 6 set bpr 7 7 set fps 2 8 set pzs 1 9 set wprom Q R B N 10 set bprom q r b n 11 set wcastle c1 g1 12 set bcastle c8 g8 13 alias rb q RB Q 14 include fairychess 15 setconst k King 16 setconst K King 17 def Cavalier_King sub uncheckedknightleap #0 #1 or == var movetype CHECK and checkleap #0 #1 1 2 or checkleap #0 #1 1 0 or checkleap #0 #1 1 1 18 copyfn Eques_Rex-Range Cavalier_King-Range 19 set Cavalier_King-Range "The Cavalier King may move as a King or a Knight. When moving as a Knight, it must have a path to its destination that is unchecked. This may start orthogonally and turn diagonally or vice versa. As long as one path is clear, the Knight leap is legal. If both paths have a checked space, then the Knight leap in that direction is illegal. This restriction on its ability to move as a Knight does not impair its ability to check an opponent's royal piece." 20 setconst kn Cavalier_King 21 setconst KN Cavalier_King 22 def Pontiff sub uncheckedpath #0 #1 or == var movetype CHECK and checkride #0 #1 1 1 or checkleap #0 #1 1 0 23 copyfn Dragon_Horse-Range Pontiff-Range 24 set Pontiff-Desc "The Pontiff may move as a Bishop or as a King. When moving as a Bishop, it may not pass through check, though this doesn't hinder its ability to check the opponent's royal piece." 25 setconst kb Pontiff 26 setconst KB Pontiff 27 def Dragon_King sub uncheckedpath #0 #1 or == var movetype CHECK and checkride #0 #1 1 0 or checkleap #0 #1 1 1 28 set Dragon_King-Desc "The Dragon King may move as a Rook or as a King. When moving as a Rook, it may not pass through check, though this doesn't hinder its ability to check the opponent's royal piece." 29 setconst kr Dragon_King 30 setconst KR Dragon_King 31 setconst rb Queen 32 setconst RB Queen 33 setconst rn Marshall 34 setconst RN Marshall 35 copyfn Cardinal Paladin 36 copyfn Cardinal-Range Paladin-Range 37 set Paladin-Desc var Cardinal-Range 38 setconst bn Paladin 39 setconst BN Paladin 40 setconst r Rook 41 setconst R Rook 42 setconst b Bishop 43 setconst B Bishop 44 setconst n Knight 45 setconst N Knight 46 setconst p Black_Pawn 47 setconst P White_Pawn 48 set cap assoc Q 0 M 0 A 0 R 0 B 0 N 0 P 0 q 0 m 0 a 0 r 0 b 0 n 0 p 0 49 sub postauto1 50 if not isconst alias $moved 51 print list "The Piece" alias $moved "is undefined." 52 die 53 elseif islower $moved 54 die You may not move one of your opponent's pieces. 55 endif 56 set codename const alias $moved 57 set name alias #codename 58 if != alias $moved alias $named 59 if not isconst alias $named 60 print alias $moved 61 die The piece $named is undefined. 62 elseif islower $named 63 die "You may not split one of your pieces into one of your opponent's pieces." 64 elseif capture 65 die "Fission must be to an empty space." 66 endif 67 set codename2 const alias $named 68 set name2 alias #codename2 69 if != 1 levenshtein alias $moved alias $named or <= strlen alias $moved strlen alias $named 70 set errmsg str_replace "_" " " list "Your" #name "cannot split into a" #name2 "component." 71 die #errmsg 72 elseif not fn #codename2 $origin $dest and isfunc #codename2 73 set errmsg list "You may not move a" #name2 "from" $origin "to" join $dest ".
" 74 set desc join #codename2 "-Desc" 75 set errmsg str_replace "_" " " join #errmsg str_replace "%s" #name2 var #desc 76 die #errmsg 77 endif 78 add $named $dest 79 set remainder realname str_replace alias $named "" alias $moved 80 add #remainder $origin 81 if sub fission-attacked $origin $dest 82 die "Fission is legal only for a piece that is not attacked." 83 endif 84 elseif isupper $old 85 if not match alias $moved R B N 86 set errmsg str_replace "_" " " list "Your" $old "may not initiate fusion with your" join #name "." 87 die #errmsg 88 elseif not match alias $old K R B N 89 set errmsg str_replace "_" " " list "You may not force fusion on your" join alias const alias $old "." 90 die #errmsg 91 elseif == alias $moved alias $old 92 die "You may not fuse two pieces of the same type." 93 elseif not fn #codename $origin $dest and isfunc #codename 94 set errmsg list "You may not move a" #name "from" $origin "to" join $dest ".
" 95 set desc join #name "-Desc" 96 set errmsg str_replace "_" " " join #errmsg str_replace "%s" #name var #desc 97 die #errmsg 98 endif 99 set compound join alias $moved alias $old 100 if not isconst #compound 101 set compound join alias $old alias $moved 102 endif 103 set compound realname #compound 104 add #compound $dest 105 elseif sub #codename $origin $dest and issub #codename 106 elseif fn #codename $origin $dest and isfunc #codename and not issub #codename 107 else 108 set errmsg list "You may not move a" #name "from" $origin "to" join $dest ".
" 109 set desc join #codename "-Desc" 110 set errmsg str_replace "_" " " join #errmsg str_replace "%s" #name var #desc 111 die #errmsg 112 endif 113 if != #codename White_Pawn 114 set ep false 115 if capture 116 set nopvc 0 117 else 118 inc nopvc 119 endif 120 endif 121 if match alias $named K KR KB KN 122 set Kpos $dest 123 endif 124 if sub checked var Kpos 125 die You may not move into check. 126 endif 127 unsetflag $origin $dest 128 set posvar join "w" join fencode boardflags 129 inc #posvar 130 if islower $old and capture 131 setelem cap $old + 1 elem $old #cap 132 endif 133 endsub 134 sub postauto2 135 if not isconst alias $moved 136 set errmsg list "The Piece" alias $moved "is undefined." 137 die #errmsg 138 elseif isupper $moved 139 die You may not move one of your opponent's pieces. 140 endif 141 set codename const alias $moved 142 set name alias #codename 143 if != alias $moved alias $named 144 if not isconst alias $named 145 print alias $moved 146 die The piece $named is undefined. 147 elseif isupper $named 148 die "You may not split one of your pieces into one of your opponent's pieces." 149 elseif capture 150 die "Fission must be to an empty space." 151 endif 152 set codename2 const alias $named 153 set name2 alias #codename2 154 if != 1 levenshtein alias $moved alias $named or <= strlen alias $moved strlen alias $named 155 set errmsg str_replace "_" " " list "Your" #name "cannot split into a" #name2 "component." 156 die #errmsg 157 elseif not fn #codename2 $origin $dest and isfunc #codename2 158 set errmsg list "You may not move a" #name2 "from" $origin "to" join $dest ".
" 159 set desc join #codename2 "-Desc" 160 set errmsg str_replace "_" " " join #errmsg str_replace "%s" #name2 var #desc 161 die #errmsg 162 endif 163 add $named $dest 164 set remainder realname str_replace alias $named "" alias $moved 165 add #remainder $origin 166 if sub fission-attacked $origin $dest 167 die "Fission is legal only for a piece that is not attacked." 168 endif 169 elseif islower $old 170 if not match alias $moved r b n 171 set errmsg str_replace "_" " " list "Your" $old "may not initiate fusion with your" join alias #codename "." 172 die #errmsg 173 elseif not match alias $old k r b n 174 set errmsg str_replace "_" " " list "You may not force fusion on your" const alias $old "." 175 die #errmsg 176 elseif == alias $moved alias $old 177 die "You may not fuse two pieces of the same type." 178 elseif not fn #codename $origin $dest and isfunc #codename 179 set errmsg list "You may not move a" #name "from" $origin "to" join $dest ".
" 180 set desc join #name "-Desc" 181 set errmsg str_replace "_" " " join #errmsg str_replace "%s" #name var #desc 182 die #errmsg 183 endif 184 set compound join alias $moved alias $old 185 if not isconst #compound 186 set compound join alias $old alias $moved 187 endif 188 set compound realname #compound 189 add #compound $dest 190 elseif sub #codename $origin $dest and issub #codename 191 elseif fn #codename $origin $dest and isfunc #codename and not issub #codename 192 else 193 set errmsg list "You may not move a" #name "from" $origin "to" join $dest ".
" 194 set desc join #codename "-Desc" 195 set errmsg str_replace "_" " " join #errmsg str_replace "%s" #name var #desc 196 die #errmsg 197 endif 198 if != #codename Black_Pawn 199 set ep false 200 if capture 201 set nopvc 0 202 else 203 inc nopvc 204 endif 205 endif 206 if match alias $named k kr kb kn 207 set kpos $dest 208 endif 209 if sub checked var kpos 210 die You may not move into check. 211 endif 212 unsetflag $origin $dest 213 set posvar join "b" join fencode boardflags 214 inc #posvar 215 if isupper $old and capture 216 setelem cap $old + 1 elem $old #cap 217 endif 218 endsub 219 moveindex 0 220 MOVE: N g1-f3 221 postauto1 222 moveindex 1 223 MOVE: p g7-g6 224 postauto2 225 moveindex 2 226 MOVE: P d2-d4 227 postauto1 228 moveindex 3 229 MOVE: b f8-g7 230 postauto2 231 moveindex 4 232 MOVE: P e2-e3 233 postauto1 234 moveindex 5 235 MOVE: p d7-d5 236 postauto2 237 moveindex 6 238 MOVE: B f1-d3 239 postauto1 240 moveindex 7 241 MOVE: n b8-c6 242 postauto2 243 moveindex 8 244 MOVE: P c2-c4 245 postauto1 246 moveindex 9 247 MOVE: p e7-e6 248 postauto2 249 moveindex 10 250 MOVE: P c4-c5 251 postauto1 252 moveindex 11 253 MOVE: n g8-e7 254 postauto2 255 moveindex 12 256 MOVE: K e1-g1 257 postauto1 258 moveindex 13 259 MOVE: k e8-g8 260 postauto2 261 moveindex 14 262 MOVE: P a2-a4 263 postauto1 264 moveindex 15 265 MOVE: p e6-e5 266 postauto2 267 moveindex 16 268 MOVE: P d4-e5 269 postauto1 270 moveindex 17 271 MOVE: n e7-c8 272 postauto2 273 moveindex 18 274 MOVE: P e3-e4 275 postauto1 276 moveindex 19 277 MOVE: n c6-e5 278 postauto2 279 moveindex 20 280 MOVE: N f3-e5 281 postauto1 282 moveindex 21 283 MOVE: b g7-e5 284 postauto2 285 moveindex 22 286 MOVE: R a1-a3 287 postauto1 288 moveindex 23 289 MOVE: bn c8-e6 290 postauto2 291 moveindex 24 292 MOVE: P e4-d5 293 postauto1 294 moveindex 25 295 MOVE: bn e6-d5 296 postauto2 297 moveindex 26 298 MOVE: P b2-b4 299 postauto1 300 moveindex 27 301 MOVE: bn d5-b4 302 postauto2 303 moveindex 28 304 MOVE: R a3-b3 305 postauto1 306 moveindex 29 307 MOVE: bn b4-c5 308 postauto2 309 moveindex 30 310 MOVE: R b3-b5 311 postauto1 312 moveindex 31 313 MOVE: bn c5-d6 314 postauto2 315 moveindex 32 316 MOVE: R b5-b3 317 postauto1 318 moveindex 33 319 MOVE: b e5-h2 320 postauto2 321 moveindex 34 322 MOVE: K g1-h1 323 postauto1 324 moveindex 35 325 MOVE: rb d8-h4 326 postauto2 327 moveindex 36 328 MOVE: RB d1-f3 329 postauto1 330 moveindex 37 331 MOVE: b h2-g3 332 postauto2 333 moveindex 38 334 MOVE: K h1-g1 335 postauto1 336 moveindex 39 337 MOVE: rb h4-h2 338 postauto2 339 set posvar join "b" join fencode boardflags 340 if >= var #posvar 3 341 say Three Times Repetition! Drawn Game! 342 drawn 343 elseif sub fusion-stalemated var Kpos 344 if sub checked var Kpos 345 say Checkmate! Black has won! 346 won 347 else 348 say Stalemate! The game is drawn. 349 drawn 350 endif 351 elseif >= #nopvc 100 352 say Fifty Moves Without Moving a Pawn or Capturing! Game Drawn! 353 drawn 354 elseif sub checked var Kpos 355 say Check! 356 endif 357 setsystem capturedpieces var cap 358 end 359 360 lib fairychess 361 if flag use-chess-defaults 362 setconst k King 363 setconst K King 364 setconst q Queen 365 setconst Q Queen 366 setconst r Rook 367 setconst R Rook 368 setconst b Bishop 369 setconst B Bishop 370 setconst n Knight 371 setconst N Knight 372 setconst p Black_Pawn 373 setconst P White_Pawn 374 endif 375 if flag use-chess-defaults 376 set wpr 2 377 set bpr 7 378 set fps 2 379 set pzs 1 380 set wcastle c1 g1 381 set bcastle c8 g8 382 set wprom Q R B N 383 set bprom q r b n 384 set promotable p P 385 elseif not isset wpr 386 set message join "Set the wpr variable to the value of White's Pawn Rank. This is the single rank on which all of White's Pawns start. This would be 2 for Chess.
" var message 387 elseif not isset bpr 388 set message join "Set the bpr variable to the value of Black's Pawn Rank. This is the single rank on which all of Black's Pawns start. This would be 7 for Chess.
" var message 389 elseif not isset fps 390 set message join "Set the fps variable to the value of the maximum number of spaces a Pawn may move on its first move. This would be 2 in Chess.
" var message 391 elseif not isset pzs 392 set message join "Set the pzs variable to the value of the Promotion Zone Size. This is the number of ranks on the opposite side of the board on which Pawns may promote. This would be 1 for Chess.
" var message 393 elseif not isset wcastle 394 set message join "Set the wcastle variable to a space-separated list of the coordinates of the spaces the White King may move to when castling. This would be c1 g1 for Chess.
" var message 395 elseif not isset bcastle 396 set message join "Set the bcastle variable to a space-separated list of the coordinates of the spaces the Black King may move to when castling. This would be c8 g8 for Chess.
" var message 397 elseif not isset wprom 398 set message join "Set the wprom variable to the pieces that a White Pawn may promote to on reaching the Promotion Zone. White's pieces will normally be uppercase, and this would be Q R B N for Chess.
" var message 399 elseif not isset bprom 400 set message join "Set the bprom variable to the pieces that a Black Pawn may promote to on reaching the Promotion Zone. Black's pieces will normally be lowercase, and this would be q r b n for Chess.
" var message 401 endif 402 set ep false 403 setsystem maxmove 2 404 ban commands allmoves 405 allow moves 1 captures 1 promotions 2 406 set Aanca-Desc "The %s may move one space orthgonally, and so long as it is unblocked, it may continue its move in an outward diagonal direction." 407 def Aanca fn (checkride #0 #1 1 1 and empty #0) where #0 0 sign - rank #1 rank #0 #1 or fn (checkride #0 #1 1 1 and empty #0) where #0 sign - file #1 file #0 0 #1 or checkleap #0 #1 1 0 408 def Aanca-Range mergeall leaps #0 1 0 rays where #0 0 1 1 1 rays where #0 0 -1 1 1 rays where #0 1 0 1 1 rays where #0 -1 0 1 1 409 set Amazon-Desc "The %s may move in a straight line in any direction, as a Queen does, or it may leap the the opposite end of a 1x2 rectangle, as a Knight does." 410 def Amazon fn Bishop #0 #1 or fn Rook #0 #1 or fn Knight #0 #1 411 def Amazon-Range merge leaps # 1 2 merge rays #0 1 0 rays #0 1 1 412 set Bede-Desc "The %s may move along any diagonal line, as a Bishop does, or it may leap two spaces away in any orthogonal direction, as a Dabababah does." 413 def Bede checkride #0 #1 1 1 or checkleap #0 #1 0 2 414 def Bede-Range merge rays #0 1 1 leaps #0 0 2 415 def White_Berolina_Pawn remove var epc and checkleap #0 #1 1 0 and == #1 var epp or and checkride #0 #1 1 1 == rankname #0 var wpr or checkleap #0 #1 1 1 and empty #1 or and islower space #1 checkleap #0 #1 1 0 and <= distance #0 #1 var fps and > rank #1 rank #0 416 def Black_Berolina_Pawn remove var epc and checkleap #0 #1 1 0 and == #1 var epp or and checkride #0 #1 1 1 == rankname #0 var bpr or checkleap #0 #1 1 1 and empty #1 or and isupper space #1 checkleap #0 #1 1 0 and <= distance #0 #1 var fps and < rank #1 rank #0 417 def White_Berolina_Pawn-Range filter lambda (onboard #1) mergeall where #ori 0 1 values lambda (where #ori neg #1 #1) range 1 var fps values lambda (where #ori #1 #1) range 1 var fps =ori 418 def Black_Berolina_Pawn-Range filter lambda (onboard #1) mergeall where #ori 0 -1 values lambda (where #ori neg #1 neg #1) range 1 var fps values lambda (where #ori #1 neg #1) range 1 var fps =ori 419 set White_Berolina_Pawn-Desc "The %s may move one space diagonally forward without capturing, or it may move one space straight forward to capture. On its first move, it may move two spaces diagonally forward without capturing so long as it isn't blocked. If this move takes it next to an enemy %s that could have captured it if it had just moved one space, that %s may immediately capture it by en passant, moving to the space it passed over. On reaching the last rank, it may promote." 420 set Black_Berolina_Pawn-Desc var White_Berolina_Pawn-Desc 421 sub White_Berolina_Pawn from to 422 verify > rank #to rank #from 423 verify <= distance #to #from #fps 424 if capture 425 verify checkleap #from #to 1 0 426 set epp false 427 set epc false 428 elseif checkleap #from #to 1 0 and == #to #epp 429 capture #epc 430 set epp false 431 set epc false 432 elseif > distance #to #from 1 433 verify == rankname #from #wpr 434 verify checkride #from #to 1 1 435 set epp elem 0 path #from #to 436 set epc #to 437 else 438 verify checkleap #from #to 1 1 439 set epp false 440 set epc false 441 endif 442 if onboard where #to 0 #pzs 443 if != space #to $moved 444 set name alias const alias $moved 445 die "You may not promote a" #name "until it reaches the promotion zone." 446 endif 447 elseif onboard where #to 0 1 448 if == White_Berolina_Pawn const alias space #to and count var wprom 449 if not $answered and == mln $maxmln 450 push wprom space #to 451 askpromote #wprom 452 endif 453 elseif not match space #to var wprom and != White_Pawn const alias space #to 454 set name alias const alias $moved 455 set newname alias const alias space #to 456 set msg list "You may not promote your" #name "to a" join #newname ".
" 457 set msg str_replace "_" " " var msg 458 die #msg 459 endif 460 elseif count var wprom 461 if == White_Berolina_Pawn const alias space #to 462 if == count var wprom 1 463 set newpiece join list var wprom 464 set newmove join #newpiece "-dest" 465 add #newpiece $dest 466 appendmove #newmove 467 else 468 askpromote #wprom 469 endif 470 elseif not match space #to var wprom 471 set name alias const alias $moved 472 set newname alias const alias space #to 473 set msg list "You may not promote your" #name "to a" join #newname ".
" 474 set msg str_replace "_" " " var msg 475 die #msg 476 endif 477 else 478 set name alias const alias $moved 479 set msg list "You may not advance your" #name "to the last rank, because there is nothing you may promote it to." 480 set msg str_replace "_" " " var msg 481 die #msg 482 endif 483 set nopvc 0 484 return true 485 endsub 486 sub Black_Berolina_Pawn from to 487 verify < rank #to rank #from 488 verify <= distance #to #from #fps 489 if capture 490 verify checkleap #from #to 1 0 491 set epp false 492 set epc false 493 elseif checkleap #from #to 1 0 and == #to #epp 494 capture #epc 495 set epp false 496 set epc false 497 elseif > distance #to #from 1 498 verify == rankname #from #bpr 499 verify checkride #from #to 1 1 500 set epp elem 0 path #from #to 501 set epc #to 502 else 503 verify checkleap #from #to 1 1 504 set epp false 505 set epc false 506 endif 507 if onboard where #to 0 neg #pzs 508 if != space #to $moved 509 set name alias const alias $moved 510 die "You may not promote a" #name "until it reaches the promotion zone." 511 endif 512 elseif onboard where #to 0 -1 513 if == Black_Berolina_Pawn const alias space #to and count var bprom 514 if not $answered and == mln $maxmln 515 push bprom space #to 516 askpromote #bprom 517 endif 518 elseif not match space #to var bprom and != Black_Pawn const alias space #to 519 set name alias const alias $moved 520 set newname alias const alias space #to 521 set msg list "You may not promote your" #name "to a" join #newname ".
" 522 set msg str_replace "_" " " var msg 523 die #msg 524 endif 525 elseif count var bprom 526 if == Black_Berolina_Pawn const alias space #to 527 if == count var bprom 1 528 set newpiece join list var bprom 529 set newmove join #newpiece "-dest" 530 add #newpiece $dest 531 appendmove #newmove 532 else 533 askpromote #bprom 534 endif 535 elseif not match space #to var bprom 536 set name alias const alias $moved 537 set newname alias const alias space #to 538 set msg list "You may not promote your" #name "to a" join #newname ".
" 539 set msg str_replace "_" " " var msg 540 die #msg 541 endif 542 else 543 set name alias const alias $moved 544 set msg list "You may not advance your" #name "to the last rank, because there is nothing you may promote it to." 545 set msg str_replace "_" " " var msg 546 die #msg 547 endif 548 set nopvc 0 549 return true 550 endsub 551 def Bishop checkride #0 #1 1 1 552 def Bishop-Range rays #0 1 1 553 set Bishop-Desc "The %s may move diagonally any number of spaces until it reaches an occupied space." 554 def Cannon cond cond empty #0 capture (not empty #1) (checkhop #0 #1 0 1) (checkride #0 #1 0 1) and #1 555 def Cannon-Range rays #0 1 0 556 set Cannon-Desc "The %s moves any number of spaces orthogonally, as a Rook does, but it must hop over an intervening piece to capture." 557 def Camel checkleap #0 #1 1 3 558 def Camel-Range leaps #0 1 3 559 set Camel-Desc "The %s leaps to any space at the opposite corner of a 1x3 rectangle." 560 def Camelrider checkride #0 #1 1 3 561 def Camelrider-Range rays #0 1 3 562 set Camelrider-Desc "The %s may make any number of Camel moves in the same direction until it lands on an occupied space." 563 def Cardinal fn Bishop #0 #1 or fn Knight #0 #1 564 def Cardinal-Range merge leaps #0 1 2 rays #0 1 1 565 set Cardinal-Desc "The %s may move along diagonals as a Bishop or leap as a Knight." 566 def Centaur checkleap #0 #1 1 1 or checkleap #0 #1 1 0 or checkleap #0 #1 1 2 567 def Centaur-Range merge leaps #0 1 2 merge leaps #0 1 0 leaps #0 1 1 568 set Centaur-Desc "The %s may move to any adjacent space as a King or leap like a Knight." 569 def Champion fn Elephant #0 #1 or fn Dabbabah #0 #1 or fn Wazir #0 #1 570 def Champion-Range mergeall leaps #0 2 2 leaps #0 2 0 leaps #0 1 0 571 set Champion-Desc "The %s may leap one or two spaces orthogonally or two spaces diagonally." 572 def White_Charging_Knight cond < rank #0 rank #1 (checkleap #0 #1 1 2) (checkleap #0 #1 1 1 or checkleap #0 #1 1 0) 573 def White_Charging_Knight-Range mergeall leaps #0 1 2 leaps #0 1 1 leaps #0 1 0 574 set White_Charging_Knight-Desc "The %s may leap forward as a Knight or move one space sideways or backwards like a King." 575 def Black_Charging_Knight cond > rank #0 rank #1 (checkleap #0 #1 1 2) (checkleap #0 #1 1 1 or checkleap #0 #1 1 0) 576 def Black_Charging_Knight-Range mergeall leaps #0 1 2 leaps #0 1 1 leaps #0 1 0 577 set Black_Charging_Knight-Desc "The %s may leap forward as a Knight or move one space sideways or backwards like a King." 578 def White_Charging_Rook checkride #0 #1 1 0 and <= rank #0 rank #1 or checkaleap #0 #1 -1 -1 or checkaleap #0 #1 -1 0 or checkaleap #0 #1 -1 1 579 def White_Charging_Rook-Range mergeall ray #0 0 -1 ray #0 1 0 ray #0 0 1 where #0 -1 1 where #0 1 0 where #0 1 1 580 set White_Charging_Rook-Desc "The %s may move forward or sideways along its file or rank like a Rook, or it may move one space backwards in any direction like a King." 581 def Black_Charging_Rook checkride #0 #1 1 0 and >= rank #0 rank #1 or checkaleap #0 #1 -1 1 or checkaleap #0 #1 1 0 or checkaleap #0 #1 1 1 582 def Black_Charging_Rook-Range mergeall ray #0 0 -1 ray #0 -1 0 ray #0 0 1 where #0 -1 1 where #0 1 0 where #0 1 1 583 set Black_Charging_Rook-Desc "The %s may move forward or sideways along its file or rank like a Rook, or it may move one space backwards in any direction like a King." 584 def Chinese_Elephant checkpath #0 #1 1 1 1 1 585 def Chinese_Elephant-Range leaps #0 2 2 586 set Chinese_Elephant-Desc "The %s may move two spaces diagonally so long as the space in between is empty." 587 def White_Chinese_Elephant checkpath #0 #1 1 1 1 1 and < rank #1 + 1 / lastrank 2 588 def White_Chinese_Elephant-Range leaps #0 2 2 589 set White_Chinese_Elephant-Desc "The %s may move two spaces diagonally so long as the space in between is empty, but it is confined to the ranks on its own side of the board." 590 def Black_Chinese_Elephant checkpath #0 #1 1 1 1 1 and >= rank #1 + 1 / lastrank 2 591 def Black_Chinese_Elephant-Range leaps #0 2 2 592 set Black_Chinese_Elephant-Desc "The %s may move two spaces diagonally so long as the space in between is empty, but it is confined to the ranks on its own side of the board." 593 def Chinese_General checkride #0 #1 1 0 and == Chinese_General const alias cond empty #0 capture space #1 or checkleap #0 #1 0 1 and flag #1 594 def Chinese_General checkride #0 #1 1 0 and == Chinese_General const alias cond empty #0 capture space #1 or checkleap #0 #1 0 1 and flag #1 595 def Chinese_General == distance #0 #1 1 or == var movetype CHECK and checkride #0 #1 1 0 and flag #1 596 def Chinese_General-Range leaps #0 1 0 597 set Chinese_General-Desc "The %s may move one space orthogonally within the confines of the Palace, but it may not face the opponent's %s along an open file." 598 def Chinese_Guard checkleap #0 #1 1 1 and flag #1 599 def Chinese_Guard-Range leaps #0 1 1 600 set Chinese_Guard-Desc "The %s may move one space diagonally within the confines of the palace." 601 def White_Chinese_Pawn checkaleap #0 #1 -1 0 or checkaleap #0 #1 1 0 and >= rank #0 + 1 / lastrank 2 or checkaleap #0 #1 0 1 602 def Black_Chinese_Pawn checkaleap #0 #1 -1 0 or checkaleap #0 #1 1 0 and < rank #0 + 1 / lastrank 2 or checkaleap #0 #1 0 -1 603 def White_Chinese_Pawn-Range leaps #0 1 0 604 def Black_Chinese_Pawn-Range leaps #0 1 0 605 set White_Chinese_Pawn-Desc "The %s may move one space forward. Once it has reached the other side of the board, it may also move one space sideways." 606 set Black_Chinese_Pawn-Desc "The %s may move one space forward. Once it has reached the other side of the board, it may also move one space sideways." 607 def White_Colonel checkride #0 #1 1 0 or checkleap #0 #1 1 2 and >= rank #1 rank #0 or checkleap #0 #1 1 1 or checkleap #0 #1 1 0 608 def White_Colonel mergeall rays #0 1 0 leaps #0 1 2 leaps #0 1 1 609 set White_Colonel-Desc "The %s may move forward or sideways as a Rook, forward as a Knight, and one space in any direction as a King." 610 def Black_Colonel checkride #0 #1 1 0 or checkleap #0 #1 1 2 and <= rank #1 rank #0 or checkleap #0 #1 1 1 or checkleap #0 #1 1 0 611 def Black_Colonel mergeall rays #0 1 0 leaps #0 1 2 leaps #0 1 1 612 set Black_Colonel-Desc "The %s may move forward or sideways as a Rook, forward as a Knight, and one space in any direction as a King." 613 def Dabbabah checkleap #0 #1 0 2 614 def Dabbabah-Range leaps #0 0 2 615 set Dabbabah-Desc "The %s may leap two spaces vertically or horizontally." 616 def Dabbabahrider checkride #0 #1 0 2 617 def Dabbabahrider-Range rays #0 0 2 618 set Dabbabahrider-Desc "The %s may make any number of two space orthogonal leaps in the same direction until it reaches an occupied space." 619 def Dragon_Horse checkride #0 #1 1 1 or checkleap #0 #1 1 0 620 def Dragon_Horse-Range merge leaps #0 1 0 rays #0 1 1 621 set Dragon_Horse-Desc "The %s may move along diagonals as a Bishop or move one space orthogonally as a Wazir." 622 def Dragon_King checkride #0 #1 1 0 or checkleap #0 #1 1 1 623 def Dragon_King-Range merge leaps #0 1 1 rays #0 1 0 624 set Dragon_King-Desc "The %s may move along its rank or file as a Rook or one space diagonally as a Ferz." 625 def Elephant checkleap #0 #1 2 2 626 def Elephant-Range leaps #0 2 2 627 set Elephant-Desc "The %s may leap two spaces in any diagonal direction." 628 def Elephantrider checkride #0 #1 2 2 629 def Elephantrider-Range rays #0 2 2 630 set Elephantrider-Desc "The %s may make a series of two-space diagonal leaps in the same direction. Each leap but the last must be to an empty space, though a leap may take it over an intervening piece." 631 def Eques_Rex checkleap #0 #1 1 1 or checkleap #0 #1 1 0 or checkleap #0 #1 1 2 632 def Eques_Rex-Range merge leaps #0 1 2 merge leaps #0 1 0 leaps #0 1 1 633 set Eques_Rex-Desc "The %s may move to any adjacent space as a King or leap like a Knight." 634 def Fad checkleap #0 #1 1 1 or checkleap #0 #1 2 2 or checkleap #0 #1 2 0 635 def Fad-Range mergeall leaps #0 1 1 leaps #0 2 2 leaps #0 2 0 636 set Fad-Desc "The %s may move one space diagonally, or it may leap two spaces diagonally or orthogonally." 637 def Ferz checkleap #0 #1 1 1 638 def Ferz-Range leaps #0 1 1 639 set Ferz-Desc "The %s may move one space diagonally." 640 def Fibnif checkleap #0 #1 1 2 or checkleap #0 #1 1 1 and == 1 abs - file #0 file #1 641 def Fibnif-Range merge leaps #0 1 2 leaps #0 1 1 642 set Fibnif-Desc "The %s may move one space diagonally or leap as a Knight to any space that is one file and two ranks away." 643 def Giraffe checkleap #0 #1 1 4 644 def Giraffe-Range leaps #0 1 4 645 set Giraffe-Desc "The %s may leap to any space that is one file and four ranks or one rank and four files away." 646 def White_Gold_General checkaleap #0 #1 1 1 or checkaleap #0 #1 -1 1 or checkleap #0 #1 0 1 647 def White_Gold_General-Range mergeall leaps #0 1 0 where #0 1 1 where #0 -1 1 648 set White_Gold_General-Desc "The %s may move one space in any orthgonal direction or one space diagonally forward." 649 def Black_Gold_General checkaleap #0 #1 1 -1 or checkaleap #0 #1 -1 -1 or checkleap #0 #1 0 1 650 def Black_Gold_General-Range mergeall leaps #0 1 0 where #0 1 -1 where #0 -1 -1 651 set Black_Gold_General-Desc "The %s may move one space in any orthgonal direction or one space diagonally forward." 652 def Grasshopper checkgrasshop #0 #1 1 1 or checkgrasshop #0 #1 1 0 653 def Grasshopper-Range merge rays #0 1 0 rays #0 1 1 654 set "The %s moves any number of spaces orthogonally or diagonally like a Queen except that it must hop over exactly one piece, and it must end its move immediately after the piece it hopped over." 655 def Griffon fn (checkride #0 #1 1 0 and empty #0) where #0 sign - file #1 file #0 sign - rank #1 rank #0 #1 and != file #1 file #0 and != rank #1 rank #0 or checkleap #0 #1 1 1 656 def Griffon-Range mergeall leaps #0 1 1 rays where #0 1 1 1 0 rays where #0 1 -1 1 0 rays where #0 -1 -1 1 0 rays where #0 -1 1 1 0 657 set Griffon-Desc "The %s may move one space diagonally, and it may continue its move by moving as a Rook in an outward orthogonal direction. It may not pass over other pieces." 658 def King checkleap #0 #1 1 1 or checkleap #0 #1 1 0 659 def King-Range merge leaps #0 1 0 leaps #0 1 1 660 set King-Desc "The %s leaps one space in any direction. It may castle with a Rook on its first move so long as it is not in check, there is nothing in between it and the Rook, it doesn't pass through check while castling, and the Rook hasn't moved. In castling, it moves two spaces toward the Rook, and the Rook moves to the space the %s passed over." 661 sub King from to 662 if not fn King #from #to 663 verify sub castle #from #to and match #to var cond isupper space #to wcastle bcastle 664 endif 665 if isupper space #to 666 set Kpos #to 667 else 668 set kpos #to 669 endif 670 return true 671 endsub 672 def Knight checkleap #0 #1 1 2 673 def Knight-Range leaps #0 1 2 674 set Knight-Desc "The %s may leap to any space that is one rank and two files away or two ranks and one file away." 675 def Korean_Elephant checkpath #0 #1 1 0 1 1 1 1 676 def Korean_Elephant-Range leaps #0 2 3 677 set "The %s may move one space orthogonally, followed by two more spaces in the same outward diagonal direction. It must complete every part of its move, and it may not pass over an occupied space." 678 def White_Lance checkaride #0 #1 0 1 679 def White_Lance-Range ray #0 0 1 680 set "The %s may move forward in its file as a Rook." 681 def Black_Lance checkaride #0 #1 0 -1 682 def Black_Lance-Range ray #0 0 -1 683 set "The %s may move forward in its file as a Rook." 684 def Leo fn Vao #0 #1 or fn Cannon #0 #1 685 def Leo-Range merge rays #0 1 0 rays #0 1 1 686 set Leo-Desc "The %s may move any number of spaces diagonally or orthogonally, as a Queen does, but it must hop over one intervening piece when it captures." 687 def Mao checktwostep #0 #1 0 1 1 1 688 def Mao-Range leaps #0 1 2 689 set Mao-Desc "The %s moves one space orthogonally, followed by one more space in an outward diagonal direction. It must complete both parts of its move, and it may not pass over an occupied space. It can reach the same spaces as a Knight except that it can be blocked on the first step of its two-space move." 690 def Marshall fn Knight #0 #1 or fn Rook #0 #1 691 def Marshall-Range merge rays #0 1 0 leaps #0 1 2 692 set Marshall-Desc "The %s moves orthogonally as a Rook or leaps as a Knight." 693 def Moa checktwostep #0 #1 1 1 0 1 694 def Moa-Range leaps #0 1 2 695 set Moa-Desc "The %s moves one space diagonally, followed by one more space in an outward orthogonal direction. It must complete both parts of its move, and it may not pass over an occupied space. It can reach the same spaces as a Knight except that it can be blocked on the first step of its two-space move." 696 def Murray_Lion checkleap #0 #1 1 0 or checkleap #0 #1 1 1 and cond empty #0 capture (not empty #1) or checkleap #0 #1 2 2 or checkleap #0 #1 0 2 697 def Murray_Lion-Range merge merge leaps #0 2 0 leaps #0 2 2 merge leaps #0 1 0 leaps #0 1 1 698 set Murray_Lion-Desc "The %s may leap two spaces in any diagonal or orthogonal direction, and it may capture (but not otherwise move) one space in any direction." 699 def Nightrider checkride #0 #1 1 2 700 def Nightrider-Range rays #0 1 2 701 set Nightrider-Desc "The %s may leap as a Knight any number of times in the same direction. While each Knight leap may take it over other pieces, each leap but the last must be to an empty space." 702 set White_Pawn-Desc "The %s may move one space straight forward without capturing, or it may move one space diagonally forward to capture. On its first move, it may move two spaces forward without capturing so long as it isn't blocked. If this move takes it over a space an enemy %s could have captured it on if it had moved there, that %s may immediately capture it by en passant by moving to that space. On reaching the last rank, it must promote to any other piece except the King." 703 set Black_Pawn-Desc var White_Pawn-Desc 704 def White_Pawn remove var ep and < rankname #1 var bpr and < rankname var ep rankname #1 and == filename var ep filename #1 and checkleap #0 #1 1 1 and var ep or and checkride #0 #1 0 1 == rankname #0 var wpr or checkleap #0 #1 0 1 and empty #1 and != var movetype CHECK or and not empty #1 checkleap #0 #1 1 1 and any onboard where #1 0 1 == var movetype CHECK count var wprom and <= distance #0 #1 var fps and > rank #1 rank #0 705 def Black_Pawn remove var ep and > rankname #1 var wpr and > rankname var ep rankname #1 and == filename var ep filename #1 and checkleap #0 #1 1 1 and var ep or and checkride #0 #1 0 1 == rankname #0 var bpr or checkleap #0 #1 0 1 and empty #1 and != var movetype CHECK or and not empty #1 checkleap #0 #1 1 1 and any count var bprom onboard where #1 0 -1 == var movetype CHECK and <= distance #0 #1 var fps and < rank #1 rank #0 706 def White_Pawn-Range filter lambda (onboard #1) mergeall where #ori -1 1 where #ori 1 1 values lambda (where #ori 0 #1) range 1 var fps =ori 707 def Black_Pawn-Range filter lambda (onboard #1) mergeall where #ori -1 -1 where #ori 1 -1 values lambda (where #ori 0 neg #1) range 1 var fps =ori 708 def White_Pawn-Promote var wprom 709 def Black_Pawn-Promote var bprom 710 sub White_Pawn from to 711 my newpiece 712 my newmove 713 my prom 714 verify > rank #to rank #from 715 verify <= distance #to #from #fps 716 if capture 717 verify checkleap #from #to 1 1 718 set ep false 719 elseif checkleap #from #to 1 1 and #ep 720 verify == filename var ep filename #to 721 verify < rankname var ep rankname #to 722 verify < rankname #to var bpr 723 capture #ep 724 set ep false 725 elseif > distance #to #from 1 726 verify == rankname #from #wpr 727 verify checkride #from #to 0 1 728 set ep #to 729 else 730 verify checkleap #from #to 0 1 731 set ep false 732 endif 733 set prom fn White_Pawn-Promote #to 734 if onboard where #to 0 #pzs 735 if != space #to $moved 736 set name alias const alias $moved 737 die "You may not promote a" #name "until it reaches the promotion zone." 738 endif 739 elseif onboard where #to 0 1 740 if == White_Pawn const alias space #to and count var prom 741 if not $answered and == mln $maxmln and not strstr thismove chr 59 742 if not match alias space #to var prom 743 push prom space #to 744 endif 745 askpromote #prom 746 endif 747 elseif not match space #to var prom and != White_Pawn const alias space #to 748 set name alias const alias $moved 749 set newname alias const alias space #to 750 set msg list "You may not promote your" #name "to a" join #newname ".
" 751 set msg str_replace "_" " " var msg 752 die #msg 753 endif 754 elseif count var prom 755 if == White_Pawn const alias space #to 756 if == count var prom 1 757 set newpiece alias list var prom 758 set pieceid realname #newpiece 759 set newmove join #newpiece "-dest" 760 add #pieceid $dest 761 appendmove #newmove 762 else 763 askpromote #prom 764 endif 765 elseif not match alias space #to var prom 766 set name alias const alias $moved 767 set newname alias const alias space #to 768 set msg list "You may not promote your" #name "to a" join #newname ".
" 769 set msg str_replace "_" " " var msg 770 die #msg 771 endif 772 else 773 set name alias const alias $moved 774 set msg list "You may not advance your" #name "to the last rank, because there is nothing you may promote it to." 775 set msg str_replace "_" " " var msg 776 die #msg 777 endif 778 set nopvc 0 779 return true 780 endsub 781 sub Black_Pawn from to 782 my newpiece, pieceid 783 my newmove 784 my prom 785 verify < rank #to rank #from 786 verify <= distance #to #from #fps 787 if capture 788 verify checkleap #from #to 1 1 789 set ep false 790 elseif checkleap #from #to 1 1 and #ep 791 verify == filename var ep filename #to 792 verify > rankname var ep rankname #to 793 verify > rankname #to var wpr 794 capture #ep 795 set ep false 796 elseif > distance #to #from 1 797 verify == rankname #from #bpr 798 verify checkride #from #to 0 1 799 set ep #to 800 else 801 verify checkleap #from #to 0 1 802 set ep false 803 endif 804 set prom fn Black_Pawn-Promote #to 805 if onboard where #to 0 neg #pzs 806 if != space #to $moved 807 set name alias const alias $moved 808 die "You may not promote a" #name "until it reaches the promotion zone." 809 endif 810 elseif onboard where #to 0 -1 811 if == Black_Pawn const alias space #to and count var prom 812 if not $answered and == mln $maxmln and not strstr thismove chr 59 813 push prom space #to 814 askpromote #prom 815 endif 816 elseif not match space #to var prom and != Black_Pawn const alias space #to 817 set name alias const alias $moved 818 set newname alias const alias space #to 819 set msg list "You may not promote your" #name "to a" join #newname ".
" 820 set msg str_replace "_" " " var msg 821 die #msg 822 endif 823 elseif count var prom 824 if == Black_Pawn const alias space #to 825 if == count var prom 1 826 set newpiece alias list var prom 827 set newmove join #newpiece "-dest" 828 set pieceid realname var newpiece 829 add #pieceid $dest 830 appendmove #newmove 831 else 832 askpromote #prom 833 endif 834 elseif not match alias space #to var prom 835 set name alias const alias $moved 836 set newname alias const alias space #to 837 set msg list "You may not promote your" #name "to a" join #newname ".
" 838 set msg str_replace "_" " " var msg 839 die #msg 840 endif 841 else 842 set name alias const alias $moved 843 set msg list "You may not advance your" #name "to the last rank, because there is nothing you may promote it to." 844 set msg str_replace "_" " " var msg 845 die #msg 846 endif 847 set nopvc 0 848 return true 849 endsub 850 set White_Quick_Pawn-Desc "The %s may move one or two spaces straight forward without capturing, or it may move one space diagonally forward to capture. If its two-space move takes it over a space an enemy %s could have captured it on if it had moved there, that %s may immediately capture it by en passant by moving to that space. On reaching the last rank, it must promote to any other piece except the King." 851 set Black_Quick_Pawn-Desc var White_Quick_Pawn-Desc 852 def White_Quick_Pawn remove var ep and < rankname #1 rankname var epf and < rankname var ep rankname #1 and == filename var ep filename #1 and checkleap #0 #1 1 1 and var ep or checkride #0 #1 0 1 and empty #1 and != var movetype CHECK or and or not empty #1 == var movetype CHECK checkleap #0 #1 1 1 and any onboard where #1 0 1 == var movetype CHECK count var wprom and <= distance #0 #1 var fps and > rank #1 rank #0 853 def Black_Quick_Pawn remove var ep and > rankname #1 rankname var epf and > rankname var ep rankname #1 and == filename var ep filename #1 and checkleap #0 #1 1 1 and var ep or checkride #0 #1 0 1 and empty #1 and != var movetype CHECK or and or not empty #1 == var movetype CHECK checkleap #0 #1 1 1 and any count var bprom onboard where #1 0 -1 == var movetype CHECK and <= distance #0 #1 var fps and < rank #1 rank #0 854 def White_Quick_Pawn-Range filter lambda (onboard #1) mergeall where #ori -1 1 where #ori 1 1 values lambda (where #ori 0 #1) range 1 var fps =ori 855 def Black_Quick_Pawn-Range filter lambda (onboard #1) mergeall where #ori -1 -1 where #ori 1 -1 values lambda (where #ori 0 neg #1) range 1 var fps =ori 856 def White_Quick_Pawn-Promote var wprom 857 def Black_Quick_Pawn-Promote var bprom 858 sub White_Quick_Pawn from to 859 my newpiece 860 my newmove 861 my prom 862 verify > rank #to rank #from 863 verify <= distance #to #from #fps 864 if capture 865 verify checkleap #from #to 1 1 866 set epf false 867 set ep false 868 elseif checkleap #from #to 1 1 and #ep 869 verify == filename var ep filename #to 870 verify < rankname var ep rankname #to 871 verify < rankname #to rankname var epf 872 capture #ep 873 set epf false 874 set ep false 875 elseif > distance #to #from 1 876 verify checkride #from #to 0 1 877 set epf #from 878 set ep #to 879 else 880 verify checkleap #from #to 0 1 881 set epf false 882 set ep false 883 endif 884 set prom fn White_Quick_Pawn-Promote #to 885 if onboard where #to 0 #pzs 886 if != space #to $moved 887 set name alias const alias $moved 888 die "You may not promote a" #name "from" $moved "to" {space #to} "until it reaches the promotion zone." 889 endif 890 elseif onboard where #to 0 1 891 if == White_Quick_Pawn const alias space #to and count var prom 892 if not $answered and == mln $maxmln and not strstr thismove chr 59 893 if not match alias space #to var prom 894 push prom space #to 895 endif 896 askpromote #prom 897 endif 898 elseif not match space #to var prom and != White_Quick_Pawn const alias space #to 899 set name alias const alias $moved 900 set newname alias const alias space #to 901 set msg list "You may not promote your" #name "to a" join #newname ".
" 902 set msg str_replace "_" " " var msg 903 die #msg 904 endif 905 elseif count var prom 906 if == White_Quick_Pawn const alias space #to 907 if == count var prom 1 908 set newpiece alias list var prom 909 set pieceid realname #newpiece 910 set newmove join #newpiece "-dest" 911 add #pieceid $dest 912 appendmove #newmove 913 else 914 askpromote #prom 915 endif 916 elseif not match alias space #to var prom 917 set name alias const alias $moved 918 set newname alias const alias space #to 919 set msg list "You may not promote your" #name "to a" join #newname ".
" 920 set msg str_replace "_" " " var msg 921 die #msg 922 endif 923 else 924 set name alias const alias $moved 925 set msg list "You may not advance your" #name "to the last rank, because there is nothing you may promote it to." 926 set msg str_replace "_" " " var msg 927 die #msg 928 endif 929 set nopvc 0 930 return true 931 endsub 932 sub Black_Quick_Pawn from to 933 my newpiece, pieceid 934 my newmove 935 my prom 936 verify < rank #to rank #from 937 verify <= distance #to #from #fps 938 if capture 939 verify checkleap #from #to 1 1 940 set ep false 941 set epf false 942 elseif checkleap #from #to 1 1 and #ep 943 verify == filename var ep filename #to 944 verify > rankname var ep rankname #to 945 verify > rankname #to rankname var epf 946 capture #ep 947 set ep false 948 set epf false 949 elseif > distance #to #from 1 950 verify checkride #from #to 0 1 951 set ep #to 952 set epf #from 953 else 954 verify checkleap #from #to 0 1 955 set ep false 956 set epf false 957 endif 958 set prom fn Black_Quick_Pawn-Promote #to 959 if onboard where #to 0 neg #pzs 960 if != space #to $moved 961 set name alias const alias $moved 962 die "You may not promote a" #name "until it reaches the promotion zone." 963 endif 964 elseif onboard where #to 0 -1 965 if == Black_Quick_Pawn const alias space #to and count var prom 966 if not $answered and == mln $maxmln and not strstr thismove chr 59 967 push prom space #to 968 askpromote #prom 969 endif 970 elseif not match space #to var prom and != Black_Quick_Pawn const alias space #to 971 set name alias const alias $moved 972 set newname alias const alias space #to 973 set msg list "You may not promote your" #name "to a" join #newname ".
" 974 set msg str_replace "_" " " var msg 975 die #msg 976 endif 977 elseif count var prom 978 if == Black_Quick_Pawn const alias space #to 979 if == count var prom 1 980 set newpiece alias list var prom 981 set newmove join #newpiece "-dest" 982 set pieceid realname var newpiece 983 add #pieceid $dest 984 appendmove #newmove 985 else 986 askpromote #prom 987 endif 988 elseif not match alias space #to var prom 989 set name alias const alias $moved 990 set newname alias const alias space #to 991 set msg list "You may not promote your" #name "to a" join #newname ".
" 992 set msg str_replace "_" " " var msg 993 die #msg 994 endif 995 else 996 set name alias const alias $moved 997 set msg list "You may not advance your" #name "to the last rank, because there is nothing you may promote it to." 998 set msg str_replace "_" " " var msg 999 die #msg 1000 endif 1001 set nopvc 0 1002 return true 1003 endsub 1004 def Queen fn Bishop #0 #1 or fn Rook #0 #1 1005 def Queen-Range merge rays #0 1 0 rays #0 1 1 1006 set Queen-Desc "The %s may move as a Rook or a Bishop." 1007 def Rhino windingride #0 #1 1 0 1 1 or windingride #0 #1 0 1 1 1 1008 def Rhino-Range merge eval (windingrays #0 1 0 1 1) windingrays #0 0 1 1 1 1009 set Rhino-Desc "The %s moves along a winding path that alternates between the same one-space orthogonal move and the same one-space diagonal move both in the same general direction." 1010 def Rook checkride #0 #1 1 0 1011 def Rook-Range rays #0 1 0 1012 set Rook-Desc "The %s may move any number of spaces in any vertical or horizontal direction until it reaches an occupied space." 1013 def Short_Rook checkride #0 #1 1 0 and <= distance #0 #1 4 1014 def Short_Rook-Range merge merge leaps #0 1 0 leaps #0 2 0 merge leaps #0 3 0 leaps #0 4 0 1015 set "The %s may move up to four spaces along its rank or file as a Rook." 1016 def White_Shogi_Knight checkaleap #0 #1 1 2 or checkaleap #0 #1 -1 2 1017 def White_Shogi_Knight-Range array where #0 1 2 where #0 -1 2 1018 set White_Shogi_Knight-Desc "The %s may leap to either space that is two ranks ahead and one file to the side." 1019 def Black_Shogi_Knight checkaleap #0 #1 1 -2 or checkaleap #0 #1 -1 -2 1020 def Black_Shogi_Knight-Range array where #0 1 -2 where #0 -1 -2 1021 set Black_Shogi_Knight-Desc "The %s may leap to either space that is two ranks ahead and one file to the side." 1022 def White_Shogi_Pawn checkaleap #0 #1 0 1 1023 def White_Shogi_Pawn-Range array where #0 0 1 1024 set White_Shogi_Pawn-Desc "The %s map move one space forward in the same file." 1025 def Black_Shogi_Pawn checkaleap #0 #1 0 -1 1026 def Black_Shogi_Pawn-Range array where #0 0 -1 1027 set Black_Shogi_Pawn-Desc "The %s map move one space forward in the same file." 1028 def White_Silver_General checkaleap #0 #1 0 1 or checkleap #0 #1 1 1 1029 def White_Silver_General-Range mergeall leaps #0 1 1 where #0 0 1 1030 set White_Silver_General-Desc "The %s may move one space in any diagonal direction or one space vertically foward." 1031 def Black_Silver_General checkaleap #0 #1 0 -1 or checkleap #0 #1 1 1 1032 def Black_Silver_General-Range mergeall leaps #0 1 1 where #0 0 -1 1033 set Black_Silver_General-Desc "The %s may move one space in any diagonal direction or one space vertically foward." 1034 def Squirrel fn Elephant #0 #1 or fn Dabbabah #0 #1 or fn Knight #0 #1 1035 def Squirrel-Range mergeall leaps #0 2 2 leaps #0 2 0 leaps #0 1 2 1036 set Squirrel-Desc "The %s may leap any non-adjacent space that is no more than two spaces away." 1037 def Spider fn Dabbabah #0 #1 or fn Elephant #0 #1 1038 def Spider-Range merge leaps #0 2 2 leaps #0 0 2 1039 set Spider-Desc "The %s may leap to any space that is two spaces away orthogonally or diagonally." 1040 def Spider-rider fn Dabbabahrider #0 #1 or fn Elephantrider #0 #1 1041 def Spider-rider-Range merge rays #0 2 2 rays #0 0 2 1042 set Spider-rider-Desc "The %s may make any number of two-space leaps in a single orthogonal or diagonal direction. While each leap may take it over an occupied space, each leap but the last must be to an empty space." 1043 def Squire checktwostep #0 #1 0 1 1 1 or checktwostep #0 #1 1 1 0 1 1044 def Squire-Range leaps #0 1 2 1045 set Squire-Desc "The %s may move one space orthogonally, followed by one more space in an outward diagonal direction, or it may move one space diagonally, followed by one more space in an outward orthogonal direction. It must complete both parts of its move, and it may not pass over an occupied space. It can reach the same spaces as a Knight except that it can be blocked on the first step of its two-space move." 1046 def Unicorn fn Nightrider #0 #1 or fn Bishop #0 #1 1047 def Unicorn-Range merge rays #0 1 2 rays #0 1 1 1048 set Unicorn-Desc "The %s may make consecutive Knight moves in the same direction, as a Nightrider does, or it may move diagonally as a Bishop." 1049 def Vao cond cond empty #0 capture (not empty #1) (checkhop #0 #1 1 1) (checkride #0 #1 1 1) and #1 1050 def Vao-Range rays #0 1 1 1051 set Vao-Desc "The %s may move diagonally as a Bishop, but it must hop over exactly one intervening piece when it captures." 1052 def Wazir checkleap #0 #1 1 0 1053 def Wazir-Range leaps #0 1 0 1054 set Wazir-Desc "The %s may move one space horizontally or vertically." 1055 def Wizard fn Ferz #0 #1 or fn Camel #0 #1 1056 def Wizard-Range merge leaps #0 1 1 leaps #0 1 3 1057 set Wizard-Desc "The %s may move one space diagonally, or it may leap to a space three ranks and one file or three files and one rank away, as a Camel does." 1058 def Woody_Rook checkleap #0 #1 0 2 or checkleap #0 #1 0 1 1059 def Woody_Rook-Range merge leaps #0 0 1 leaps #0 0 2 1060 set Woody_Rook-Desc "The %s may leap one or two spaces orthogonally. It may pass over another piece when moving two spaces." 1061 def Zebra checkleap #0 #1 2 3 1062 def Zebra-Range leaps #0 2 3 1063 set Zebra-Desc "The %s may leap to any space that is 2 ranks and 3 files or 2 files and 3 ranks away." 1064 def Elephant_Ferz fn Ferz #0 #1 or fn Elephant #0 #1 1065 def Elephant_Ferz-Range merge leaps #0 2 2 leaps #0 1 1 1066 set Elephant_Ferz-Desc "The %s may leap one or two spaces diagonally. It may pass over another piece when moving two spaces." 1067 def Elephant_Wazir fn Wazir #0 #1 or fn Elephant #0 #1 1068 def Elephant_Wazir-Range merge leaps #0 2 2 leaps #0 1 0 1069 set Elephant_Wazir-Desc "The %s may move one space orthogonally, as a Wazir, or leap two spaces diagonally, as an Elephant." 1070 def Kylin fn Ferz #0 #1 or fn Dabbabah #0 #1 1071 def Kylin-Range mergeall leaps #0 1 1 leaps #0 2 0 1072 set Kylin-Desc "The %s may move one space diagonally, or it may leap 2 spaces orthogonally, passing over any pieces in the way." 1073 def Half_Duck fn Ferz #0 #1 or fn Dabbabah #0 #1 or checkleap #0 #1 3 0 1074 def Half_Duck-Range mergeall leaps #0 1 1 leaps #0 2 0 leaps #0 3 0 1075 set Half_Duck-Desc "The %s may move one space diagonally, or it may leap 2 or 3 spaces orthogonally, passing over any pieces in the way." 1076 def Knight_Wazir fn Knight #0 #1 or fn Wazir #0 #1 1077 def Knight_Wazir-Range merge leaps #0 1 2 leaps #0 1 0 1078 set Knight_Wazir-Desc "The %s may move one space orthogonally, as a Wazir, or it may leap as a Knight to any space one file and two ranks or two files and one rank away." 1079 def Frog fn Ferz #0 #1 or checkleap #0 #1 3 0 1080 def Frog-Range merge leaps #0 1 1 leaps #0 3 0 1081 set Frog-Desc "The %s may move one space diagonally or directly leap 3 spaces orthogonally." 1082 def Buffalo fn Knight #0 #1 or fn Camel #0 #1 or fn Zebra #0 #1 1083 def Buffalo-Range mergeall leaps #0 1 2 leaps #0 1 3 leaps #0 2 3 1084 set Buffalo-Desc "The %s Buffalo may leap (1, 2) as a Knight, (1, 3) as a Camel, or (2, 3) as a Zebra." 1085 def @ false 1086 sub attacked start finish 1087 my from piece actual 1088 local movetype 1089 set movetype MOVE 1090 if empty #start 1091 set actual true 1092 move #finish #start 1093 add $old #finish 1094 endif 1095 if isupper space #start 1096 def enemies onlylower 1097 else 1098 def enemies onlyupper 1099 endif 1100 for (from piece) fn enemies 1101 if fn const alias #piece #from #to 1102 if #actual 1103 move #start #finish 1104 endif 1105 return #from 1106 endif 1107 next 1108 if #actual 1109 move #start #finish 1110 endif 1111 return false 1112 endsub 1113 sub fission-attacked start finish 1114 my from piece p1 p2 1115 local movetype 1116 set p1 space #start 1117 set p2 space #finish 1118 set movetype CHECK 1119 if isupper #p1 1120 def enemies onlylower 1121 else 1122 def enemies onlyupper 1123 endif 1124 empty #finish 1125 for (from piece) fn enemies 1126 if fn const alias #piece #from #start 1127 add #p2 #finish 1128 return #from 1129 endif 1130 next 1131 add #p2 #finish 1132 return false 1133 endsub 1134 sub checked king 1135 my from piece 1136 local movetype 1137 set movetype CHECK 1138 if isupper cond empty var king $moved space var king 1139 def enemies onlylower 1140 else 1141 def enemies onlyupper 1142 endif 1143 for (from piece) fn enemies 1144 if fn const alias #piece #from var king and isfunc const alias #piece 1145 return #from 1146 endif 1147 next 1148 return false 1149 endsub 1150 def checked anytrue lambda (fn const alias #0 var key var king) cond isupper space var king (onlylower) (onlyupper) =movetype CHECK =king 1151 def threatened anytrue lambda (fn const alias space #0 #0 var king) elem var king threats =movetype CHECK =king 1152 sub uncheckedpath start finish 1153 my from to piece kingpos 1154 local movetype 1155 set movetype CHECK 1156 if empty #finish 1157 set kingpos #start 1158 else 1159 set kingpos #finish 1160 endif 1161 if isupper space #kingpos 1162 def enemies onlylower 1163 else 1164 def enemies onlyupper 1165 endif 1166 for to path #start #finish 1167 move #kingpos #to 1168 for (from piece) fn enemies 1169 if fn const alias #piece #from #to 1170 move #to #kingpos 1171 return false 1172 endif 1173 next 1174 move #to #kingpos 1175 next 1176 return true 1177 endif 1178 sub uncheckedknightleap start finish 1179 my from to piece kingpos kingpiece checkedpaths 1180 local movetype 1181 set movetype CHECK 1182 if empty #start 1183 set kingpos #finish 1184 else 1185 set kingpos #start 1186 endif 1187 if isupper space #kingpos 1188 def enemies onlylower 1189 else 1190 def enemies onlyupper 1191 endif 1192 set kingpiece space #kingpos 1193 set avenues merge intersection leaps #start 1 0 leaps #finish 1 1 intersection leaps #start 1 1 leaps #finish 1 0 1194 set checkdpaths 0 1195 for to #avenues 1196 if empty #to 1197 move #kingpos #to 1198 else 1199 empty #kingpos 1200 endif 1201 for (from piece) fn enemies 1202 if fn const alias #piece #from #to 1203 inc checkedpaths 1204 break 1205 endif 1206 next 1207 if == space #to #kingpiece 1208 move #to #kingpos 1209 else 1210 add #kingpiece #kingpos 1211 endif 1212 if == checkedpaths 0 1213 break 1214 endif 1215 next 1216 return < var checkedpaths 2 1217 endif 1218 sub castle from to 1219 local coord RPOS RDEST xdir 1220 if not flag #from 1221 die A King may not castle after it moves. 1222 endif 1223 if capture 1224 die A King may not castle to an occupied space. 1225 endif 1226 set xdir sign minus file #to file #from 1227 if not checkaride #from #to #xdir 0 1228 die A King may not castle across any occupied space. 1229 endif 1230 set coord #to 1231 do 1232 set coord where #coord #xdir 0 1233 if flag #coord 1234 break 1235 elseif not onboard #coord 1236 die No piece was found to castle with. 1237 elseif not empty #coord 1238 die The King cannot castle with the piece at #coord 1239 endif 1240 loop 1241 set RPOS #coord 1242 move #to #from 1243 if sub checked #from 1244 die A King may not castle out of check. 1245 endif 1246 store 1247 for coord path #from #to 1248 move #from #coord 1249 if sub checked #coord 1250 die A King may not castle through check. 1251 endif 1252 restore 1253 next 1254 move #from #to 1255 set RDEST where #to neg #xdir 0 1256 move #RPOS #RDEST 1257 return true 1258 endsub 1259 sub castlepos from to 1260 local coord RPOS RDEST xdir safe 1261 verify flag #from 1262 verify empty #to 1263 set xdir sign minus file #to file #from 1264 verify checkaride #from #to #xdir 0 1265 verify not sub checked #from 1266 set coord #to 1267 do 1268 set coord where #coord #xdir 0 1269 if flag #coord 1270 break 1271 endif 1272 verify onboard #coord 1273 verify empty #coord 1274 loop 1275 verify flag #coord 1276 set RPOS #coord 1277 store 1278 for coord path #from #to 1279 move #from #coord 1280 set safe not sub checked #coord 1281 restore 1282 verify #safe 1283 next 1284 move #from #to 1285 set RDEST where #to neg #xdir 0 1286 move #RPOS #RDEST 1287 set safe not sub checked #to 1288 restore 1289 return #safe 1290 endsub 1291 sub castle2 kingfrom kingto rookfrom rookto 1292 local coord xdir king rook 1293 if not flag #kingfrom 1294 die A King may not castle after it moves. 1295 endif 1296 if not flag #rookfrom 1297 die A King may not castle with a piece that has already moved. 1298 endif 1299 if not match @ $lastcaptured $prevcaptured 1300 die Castling to an occupied space is not allowed. 1301 endif 1302 if empty #kingto 1303 die There is nothing on #kingto. Did you move a piece there and then move it away? 1304 endif 1305 if empty #rookto 1306 die There is nothing on #rookto. Did you move a piece there and then move it away? 1307 endif 1308 set king space #kingto 1309 set rook space #rookto 1310 if == #king #rook 1311 die "Castling must be between different pieces. These two are both {#king}. What happened?" 1312 endif 1313 empty #kingto 1314 empty #rookto 1315 add #king #kingfrom 1316 add #rook #rookfrom 1317 set xdir sign minus file #kingto file #kingfrom 1318 if not checkaride #kingfrom #kingto #xdir 0 1319 die A King may not castle across any occupied space. 1320 endif 1321 if not checkaride #rookto #rookfrom #xdir 0 1322 die A Rook may not castle across an occupied space. 1323 endif 1324 if sub checked #kingfrom 1325 die A King may not castle out of check. 1326 endif 1327 store 1328 for coord path #kingfrom #kingto 1329 move #kingfrom #coord 1330 if sub checked #coord 1331 die A King may not castle through check. 1332 endif 1333 restore 1334 next 1335 empty #kingfrom 1336 empty #rookfrom 1337 add #king #kingto 1338 add #rook #rookto 1339 unsetflag #kingfrom #rookfrom 1340 if isupper space #kingto 1341 set Kpos #kingto 1342 else 1343 set kpos #kingto 1344 endif 1345 return true 1346 endsub 1347 sub castlepos2 kingfrom kingto rookfrom rookto 1348 echo "Calling castlepos2" #kingfrom #kingto #rookfrom #rookto 1349 local coord xdir safe 1350 verify flag #kingfrom and flag #rookfrom 1351 echo "Verified flags" 1352 verify empty #kingto or == #kingto #rookfrom 1353 verify empty #rookto or == #rookto #kingfrom 1354 echo "Verified empty destinations" 1355 set xdir sign minus file #kingto file #kingfrom 1356 echo "xdir is {#xdir}" 1357 verify checkride #kingfrom #kingto #xdir 0 1358 echo "Verified checkride {#kingfrom} {#kingto} {#xdir} 0" 1359 verify checkride #rookto #rookfrom #xdir 0 1360 echo "Verified checkride {#kingto} {#kingfrom} {#xdir} 0" 1361 verify not sub checked #kingfrom 1362 echo "Verified not checked" 1363 store 1364 for coord path #kingfrom #kingto 1365 move #kingfrom #coord 1366 set safe not sub checked #coord 1367 restore 1368 verify #safe 1369 next 1370 move #kingfrom #kingto 1371 move #rookfrom #rookto 1372 set safe not sub checked #kingto 1373 restore 1374 return #safe 1375 endsub 1376 sub stalemated kingpos 1377 store 1378 local cspaces friend friends from king piece to movetype np prom promfn 1379 set movetype MOVE 1380 set king alias space #kingpos 1381 if hasupper #king 1382 set friends lambda (onlyupper) 1383 set free lambda (haslower #0 or not hasupper #0) 1384 set pzone lambda (not onboard where #0 0 var pzs) 1385 set cspaces var wcastle 1386 set prom var wprom 1387 else 1388 set friends lambda (onlylower) 1389 set free lambda (hasupper #0 or not haslower #0) 1390 set pzone lambda (not onboard where #0 0 neg var pzs) 1391 set cspaces var bcastle 1392 set prom var bprom 1393 endif 1394 store 1395 for (from piece) fn #friends 1396 set af alias #from 1397 for to fn join const alias #piece "-Range" #from 1398 set at alias #to 1399 if fn const alias #piece #from #to and fn #free alias space #to and onboard #to 1400 set ap alias #piece 1401 move #from #to 1402 if not sub checked cond == #from #kingpos #to #kingpos 1403 set promfn join const alias #piece "-Promote" 1404 if fn #pzone #to and match #piece #promotable 1405 if > count var prom 0 1406 for np var prom 1407 setlegal "{#ap} {#af}-{#at}; {#np}-{#at}" 1408 next 1409 endif 1410 elseif fn #pzone #to and isfunc var promfn 1411 set prom fn var promfn #to 1412 if > count var prom 0 1413 for np var prom 1414 setlegal "{#ap} {#af}-{#at}; {#np}-{#at}" 1415 next 1416 endif 1417 elseif fn #pzone #to and match #piece #promotable 1418 if > count var prom 0 1419 for np var prom 1420 setlegal "{#ap} {#af}-{#at}; {#np}-{#at}" 1421 next 1422 endif 1423 else 1424 setlegal "{#ap} {#af}-{#at}" 1425 endif 1426 endif 1427 endif 1428 restore 1429 next 1430 next 1431 if > count var cspaces 0 1432 for to var cspaces 1433 if sub castlepos #kingpos #to 1434 setlegal "{#king} {#kingpos}-{#to}" 1435 endif 1436 next 1437 endif 1438 setsystem autorules sub describe_rules 1439 return cond count system legalmoves false true 1440 endsub 1441 sub stalemated-quick kingpos 1442 store 1443 local checked checkpos cspaces enemies friend friends from in king piece threats to movetype np prom promfn 1444 set movetype MOVE 1445 set king alias space #kingpos 1446 if hasupper #king 1447 set friends lambda (onlyupper) 1448 set enemies lambda (onlylower) 1449 set free lambda (haslower #0 or not hasupper #0) 1450 set pzone lambda (not onboard where #0 0 var pzs) 1451 set cspaces var wcastle 1452 set prom var wprom 1453 else 1454 set friends lambda (onlylower) 1455 set enemies lambda (onlyupper) 1456 set free lambda (hasupper #0 or not haslower #0) 1457 set pzone lambda (not onboard where #0 0 neg var pzs) 1458 set cspaces var bcastle 1459 set prom var bprom 1460 endif 1461 set krange merge fn join const alias space #kingpos "-Range" #kingpos #kingpos 1462 set threats () 1463 for to #krange 1464 set threats.{#to} () 1465 next 1466 for (from piece) fn #enemies 1467 set in intersection var krange fn join const alias var piece "-Range" var from 1468 for to #in 1469 push threats.{#to} #from 1470 next 1471 next 1472 store 1473 for (from piece) fn #friends 1474 set af alias #from 1475 for to fn join const alias #piece "-Range" #from 1476 set at alias #to 1477 if fn const alias #piece #from #to and fn #free alias space #to and onboard #to 1478 set ap alias #piece 1479 set checkpos cond == #from #kingpos #to #kingpos 1480 set checked false 1481 if count elem var checkpos threats 1482 move #from #to 1483 set checked fn threatened #checkpos 1484 restore 1485 endif 1486 if not #checked 1487 set promfn join const alias #piece "-Promote" 1488 if fn #pzone #to and match #piece #promotable 1489 if > count var prom 0 1490 for np var prom 1491 setlegal "{#ap} {#af}-{#at}; {#np}-{#at}" 1492 next 1493 endif 1494 elseif fn #pzone #to and isfunc var promfn 1495 set prom fn var promfn #to 1496 if > count var prom 0 1497 for np var prom 1498 setlegal "{#ap} {#af}-{#at}; {#np}-{#at}" 1499 next 1500 endif 1501 elseif fn #pzone #to and match #piece #promotable 1502 if > count var prom 0 1503 for np var prom 1504 setlegal "{#ap} {#af}-{#at}; {#np}-{#at}" 1505 next 1506 endif 1507 else 1508 setlegal "{#ap} {#af}-{#at}" 1509 endif 1510 endif 1511 endif 1512 restore 1513 next 1514 next 1515 if > count var cspaces 0 1516 for to var cspaces 1517 if sub castlepos #kingpos #to 1518 setlegal "{#king} {#kingpos}-{#to}" 1519 endif 1520 next 1521 endif 1522 setsystem autorules sub describe_rules 1523 return cond count system legalmoves false true 1524 endsub 1525 sub stalemated2 kingpos 1526 store 1527 local cspaces friend friends from piece to movetype 1528 set movetype MOVE 1529 if isupper space #kingpos 1530 set friends (onlyupper) 1531 set friend (isupper #0) 1532 set cspaces var wcastle 1533 else 1534 set friends (onlylower) 1535 set friend (islower #0) 1536 set cspaces var bcastle 1537 endif 1538 set royal space var kingpos 1539 store 1540 for (from piece) fn #friends 1541 for to fn join const alias #piece "-Range" #from 1542 if fn const alias #piece #from #to and not fn #friend space #to and onboard #to 1543 move #from #to 1544 if not sub checked cond == #from #kingpos #to #kingpos 1545 set ap alias #piece 1546 setlegal "{#ap} {#from}-{#to}" 1547 endif 1548 endif 1549 restore 1550 next 1551 next 1552 if > count var cspaces 0 and flag #kingpos 1553 for mvs var cspaces 1554 if sub castlepos2 #mvs.0 #mvs.1 #mvs.2 #mvs.3 and == #kingpos #mvs.0 1555 set pk alias space #mvs.0 1556 set pr alias space #mvs.2 1557 setlegal "{#pk} {#mvs.0}-{#mvs.1}; {#pr} {#mvs.2}-{#mvs.3}" 1558 endif 1559 next 1560 endif 1561 setsystem autorules sub describe_rules 1562 return cond count system legalmoves false true 1563 endsub 1564 sub fusion-stalemated kingpos 1565 store 1566 local cspaces friend friends from piece to movetype mv ss 1567 set movetype MOVE 1568 set ss join chr 47 chr 47 1569 if isupper space #kingpos 1570 set friends (onlyupper) 1571 set friend (isupper #0) 1572 set cspaces var wcastle 1573 else 1574 set friends (onlylower) 1575 set friend (islower #0) 1576 set cspaces var bcastle 1577 endif 1578 set royal space var kingpos 1579 store 1580 set kp #kingpos 1581 for (from piece) fn #friends 1582 set ap alias #piece 1583 for to fn join const #ap "-Range" #from 1584 if != space #to #piece and match toupper alias space #to K R B N and match toupper alias #piece R B N or not fn #friend space #to and fn const alias #piece #from #to and onboard #to 1585 move #from #to 1586 if match #ap K KR KB KN k kr kb kn 1587 set kp #to 1588 endif 1589 if not sub checked #kp 1590 setlegal "{#ap} {#from}-{#to}" 1591 endif 1592 restore 1593 set kp #kingpos 1594 endif 1595 if not sub checked #from and empty #to and == strlen alias #piece 2 1596 set compound alias #piece 1597 set simple1 leftstr #compound 1 1598 set simple2 rightstr #compound 1 1599 if != not fn #friend space #to and fn const alias #simple1 #from #to 1600 add #simple1 #to 1601 add #simple2 #from 1602 if match #simple1 K k 1603 set kp #to 1604 endif 1605 if not sub checked #kp 1606 setlegal "{#simple1} {#from}-{#to}; {#ss} {#simple2}-{#from}" 1607 endif 1608 restore 1609 set kp #kingpos 1610 endif 1611 if != not fn #friend space #to and fn const alias #simple2 #from #to 1612 add #simple2 #to 1613 add #simple1 #from 1614 if match #simple1 K k 1615 set kp #from 1616 endif 1617 if not sub checked #kp 1618 setlegal "{#simple2} {#from}-{#to}; {#ss} {#simple1}-{#from}" 1619 endif 1620 restore 1621 set kp #kingpos 1622 endif 1623 endif 1624 next 1625 next 1626 if > count var cspaces 0 1627 for to var cspaces 1628 if sub castlepos #kingpos #to 1629 setlegal (#kingpos #to) 1630 endif 1631 next 1632 endif 1633 setsystem autorules sub describe_rules 1634 return cond count system legalmoves false true 1635 endsub 1636 sub describe_rules 1637 my c piecenames notation values val id ref rules desc name codename rangefn 1638 set c.0 join filename 0 rankname 0 1639 set c.1 join filename >> lastfile 1 rankname 1 1640 set c.2 join filename inc >> lastfile 1 rankname 1 1641 set c.3 join filename >> lastfile 1 rankname inc >> lastrank 1 1642 set c.4 join filename inc >> lastfile 1 rankname >> lastrank 1 1643 set c.5 join filename >> lastfile 1 rankname dec lastrank 1644 set c.6 join filename inc >> lastfile 1 rankname dec lastrank 1645 set c.7 join filename lastfile rankname lastrank 1646 foreach p keys $pieces 1647 if isconst alias #p 1648 set codename const alias #p 1649 set name alias #codename 1650 set notation.{#name} alias #p 1651 if match #codename const alias space #kpos const alias space #Kpos 1652 set values.{#name} * 8 count spaces 1653 else 1654 set rangefn join #codename "-Range" 1655 set values.{#name} sum lambda (count fn #rangefn #0) #c 1656 endif 1657 endif 1658 next 1659 set values reverse asort #values 1660 set rules "

" 1661 foreach (name val) #values 1662 set codename realname #name 1663 if == null var #codename 1664 set codename #name 1665 endif 1666 set ref join #codename "-Desc" 1667 set desc str_replace "%s" #name var #ref 1668 set desc str_replace "_" " " #desc 1669 set id realname #notation.{#name} 1670 set rules join #rules "

[pc {#id} {#name}]{#desc}[/pc]

" 1671 next 1672 set rules join #rules "

" 1673 return #rules 1674 endsub 1675 sub findmates side 1676 local enemyking king mates moves mv 1677 if match #side 1 white White first 1678 set king #Kpos 1679 set enemyking #kpos 1680 else 1681 set king #kpos 1682 set enemyking #Kpos 1683 endif 1684 set mates () 1685 ban none 1686 setsystem maxmove 0 1687 store main 1688 setsystem legalmoves () 1689 if not sub stalemated #king 1690 set lglmvs $legalmoves 1691 foreach move #lglmvs 1692 set moves explode chr 59 #move 1693 foreach mv #moves 1694 set mv trim #mv 1695 eval "MOVE: {#mv}" 1696 next 1697 if sub checked #enemyking 1698 setsystem legalmoves () 1699 if sub stalemated #enemyking 1700 push mates #move 1701 endif 1702 endif 1703 restore main 1704 next 1705 endif 1706 setsystem legalmoves #mates 1707 endsub 1708 endlib