hiya,
I'm posting a 'little' program that plays chess!
It draws a recognisable board, allows the human player to enter their move and
then replies with its move [yep, it really does play -- just not overly well].
The commands that are permitted are: (they're all 4 characters)
QUIT - stop the game in a rather permenant fashion
HALT - pause the game
SWAP - change sides
all moves are entered as start/end (e.g. E2E4 for P-K4).
While the display is being drawn (it takes a while) commands may be entered and
when ENTER is pressed the game continues.
Currently, there are quite a lot of debugging messages displayed while the
machine works out its move -- these could be removed if necessary.
The program understands most chess rules. (it knows about enpassant, castling
and underpromotion. It doesn't know about triple position/stalemate/50 move rule
and it won't actually stop playing when it loses it king).
The program uses a minimax search with alpha/beta pruning and move ordering.
I didn't get staged move generation done [this would increase speed a fair bit]
and haven't implemented any form of killer heuristic.
The program was written mostly to be as small as possible (then as fast as
possible) since I didn't realise it would be as small as it is. One possible
future extension would be to speed it up.....it is pretty dismal!
If anyone types in this program I would like to hear from them; any improvements
or alterations would also be of great interest to me.
I can be reached at grue@lance.hss.bu.oz, and I would like to see how far
this program propogates! (I need encouragement or I may not submit too many
more programs -- I've still got to write 'em!!!)
If there is sufficient interest I'll post/email some extra internal docs that
I haven't really changed from scraps of paper into something more
understandable.
It had to happen, this program isn't really in the public domain.
Copyright notice: This program remains copyright Paul Dale (1988/89)
Permission is given for this program or any derived
programs to be used for personal non-profit purposes.
Hope this makes someone else happy.
Pauli
seeya
SNIF
The program follows:
ERRBELL:<< 440 .1 BEEP
>>
[A2BB]
PPAR: { (-104,2) (32,33) constant 1 (0,0) }
[A11]
DRWB: << 2 SF
"{[(1,2)(2,3)(3,2)[(1,2)(2,2)(3,2)(2,3)(2,4)(3,4)[(1,2)(2,2)(3,2)(2,3)(2
,4)[(1,2)(2,2)(3,2)(1,3)(2,3)(3,3)(1,4)(3,4)[(1,2)(2,2)(3,2)(2,3)(1,4)(3,4)[(1,2
)(2,2)(3,2)(1,3)(2,3)(3,3)(2,4" STR-> 21 -> pict n
<< CLLCD (1,1)
WHILE 99 n >= INPUT 2 FS? AND
REPEAT n BDGT DUP ABS SWAP SIGN -> p col
<<
IF p 0 SAME
THEN
IF n DUP 10 / IP + 2 MOD
THEN 1 3
FOR j 2 4
FOR k DUP j k R->C + PIXEL
NEXT
NEXT
END
ELSE
IF p 7 SAME
THEN (-20,2) +
ELSE DUP 'pict' p GET
IF col -1 SAME
THEN NEG SWAP (4,6) + SWAP
END DUP ROT CON + ARRY-> LIST-> SWAP
START PIXEL
NEXT
END
END
>> (4,0) + n 1 + 'n' STO
END DROP
>>
IF 2 FS?
THEN FINP
END
>>
[318B]
DIS: << DISS LCD-> AND ROT ROT DISP LCD-> OR ->LCD
>>
[7DEB]
DISS isn't a program, it is really a string type the following exactly as is:
DISS: << "" 1 105 START 0 CHR + NEXT 106 137 START 255 CHR + NEXT DUP + DUP +
>> EVAL 'DISS' STO
The checksum is [0] for the created DISS object.
INPUT: <<
WHILE KEY
REPEAT -> st
<<
IF st SIZE 1 SAME
THEN INP 2 4 SUB st + DUP 'INP' STO 1 DIS
ELSE
IF st "ENTER" SAME
THEN 2 CF
END
END
>>
END
>>
[811D]
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"
[6BC7]
MOVE: << 6 CF
IF INP "QUIT" ==
THEN 1 SF CLMF
ELSE
IF INP "HALT" ==
THEN HALT
ELSE
IF INP "SWAP" ==
THEN
<< 'BRD' SWAP GET
IF DUP 7 <>
THEN NEG
END
>> -> fix
<< 20 50
FOR j 1 8
FOR k 119 j k + DUP ROT ROT - DUP2 fix EVAL SWAP fix EVAL
'BRD' DUP ROT 5 PICK SWAP PUT 4 PICK ROT PUT DROP2
NEXT 10
STEP
IF EPSNT
THEN 119 'EPSNT' STO-
END
IF 5 DUP FS?
THEN CF
ELSE SF
END 6 SF CKNG PKNG 'CKNG' STO 'PKNG' STO SCORE NEG 'SCORE' STO
MTBL NEG 'MTBL' STO
>>
ELSE PLMV
END
IF 6 FS?
THEN CPMV
ELSE "Illegal move" 4 DIS ERRBELL
END
END
END
>>
[AD3B]
FINP: << 2 SF
WHILE 2 FS?
REPEAT INPUT
END
>>
[2030]
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
>>
>>
[79AD]
BDGT: << 'BRD' SWAP GET
>>
[FE0E]
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
>>
>>
[687C]
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 MKMV 6 SF
END
END
>>
>>
[9583]
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
>>
>>
[DA90]
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
>>
>>
>>
>>
[B441]
MTUPD: << DUP 'MTBL' STO+ SCUPD
>>
[3E44]
SCUPD: << 'SCORE' STO+
>>
[760]
GTML: << DUP SIGN SWAP ABS -> col pce
<< [1 3.25 3.5 5 9 120 ] pce
IFERR GET
THEN DROP2 0
ELSE col *
END
>>
>>
[7C24]
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
>>
>>
>>
>>
[3D58]
CPMV: << MAXR -1 SEARCH DROP "My move" 3 DIS DUP2 SHOWMV MKMV ERRBELL
>>
[A946]
GETMV: << -> n
<< n GET SWAP n GET SWAP
>>
>>
[BB18]
SCOREMV:<< "PLY = " PLY ->STR + "." + SWAP ->STR + 3 DIS
IF PLY 2 ==
THEN DROP2 SCORE
ELSE NEG SEARCH ROT ROT DROP2
END
>>
[8F08]
SHOWMV: << C->R UNCVT SWAP UNCVT SWAP + 4 DIS DROP
>>
[106B]
SEARCH: << 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
IF PLY 1 SAME
THEN DUP2 SHOWMV
END 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 l2 col n SCOREMV
IF PLY 1 SAME
THEN DUP ->STR "mv sc " SWAP + 2 DIS
END
IF DUP l1 c1 EVAL
THEN 8 CF
IF DUP l2 c2 EVAL
THEN 'l2' STO DUP2 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-
>>
[322]
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
>>
>>
>>
[5CF9]
UNCVT: << 10 / DUP IP 1 - ->STR SWAP FP 10 * "ABCDEFGH" SWAP DUP SUB SWAP +
>>
[4BED]
COORDS: << 10 / DUP IP 1 - SWAP FP 10 * R->C
>>
[D97D]
RD2: << 100 * IP 100 /
>>
[16DD]
PLAY: << STBRD STR-> 'BRD' STO
"0'PLY'0'MTBL'0'EPSNT'0'SCORE'25'PKNG'95'CKNG'1 6" STR->
START STO
NEXT "1 3 4 5 1 4" STR->
START CF
NEXT
DO " " 'INP' STO DRWB MOVE
UNTIL 1 FS?
END
"{PLY BRD INP MTBL SCORE PKNG CKNG EPSNT}" STR-> PURGE
>>
[482E]