This Shogi preset now spots check, checkmate, and stalemate. Let me know if it makes any mistakes.
45
BANNED INPUT: resigns on turn 23:
There is a global ban on commands in user input, and no exception has been made for the resigns command on the part of the turn indexed 1.
Go back and try again.
What is otherwise valid user input in Game Courier can be banned in a GAME Code program for the sake of better enforcing the rules. See "Restricting User Input" in the Game Courier Developer's Guide for details on how this is done.
If you believe that your input should not have been banned, contact Fergus Duniho or whoever programmed the rules for this game.
Edit Settings File 0 echo This Shogi preset now spots check, checkmate, and stalemate. Let me know if it makes any mistakes.
1 set k findpiece k spaces
2 set K findpiece K spaces
3 set promote assoc p t n y l m s v g g r d b h k k P T N Y L M S V G G R D B H K K
4 alias +p t +n y +l m +s v +r d +b h +P T +N Y +L M +S V +R D +B H
5 include shogi
6 setsystem starpath (!Ai !Ah !Ag !Af !Ae !Ad !Ac !Ab !Aa !Bi !Bh !Bg !Bf !Be !Bd !Bc !Bb !Ba !Ci !Ch !Cg !Cf !Ce !Cd !Cc !Cb !Ca !Di !Dh !Dg !Df !De !Dd !Dc !Db !Da) reverse (!Ai !Ah !Ag !Af !Ae !Ad !Ac !Ab !Aa !Bi !Bh !Bg !Bf !Be !Bd !Bc !Bb !Ba !Ci !Ch !Cg !Cf !Ce !Cd !Cc !Cb !Ca !Di !Dh !Dg !Df !De !Dd !Dc !Db !Da)
7 sub postauto1
8 if isupper moved
9 die You may not move any enemy pieces.
10 endif
11 if islower old
12 die You may not capture your own pieces.
13 endif
14 set pp space dest
15 if not isalnum origin
16 if capture
17 die You may not drop a piece on an occupied space.
18 elseif not isalnum dest
19 die You may not drop a piece off the board.
20 elseif == rank dest 8 and match moved p l n
21 die You may not drop a moved onto the last rank.
22 elseif == rank dest 7 and == moved n
23 die You may not drop a Knight onto this rank.
24 elseif != moved #pp
25 die You may not promote a piece when dropping it.
26 elseif twinonfile dest and == moved p
27 die You may not drop a Pawn on a file that already has another of your unpromoted Pawns on it.
28 endif
29 elseif not fn moved origin dest
30 die You not move a moved from origin to dest
31 endif
32 if == moved k
33 set k dest
34 elseif != #pp moved
35 if < rank origin 6 and < rank dest 6
36 die You may not promote any piece without moving from or to the last three ranks.
37 elseif != #pp elem moved promote
38 die You may not promote your moved to a #pp
39 endif
40 elseif == rank dest 8 and match moved p n l
41 set pp elem moved promote
42 add #pp dest
43 elseif == rank dest 7 and == moved n
44 add y dest
45 endif
46 if fn ATTACKEDBYW #k
47 die You may not move into check.
48 endif
49 verify capture
50 set p old
51 set c dest
52 drop old first !Ai !Ah !Ag !Af !Ae !Ad !Ac !Ab !Aa !Bi !Bh !Bg !Bf !Be !Bd !Bc !Bb !Ba !Ci !Ch !Cg !Cf !Ce !Cd !Cc !Cb !Ca !Di !Dh !Dg !Df !De !Dd !Dc !Db !Da
53 flip dest
54 convert dest d r h b v s m l y n t p
55 setglobal lastcaptured #p
56 setglobal "dest" #c
57 endsub
58 sub postauto2
59 if islower moved
60 die You may not move any enemy pieces.
61 endif
62 if isupper old
63 die You may not capture your own pieces.
64 endif
65 set pp space dest
66 if not isalnum origin
67 if capture
68 die You may not drop a piece on an occupied space.
69 elseif not isalnum dest
70 die You may not drop a piece off the board.
71 elseif == rank dest 0 and match moved P L N
72 die You may not drop a moved onto the last rank.
73 elseif == rank dest 1 and == moved N
74 die You may not drop a Knight onto the eighth rank.
75 elseif != moved #pp
76 die You may not promote a piece when dropping it.
77 elseif twinonfile dest and == moved P
78 die You may not drop a Pawn on a file that already has another of your unpromoted Pawns on it.
79 endif
80 elseif not fn moved origin dest
81 die You not move a moved from origin to dest
82 endif
83 if == moved K
84 set K dest
85 elseif != #pp moved
86 if < 2 rank origin and < 2 rank dest
87 die You may not promote any piece without moving from or to the last three ranks.
88 elseif != #pp elem moved promote
89 die You may not promote your moved to a #pp
90 endif
91 elseif match moved P N L and == rank dest 0
92 set pp elem moved promote
93 add #pp dest
94 elseif == rank dest 1 and == moved N
95 add Y dest
96 endif
97 if fn ATTACKEDBYB #K
98 die You may not move into check.
99 endif
100 verify capture
101 set p old
102 set c dest
103 drop old last !Ai !Ah !Ag !Af !Ae !Ad !Ac !Ab !Aa !Bi !Bh !Bg !Bf !Be !Bd !Bc !Bb !Ba !Ci !Ch !Cg !Cf !Ce !Cd !Cc !Cb !Ca !Di !Dh !Dg !Df !De !Dd !Dc !Db !Da
104 flip dest
105 convert dest D R H B V S M L Y N T P
106 setglobal lastcaptured #p
107 setglobal "dest" #c
108 setglobal lastcaptured #temp
109 endsub
110 moveindex 0
111 MOVE: p 2g-2f
112 postauto1
113 moveindex 1
114 MOVE: P 8c-8d
115 postauto2
116 moveindex 2
117 MOVE: g 6i-6h
118 postauto1
119 moveindex 3
120 MOVE: G 6a-7b
121 postauto2
122 moveindex 4
123 MOVE: p 6g-6f
124 postauto1
125 moveindex 5
126 MOVE: P 8d-8e
127 postauto2
128 moveindex 6
129 MOVE: p 7g-7f
130 postauto1
131 moveindex 7
132 MOVE: G 4a-3b
133 postauto2
134 moveindex 8
135 MOVE: g 6h-7g
136 postauto1
137 moveindex 9
138 MOVE: K 5a-4a
139 postauto2
140 moveindex 10
141 MOVE: g 4i-5h
142 postauto1
143 moveindex 11
144 MOVE: S 3a-4b
145 postauto2
146 moveindex 12
147 MOVE: p 1g-1f
148 postauto1
149 moveindex 13
150 MOVE: P 1c-1d
151 postauto2
152 moveindex 14
153 MOVE: s 7i-6h
154 postauto1
155 moveindex 15
156 MOVE: G 7b-6b
157 postauto2
158 moveindex 16
159 MOVE: p 2f-2e
160 postauto1
161 moveindex 17
162 MOVE: G 6b-5b
163 postauto2
164 moveindex 18
165 MOVE: p 5g-5f
166 postauto1
167 moveindex 19
168 MOVE: P 9c-9d
169 postauto2
170 moveindex 20
171 MOVE: p 9g-9f
172 postauto1
173 moveindex 21
174 MOVE: L 9a-9c
175 postauto2
176 moveindex 22
177 MOVE: s 3i-4h
178 postauto1
179 moveindex 23
180 MOVE: R 8b-9b
181 postauto2
182 moveindex 24
183 MOVE: n 8i-9g
184 postauto1
185 moveindex 25
186 MOVE: S 7a-8b
187 postauto2
188 moveindex 26
189 MOVE: n 9g-8e
190 postauto1
191 moveindex 27
192 MOVE: P 9d-9e
193 postauto2
194 moveindex 28
195 MOVE: n 8e-9c
196 postauto1
197 moveindex 29
198 MOVE: N 8a-9c
199 postauto2
200 moveindex 30
201 MOVE: p 9f-9e
202 postauto1
203 moveindex 31
204 MOVE: N 9c-8e
205 postauto2
206 moveindex 32
207 MOVE: g 7g-8f
208 postauto1
209 moveindex 33
210 MOVE: N*9c
211 postauto2
212 moveindex 34
213 MOVE: p 9e-9d
214 postauto1
215 moveindex 35
216 MOVE: P 3c-3d
217 postauto2
218 moveindex 36
219 MOVE: p 9d-9c
220 postauto1
221 moveindex 37
222 MOVE: S 8b-9c
223 postauto2
224 moveindex 38
225 MOVE: g 8f-8e
226 postauto1
227 moveindex 39
228 MOVE: P*8d
229 postauto2
230 moveindex 40
231 MOVE: g 8e-7e
232 postauto1
233 moveindex 41
234 MOVE: R 9b-8b
235 postauto2
236 moveindex 42
237 MOVE: l 9i-9c
238 postauto1
239 moveindex 43
240 MOVE: R 8b-8c
241 postauto2
242 moveindex 44
243 MOVE: l*9i
244 postauto1
245 moveindex 45
246 MOVE: resigns
247 postauto2
248 set checks sub checks #k
249 if var checks
250 if sub checkmated #k #checks
251 restore
252 if == moved P and not isalnum origin
253 die You may not checkmate a King by dropping a Pawn.
254 endif
255 say Checkmate! White has won!
256 won
257 else
258 say Check!
259 endif
260 elseif sub stalemated #k
261 say Stalemate! White has won.
262 won
263 endif
264 end
265
266 lib shogi
267 setsystem maxmove 2
268 ban commands allmoves
269 allow moves 1 captures 1 drops 1 promotions 2
270 def p checkaleap #0 #1 0 1
271 def n checkaleap #0 #1 1 2 or checkaleap #0 #1 -1 2
272 def b checkride #0 #1 1 1
273 def r checkride #0 #1 1 0
274 def l checkaride #0 #1 0 1
275 def s checkaleap #0 #1 0 1 or checkleap #0 #1 1 1
276 def g checkaleap #0 #1 1 1 or checkaleap #0 #1 -1 1 or checkleap #0 #1 0 1
277 def t checkaleap #0 #1 1 1 or checkaleap #0 #1 -1 1 or checkleap #0 #1 0 1
278 def y checkaleap #0 #1 1 1 or checkaleap #0 #1 -1 1 or checkleap #0 #1 0 1
279 def m checkaleap #0 #1 1 1 or checkaleap #0 #1 -1 1 or checkleap #0 #1 0 1
280 def v checkaleap #0 #1 1 1 or checkaleap #0 #1 -1 1 or checkleap #0 #1 0 1
281 def h checkleap #0 #1 1 0 or checkride #0 #1 1 1
282 def d checkleap #0 #1 1 1 or checkride #0 #1 1 0
283 def k checkleap #0 #1 1 1 or checkleap #0 #1 1 0
284 def z checkaleap #0 #1 0 2
285 def P checkaleap #0 #1 0 -1
286 def N checkaleap #0 #1 1 -2 or checkaleap #0 #1 -1 -2
287 def B checkride #0 #1 1 1
288 def R checkride #0 #1 1 0
289 def L checkaride #0 #1 0 -1
290 def S checkaleap #0 #1 0 -1 or checkleap #0 #1 1 1
291 def G checkaleap #0 #1 1 -1 or checkaleap #0 #1 -1 -1 or checkleap #0 #1 0 1
292 def T checkaleap #0 #1 1 -1 or checkaleap #0 #1 -1 -1 or checkleap #0 #1 0 1
293 def Y checkaleap #0 #1 1 -1 or checkaleap #0 #1 -1 -1 or checkleap #0 #1 0 1
294 def M checkaleap #0 #1 1 -1 or checkaleap #0 #1 -1 -1 or checkleap #0 #1 0 1
295 def V checkaleap #0 #1 1 -1 or checkaleap #0 #1 -1 -1 or checkleap #0 #1 0 1
296 def H checkleap #0 #1 1 0 or checkride #0 #1 1 1
297 def D checkleap #0 #1 1 1 or checkride #0 #1 1 0
298 def K checkleap #0 #1 1 1 or checkleap #0 #1 1 0
299 def Z checkaleap #0 #1 0 -2
300 def @ #0 and #1 and false
301 def FVL match #1 what #0 0 1
302 def BVL match #1 what #0 0 -1
303 def FVR match #1 insight #0 0 1
304 def BVR match #1 insight #0 0 -1
305 def FDL match #1 what #0 1 1 what #0 -1 1
306 def BDL match #1 what #0 1 -1 what #0 -1 -1
307 def FNL match N what #0 1 2 what #0 -1 2
308 def BNL match n what #0 1 -2 what #0 -1 -2
309 def FZL == Z what #0 0 2
310 def BZL == z what #0 0 -2
311 def OL check what #0 0 -1 check what #0 -1 0 check what #0 0 1 check what #0 1 0 target #1
312 def DL check what #0 -1 -1 check what #0 -1 1 check what #0 1 -1 check what #0 1 1 target #1
313 def OR check insight #0 0 -1 check insight #0 -1 0 check insight #0 0 1 check insight #0 1 0 target #1
314 def DR check insight #0 -1 -1 check insight #0 -1 1 check insight #0 1 -1 check insight #0 1 1 target #1
315 def ATTACKEDBYW fn FZL #0 or fn FNL #0 or fn FVL #0 (P S) or fn DL #0 (S K D) or fn FDL #0 (G T M V) or fn OL #0 (G T Y M V K H) or fn FVR #0 L or fn OR #0 (R D) or fn DR #0 (B H)
316 def ATTACKEDBYB fn BZL #0 or fn BNL #0 or fn BVL #0 (p s) or fn DL #0 (s k d) or fn BDL #0 (g t m v) or fn OL #0 (g t y m v k h) or fn BVR #0 l or fn OR #0 (r d) or fn DR #0 (b h)
317 sub checks king
318 my checks c
319 set checks ()
320 if dest
321 if fn space dest dest #king
322 setelem checks dest space dest
323 endif
324 if isalnum origin
325 set c sub checkedthru #king origin
326 if #c
327 setelem checks #c space #c
328 endif
329 endif
330 else
331 if isupper cond empty #king moved space #king
332 def enemies onlylower
333 else
334 def enemies onlyupper
335 endif
336 for (from piece) fn enemies
337 if fn #piece #from #king
338 setelem checks #from space #from
339 if > count var checks 1
340 break
341 endif
342 endif
343 next
344 endif
345 return var checks
346 endsub
347 sub checkmated king checks
348 store
349 local from piece to key piece
350 set lglmvs array
351 if isupper space #king
352 def friends onlyupper
353 def friend isupper #0
354 def attacked fn ATTACKEDBYB #0
355 set lastrank 9
356 set pawn P
357 set forward 1
358 else
359 def friends onlylower
360 def friend islower #0
361 def attacked fn ATTACKEDBYW #0
362 set lastrank 1
363 set pawn p
364 set forward -1
365 endif
366 set kingmoves merge leaps #king 1 0 leaps #king 1 1
367 for to #kingmoves
368 if not fn friend space #to and onboard #to
369 move #king #to
370 set checked fn attacked #to
371 restore
372 if not #checked
373 setlegal #king #to
374 endif
375 endif
376 next
377 if == count var checks 1
378 for (key enemy) var checks
379 for (from piece) fn friends
380 if == #from #king
381 continue
382 endif
383 if isalnum #from and #piece
384 if fn #piece #from #key
385 echo #piece #from #key
386 move #from #key
387 set checked fn attacked #king
388 restore
389 if not #checked
390 setlegal #from #key
391 endif
392 endif
393 endif
394 set possible path #king #key
395 for to #possible
396 if isalnum #from
397 if fn #piece #from #to and #piece
398 move #from #to
399 set checked fn attacked #king
400 restore
401 if not #checked
402 setlegal #from #to
403 endif
404 endif
405 else
406 switch #piece
407 case P p
408 if onboard where #to #forward 0 and not onfile filename #to #piece
409 setlegal #from #to
410 endif
411 break
412 case L l
413 if onboard where #to #forward 0
414 setlegal #from #to
415 endif
416 break
417 case N n Z z
418 if onboard where #to * #forward 2 0
419 setlegal #from #to
420 endif
421 break
422 default
423 setlegal #from #to
424 break
425 endswitch
426 endif
427 next
428 next
429 next
430 endif
431 return cond count system legalmoves false true and checks
432 endsub
433 sub stalemated king
434 local forward from piece to pawninhand pawn key pawndrops lancedrops knightdrops piecedrops
435 set pawndrops array
436 set lancedrops array
437 set knightdrops array
438 set piecedrops array
439 set pawnonfile array
440 if isupper space #king
441 def friend isupper #0
442 def friends onlyupper
443 def attacked fn ATTACKEDBYB #0
444 set pawn P
445 set forward -1
446 else
447 def friend islower #0
448 def friends onlylower
449 def attacked fn ATTACKEDBYW #0
450 set pawn p
451 set forward 1
452 endif
453 store
454 for (from piece) fn friends
455 if not isalnum #from
456 continue
457 endif
458 switch #piece
459 case p
460 set spcs array where #from 0 1
461 break
462 case l
463 set spcs ray #from 0 1
464 break
465 case P
466 set spcs array where #from 0 -1
467 break
468 case L
469 set spcs ray #from 0 -1
470 break
471 case n
472 set spcs array where #from 1 2 where #from -1 2
473 break
474 case N
475 set spcs array where #from 1 -2 where #from -1 -2
476 break
477 case s
478 set spcs merge leaps #from 1 1 array where #from 0 1
479 break
480 case S
481 set spcs merge leaps #from 1 1 array where #from 0 -1
482 break
483 case g t m v y
484 set spcs merge leaps #from 1 0 array where #from -1 1 where #from 1 1
485 break
486 case G T M V Y
487 set spcs merge leaps #from 1 0 array where #from -1 -1 where #from 1 -1
488 break
489 case z
490 set spcs array where #from 0 2
491 case Z
492 set spcs array where #from 0 -2
493 case r R
494 set spcs rays #from 0 1
495 break
496 case d D
497 set spcs merge rays #from 0 1 leaps #from 1 1
498 break
499 case b B
500 set spcs rays #from 1 1
501 break
502 case h H
503 set spcs merge rays #from 1 1 leaps #from 0 1
504 break
505 case k K
506 set spcs merge leaps #from 1 0 leaps #from 1 1
507 break
508 default
509 set spcs merge rays #from 1 0 rays #from 1 1
510 break
511 endswitch
512 for to #spcs
513 if fn #piece #from #to and onboard #to and not fn friend space #to
514 move #from #to
515 if == #from #king
516 set checked fn attacked #to
517 else
518 set checked fn attacked #king
519 endif
520 restore
521 if not #checked
522 setlegal #from #to
523 endif
524 endif
525 next
526 next
527 for to fn spaces
528 if empty #to and isalnum #to
529 push piecedrops #to
530 if onboard where #to 0 #forward
531 push lancedrops #to
532 if not sub pawndropcheckmate #pawn #to and not onfile filename #to #pawn
533 push pawndrops #to
534 endif
535 if onboard where #to 0 * #forward 2
536 push knightdrops #to
537 endif
538 endif
539 endif
540 next
541 for (from piece) fn friends
542 if not isalnum #from
543 switch #piece
544 case p P
545 for to var pawndrops
546 setlegal "{#piece}*{#to}"
547 next
548 break
549 case n N z Z
550 for to var knightdrops
551 setlegal "{#piece}*{#to}"
552 next
553 break
554 case l L
555 for to var lancedrops
556 setlegal "{#piece}*{#to}"
557 next
558 break
559 default
560 for to var piecedrops
561 setlegal "{#piece}*{#to}"
562 next
563 break
564 endswitch
565 endif
566 next
567 return cond count system legalmoves false true
568 endsub
569 sub pawndropcheckmate pawn spot
570 my allies
571 local king kingmoves black test to
572 verify empty #spot and onboard #spot
573 if == #pawn P
574 set king where #spot 0 -1
575 set black true
576 else
577 set king where #spot 0 1
578 set black false
579 endif
580 verify == space #king cond #black k K
581 set kingmoves merge leaps #king 1 0 leaps # 1 1
582 for to #kingmoves
583 if not cond #black islower space #to isupper space #to or empty #to and onboard #to
584 move #king #to
585 set checked fn cond #black ATTACKEDBYW ATTACKEDBYB #to
586 restore
587 verify #checked
588 endif
589 next
590 if #black
591 set allies onlylower
592 else
593 set allies onlyupper
594 endif
595 for (from piece) #allies
596 if == #piece #king
597 continue
598 endif
599 if fn #piece #from #spot and #piece
600 move #from #spot
601 set checked fn cond #black ATTACKEDBYW ATTACKEDBYB #king
602 restore
603 verify #checked
604 endif
605 next
606 return true
607 endsub
608 sub checkedthru king loc
609 my dir c p
610 set c revealed #king #loc
611 set p space #c
612 if samecase space #king #p or not #c
613 return false
614 endif
615 set dir direction #king #loc
616 switch #dir
617 case n
618 if match #p R r D d L
619 return #c
620 endif
621 return false
622 case s
623 if match #p R r D d l
624 return #c
625 endif
626 return false
627 case e w
628 if match #p R r D d
629 return #c
630 endif
631 return false
632 case nw sw ne se
633 if match #p B b H h
634 return #c
635 endif
636 return false
637 default
638 return false
639 endswitch
640 endsub
641 endlib