%%HP: T(3)A(D)F(.);
@ CHESS by Paul Dale
DIR
  play
    \<< RCLF 'FLGS' STO
      STBRD OBJ\->  'BRD' STO
      "2'DPTH'0'PLY'0'MTBL'0'EPSNT'0'SCORE'25'PKNG'95'CKNG'1 7" OBJ\->
      START STO
      NEXT { # 400306410103F4h # 0h } STOF
      # 83h # 40h BLANK PICT STO
      { # 0h # 0h } PVIEW DRWB
      DO "____" 'INP' STO
        2 SF
        FINP MOVE
        MEM DROP
      UNTIL 1 FS?
      END FLGS STOF
      "{FLGS DPTH PLY BRD INP MTBL SCORE PKNG CKNG EPSNT}" OBJ\-> PURGE
    \>>
  DISPMV
    \<< C\->R \-> frs tos
      \<< PICT frs COORDS C\->R SWAP R\->C 8 * (7,7) - # 8h # 8h BLANK
        IF frs DUP 10 / IP + 2 MOD
        THEN NEG
        END REPL tos BDGT DUP ABS SWAP SIGN \-> p col
        \<< PICT tos COORDS C\->R SWAP R\->C 8 * (7,7) - DUP2 # 8h # 8h BLANK
          IF tos DUP 10 / IP + 2 MOD
          THEN NEG
          END REPL
          IF tos DUP 10 / IP + 2 MOD DUP col -1 SAME XOR
          THEN 2
          ELSE 1
          END FIG SWAP GET p GET SWAP
          \<< GXOR
          \>>
          \<< GOR
          \>> IFTE
        \>>
      \>> DROP
    \>>
  FIG { {
GROB 8 8 0000C3424242C300
GROB 8 8 00C366242764C700
GROB 8 8 00C143426624E700
GROB 8 8 00E7A5242424E700
GROB 8 8 00E7A5662424E700
GROB 8 8 00C366246624E700
} {
GROB 8 8 0000008181810000
GROB 8 8 000081C3C0830000
GROB 8 8 0000808181C30000
GROB 8 8 000042C3C3C30000
GROB 8 8 00004281C3C30000
GROB 8 8 000081C381C30000
} }
  debugs
    \<< \-> n
      \<< DUP C\->R UNCVT SWAP UNCVT SWAP + PLY
       \->STR " " + n \->STR + " " + SWAP + " " + 5 DIS
      \>>
    \>>
  SORTMV
    \<< \-> xt sq
      \<< { } 1 22
        START DUP
        NEXT 21 \->LIST DUP \-> xht sht
        \<< 1 xt SIZE
          FOR n xht xt n GET DUP C\->R DROP
            IF DUP 18 >
            THEN DROP 18
            END 1 + DUP xht SWAP GET ROT + OVER sht SWAP DUP2
            GET sq n GET + PUT 'sht' STO PUT 'xht' STO
          NEXT 'xt' STO 'sq' STO
          "6 16 9 13 8 14 7 15 2 20 3 1 1 12" STR\->
          START xt xht 3 PICK GET + 'xt' STO sq sht ROT GET + 'sq' STO
          NEXT xt sq
        \>>
      \>>
    \>>
  SEARCH
    \<< MEM DROP 1 'PLY' STO+ \-> l1 col
      \<< MAXR col * { i i } \-> l2 best
        \<< col ALLMV SORTMV DUP SIZE
          IF col 0 >
          THEN
            \<< \>= \>>
            \<< < \>>
          ELSE
            \<< \<= \>>
            \<< > \>>
          END \-> xt sq n c1 c2
          \<<
            DO xt n GET sq n GET DUP2 MKMV n debugs DUP C\->R SWAP DROP DUP
              MVGEN DROP SIZE 200 / SWAP COORDS DUP (4.5,4.5) - ABS 10 * INV
              RD2 SWAP col 0 > CKNG PKNG IFTE COORDS - ABS 10 * 1 + INV RD2
              + + col * DUP NEG SCUPD ROT ROT 12 col * col SCOREMV
              IF 1
              THEN DUP \->STR "  " + 6 DIS
              END
              IF DUP l1 c1 EVAL
              THEN 8 CF
                IF DUP l2 c2 EVAL
                THEN 'l2' STO DUP2
                  IF PLY 1 SAME
                  THEN DUP2 SHOWMV
                  END 2 \->LIST 'best' STO
                ELSE DROP
                END
              ELSE 'l2' STO 8 SF
              END n 1 - DUP 'n' STO
              IF NOT
              THEN 8 SF
              END UNMKMV SCUPD
            UNTIL 8 FS?
            END
          \>> best LIST\-> DROP l2
        \>>
      \>> 'PLY' 1 STO-
    \>>
  SCOREMV
    \<<
      IF PLY DPTH ==
      THEN DROP2 SCORE
      ELSE NEG SEARCH ROT ROT DROP2
      END
    \>>
  GETMV
    \<< \-> n
      \<< n GET SWAP n GET SWAP \>>
    \>>
  CPMV
    \<< MAXR -1
      IF 5 FS?
      THEN NEG SWAP NEG SWAP
      END SEARCH DROP "My move" 3 DIS DUP2 SHOWMV DUP2 MKMV DISPMV ERRBELL
    \>>
  UNMKMV
    \<< \-> xt sq
      \<< sq C\->R xt C\->R \-> frs tos t z
        \<< 'BRD' DUP tos BDGT DUP SIGN \-> col
          \<< frs SWAP PUT tos 0 PUT
            IF tos PKNG SAME
            THEN frs 'PKNG' STO
            ELSE
              IF tos CKNG SAME
              THEN frs 'CKNG' STO
              END
            END
            IF xt i \=/
            THEN
              IF t 1 SAME
              THEN z GTML NEG MTUPD 'BRD' tos z PUT
              ELSE
                IF t 2 SAME
                THEN z 'EPSNT' STO
                ELSE
                  IF t NOT
                  THEN 'BRD' tos 10 col * - col NEG PUT col GTML MTUPD
                  ELSE
                    IF t 20 >
                    THEN 'BRD' DUP t z BDGT PUT z 0 PUT
                    ELSE 'BRD' DUP frs col PUT tos t 10 - DUP GTML z GTML
                    - col GTML - MTUPD PUT
                    END
                  END
                END
              END
            END
          \>>
        \>>
      \>>
    \>>
  GTML
    \<< DUP SIGN SWAP ABS \-> col pce
      \<< [ 1 3.25 3.5 5 9 120 ] pce
        IFERR GET
        THEN DROP2 0
        ELSE col *
        END
      \>>
    \>>
  SCUPD
    \<< 'SCORE' STO+ \>>
  MTUPD
    \<< DUP 'MTBL' STO+ SCUPD \>>
  MKMV
    \<< \-> xt sq
      \<< sq C\->R xt C\->R \-> frs tos t z
        \<<
          IF frs PKNG SAME
          THEN tos 'PKNG' STO
          ELSE
            IF frs CKNG SAME
            THEN tos 'CKNG' STO
            END
          END 'BRD' DUP frs BDGT DUP DUP SIGN SWAP ABS \-> col ptyp
          \<< tos SWAP PUT frs 0 DUP 'EPSNT' STO PUT
            IF xt i \=/
            THEN
              IF t 1 SAME
              THEN z GTML MTUPD
              ELSE
                IF t 2 SAME
                THEN frs 10 col * + 'EPSNT' STO
                ELSE
                  IF t NOT
                  THEN 'BRD' tos 10 col * - 0 PUT col NEG GTML MTUPD
                  ELSE
                    IF t 20 >
                    THEN 'BRD' DUP z t BDGT PUT t 0 PUT
                    ELSE z GTML MTUPD 'BRD' tos t 10 - DUP GTML col GTML
                      SWAP - MTUPD PUT
                    END
                  END
                END
              END
            END
          \>>
        \>>
      \>>
    \>>
  CVRTSQ
    \<< DUP 1 DUP SUB "abcdefgh" SWAP POS SWAP 2 DUP SUB
     "12345678" SWAP POS \-> x y
      \<<
        IF x NOT y NOT OR
        THEN 4 SF
        ELSE x 10 DUP y * + +
        END
      \>>
    \>>
  PLMV
    \<< 4 CF INP CVRTSQ INP 3 4 SUB CVRTSQ \-> frs tos
      \<<
        IF 4 FC? frs BDGT DUP 0 > SWAP 7 \=/ AND AND
        THEN frs MVGEN frs tos R\->C POS DUP
          IF 0 SAME
          THEN DROP
          ELSE GET frs tos R\->C DUP2 MKMV DISPMV 6 SF
          END
        END
      \>>
    \>>
  ALLMV
    \<< { } DUP \-> col sq xt
      \<< 21 98
        FOR n
          IF n BDGT DUP SIGN col SAME SWAP 7 \=/ AND
          THEN n MVGEN sq + 'sq' STO xt + 'xt' STO
          END
        NEXT xt sq
      \>>
    \>>
  MVGEN
    \<< 3 CF { } DUP \-> p sq xt
      \<< p BDGT DUP SIGN SWAP ABS
        \<< xt + 'xt' STO p SWAP R\->C sq + 'sq' STO
        \>> \-> col pce admov
        \<<
          \<< p + DUP BDGT DUP DUP DUP
            IF
            THEN 3 SF
            END
            IF 7 \=/ SWAP SIGN col \=/ AND
            THEN
              IF DUP NOT
              THEN DROP i
              ELSE 1 SWAP R\->C
              END admov EVAL
            ELSE DROP2
            END
          \>> \-> chk
          \<<
            \<< STR\->
              START 0
                DO OVER + DUP chk EVAL
                UNTIL 3 FS?C
                END DROP2
              NEXT
            \>> \-> mmv
            \<< {
              \<<
                \<< \-> tos
                  \<<
                    IF tos 10 / IP DUP 2 SAME SWAP 9 SAME OR
                    THEN 2 5
                      FOR m tos DUP BDGT m col * 10 + SWAP R\->C admov EVAL
                      NEXT 0
                    ELSE tos 1
                    END
                  \>>
                \>> \-> promote
                \<<
                  \<< DUP
                    IF DUP EPSNT SAME
                    THEN i NEG admov EVAL DROP
                    ELSE
                      IF BDGT DUP DUP 7 \=/ SWAP SIGN col + NOT AND
                      THEN SWAP
                        IF promote EVAL
                        THEN 1 ROT R\->C admov EVAL
                        ELSE DROP
                        END
                      ELSE DROP2
                      END
                    END
                  \>> \-> capchk
                  \<< 10 col * p + DUP DUP
                    IF BDGT
                    THEN DROP
                    ELSE
                      IF promote EVAL
                      THEN i admov EVAL
                      ELSE DROP
                      END
                      IF p 10 / IP DUP 3 SAME SWAP 8 SAME OR
                      THEN 20 col * p + DUP
                        IF BDGT
                        THEN DROP
                        ELSE 2 EPSNT R\->C admov EVAL
                        END
                      END
                    END 1 DUP2 + capchk EVAL - capchk EVAL
                  \>>
                \>>
              \>>
              \<<
                "8 -8 12 -12 19 -19 21 -21 1 8" STR\->
                START chk EVAL
                NEXT
              \>>
              \<< "9 -9 11 -11 1 4" mmv EVAL \>>
              \<< "1 -1 10 -10 1 4" mmv EVAL \>>
              \<< "1 -1 9 -9 10 -10 11 -11 1 8" mmv EVAL \>>
              \<<
                "1 -1 9 -9 10 -10 11 -11 1 8" STR\->
                START chk EVAL
                NEXT
                IF p 25 SAME p 95 SAME OR
                THEN
                  IF p 1 + BDGT NOT
                    p 2 + BDGT NOT AND
                    p 3 + BDGT ABS 4 SAME AND
                  THEN p 2 + p 3 + p 1 + R\->C admov EVAL
                  END
                  IF p 1 - BDGT NOT
                    p 2 - BDGT NOT AND
                    p 3 - BDGT NOT AND
                    p 4 - BDGT ABS 4 SAME AND
                  THEN p 2 - p 4 - p 1 - R\->C admov EVAL
                  END
                END
              \>> } pce GET EVAL
            \>>
          \>>
        \>> xt sq
      \>>
    \>>
  SHOWMV
    \<< C\->R UNCVT SWAP UNCVT SWAP + 4 DIS DROP \>>
  UNCVT
    \<< 10 / DUP IP 1 - \->STR SWAP FP 10 * "abcdefgh" SWAP DUP SUB SWAP +
    \>>
  COORDS
    \<< 10 / DUP IP 1 - SWAP FP 10 * R\->C \>>
  RD2
    \<< 100 * IP 100 / \>>
  BDGT
    \<< 'BRD' SWAP GET \>>
  DRWB
    \<< 21 \-> n
      \<< (1,1)
        WHILE 99 n \>=
        REPEAT n
          IF 5 FS?
          THEN 119 SWAP -
          END BDGT DUP ABS SWAP SIGN \-> p col
          \<<
            IF p 7 \=/
            THEN DUP PICT SWAP # 8h # 8h BLANK
              IF n DUP 10 / IP + 2 MOD
              THEN NEG
              END REPL
            END
            IF p 0 \=/
            THEN
              IF p 7 SAME
              THEN (-40,4) +
              ELSE DUP
                IF n DUP 10 / IP + 2 MOD DUP col -1 SAME XOR
                THEN 2
                ELSE 1
                END FIG SWAP GET p GET PICT 4 ROLLD SWAP
                \<< GXOR \>>
                \<< GOR \>> IFTE
              END
            END
          \>> (8,0) + n 1 + 'n' STO
        END DROP
      \>>
    \>>
  MOVE
    \<< 6 CF "        " 3 DIS "    " 4 DIS
      IF INP "quit" ==
      THEN 1 SF
      ELSE
        IF INP "halt" ==
        THEN HALT
        ELSE
          IF INP "swap" ==
          THEN
            IF 5 DUP FS?
            THEN CF
            ELSE SF
            END 6 SF 119 PKNG - 119 CKNG - 'PKNG' STO 'CKNG' STO DRWB
          ELSE PLMV
          END
          IF 6 FS?
          THEN CPMV
          ELSE "Illegal move" 6 DIS ERRBELL
          END
        END
      END
    \>>
  DIS
    \<< 1 - 10 * SWAP 2 \->GROB
      SWAP 57 SWAP - -66 SWAP R\->C SWAP PICT 3 ROLLD REPL
    \>>
  input
    \<<
      WHILE key
      REPEAT \-> st
        \<<
          IF st SIZE 1 SAME
          THEN INP 2 4 SUB st + 'INP' STO
          ELSE
            IF st "ENTER" SAME
            THEN 2 CF
            ELSE
              IF st "DEL" SAME
              THEN "____" 'INP' STO
              ELSE
                IF st "BACK" SAME
                THEN "_" INP 1 3 SUB + 'INP' STO
                END
              END
            END
          END INP 2 DIS
        \>>
      END
    \>>
  FINP
    \<< 2 SF "Your move?" 1 DIS INP 2 DIS
      WHILE 2 FS?
      REPEAT input
      END "          " 1 DIS
    \>>
  ERRBELL
    \<< 440 .1 BEEP \>>
  STBRD
"[7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 4 2 3 5 6 3 2 4 7 7 1 1 1 1 1 1 1 1 7 7 0 0 0 0 0 0 0 0 7 7 0 0 0 0 0 0 0 0 7 7 0 0 0 0 0 0 0 0 7 7 0 0 0 0 0 0 0 0 7 7 -1 -1 -1 -1 -1 -1 -1 -1 7 7 -4 -2 -3 -5 -6 -3 -2 -4 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7"
  key
    \<< { { "a" "b" "c" "d" "e" "f" }
          { "g" "h" "i" "j" "k" "l" }
          { "m" "n" "o" "p" "q" "r" }
          { "s" "t" "u" "v" "w" "x" }
          { "ENTER" "y" "z" "DEL" "BACK" }
          { "" "7" "8" "9" "" }
          { "" "4" "5" "6" "" }
          { "" "1" "2" "3" "-" }
          { "" "0" "." " " "+" } } KEY
      \<< 10 / DUP IP SWAP FP 10 * 3 ROLLD GET SWAP GET
        IF DUP SIZE
        THEN 1
        ELSE DROP 0
        END
      \>>
      \<< DROP 0
      \>> IFTE
    \>>
  PPAR { (-66,-6) (64,57) constant 1 (0,0) FUNCTION Y }
END