Chess player: Difference between revisions
(→{{libheader|python-chess}}: try to avoid mate in one) |
|||
Line 1,015: | Line 1,015: | ||
for yourmove in board.legal_moves: |
for yourmove in board.legal_moves: |
||
board.push(yourmove) |
board.push(yourmove) |
||
if board.result() == "1-0": # Has White won? If so, avoid move. |
|||
board.pop() |
|||
moves[mymove] = -1000 |
|||
break |
|||
v = Counter(board.fen().split()[0]) |
v = Counter(board.fen().split()[0]) |
||
p = (9 * (v['q']-v['Q']) + 5 * (v['r']-v['R']) + 3 * (v['b']-v['B']) |
p = (9 * (v['q']-v['Q']) + 5 * (v['r']-v['R']) + 3 * (v['b']-v['B']) |
Revision as of 13:34, 10 May 2022
In the early times, chess used to be the prime example of artificial intelligence. Nowadays, some chess programs can beat a human master, and simple implementations can be written in a few pages of code.
Write a program which plays chess against a human player.
No need for graphics -- a textual user interface is sufficient.
Rather than implementing a complete monolithic program, you may wish to tackle one of the simpler sub-tasks:
- Chess player/Move generation
- Chess player/Search and evaluation
- Chess player/Program options and user interface
or use those components as part of a complete program, demonstrating your language's support for modularity.
BASIC
El código es de Dean Menezes
Encontrado en: http://www.petesqbsite.com/sections/express/issue23/Tut_QB_Chess.txt <lang qbasic>DEFINT A-Z
DECLARE SUB SQUARE (A, B, C) DECLARE SUB SHOWMAN (A, B, FLAG) DECLARE SUB SHOWBD () DECLARE SUB IO (A, B, X, Y, RESULT) DECLARE FUNCTION INCHECK (X) DECLARE SUB MAKEMOVE (A, B, X, Y) DECLARE SUB KNIGHT (A, B, XX(), YY(), NDX) DECLARE SUB KING (A, B, XX(), YY(), NDX) DECLARE SUB QUEEN (A, B, XX(), YY(), NDX) DECLARE SUB ROOK (A, B, XX(), YY(), NDX) DECLARE SUB BISHOP (A, B, XX(), YY(), NDX) DECLARE SUB MOVELIST (A, B, XX(), YY(), NDX) DECLARE SUB PAWN (A, B, XX(), YY(), NDX) DECLARE FUNCTION EVALUATE (ID, PRUNE)
DIM SHARED BOARD(0 TO 7, 0 TO 7) DIM SHARED BESTA(0 TO 7), BESTB(0 TO 7), BESTX(0 TO 7), BESTY(0 TO 7) DIM SHARED LEVEL, MAXLEVEL, SCORE, CFLAG CFLAG = 0 LEVEL = 0 MAXLEVEL = 5
DATA -500,-270,-300,-900,-7500,-300,-270,-500 DATA -100,-100,-100,-100, -100,-100,-100,-100 DATA 0, 0, 0, 0, 0, 0, 0, 0 DATA 0, 0, 0, 0, 0, 0, 0, 0 DATA 0, 0, 0, 0, 0, 0, 0, 0 DATA 0, 0, 0, 0, 0, 0, 0, 0 DATA 100, 100, 100, 100, 100, 100, 100, 100 DATA 500, 270, 300, 900, 5000, 300, 270, 500 FOR X = 0 TO 7
FOR Y = 0 TO 7 READ Z BOARD(X, Y) = Z NEXT Y
NEXT X
A = -1 RESULT = 0
DO
SCORE = 0 CALL IO(A, B, X, Y, RESULT) CLS CALL SHOWBD RESULT = EVALUATE(-1, 10000) A = BESTA(1) B = BESTB(1) X = BESTX(1) Y = BESTY(1)
LOOP end
SUB BISHOP (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A)) FOR DXY = 1 TO 7 X = A - DXY Y = B + DXY IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR GOSUB 3 IF BOARD(Y, X) THEN EXIT FOR NEXT FOR DXY = 1 TO 7 X = A + DXY Y = B + DXY IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR GOSUB 3 IF BOARD(Y, X) THEN EXIT FOR NEXT FOR DXY = 1 TO 7 X = A - DXY Y = B - DXY IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR GOSUB 3 IF BOARD(Y, X) THEN EXIT FOR NEXT FOR DXY = 1 TO 7 X = A + DXY Y = B - DXY IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR GOSUB 3 IF BOARD(Y, X) THEN EXIT FOR NEXT EXIT SUB
3 REM
IF ID <> SGN(BOARD(Y, X)) THEN NDX = NDX + 1 XX(NDX) = X YY(NDX) = Y END IF RETURN
END SUB
FUNCTION EVALUATE (ID, PRUNE)
DIM XX(0 TO 26), YY(0 TO 26) LEVEL = LEVEL + 1 BESTSCORE = 10000 * ID FOR B = 7 TO 0 STEP -1 FOR A = 7 TO 0 STEP -1 IF SGN(BOARD(B, A)) <> ID THEN GOTO 1 IF (LEVEL = 1) THEN CALL SHOWMAN(A, B, 8) CALL MOVELIST(A, B, XX(), YY(), NDX) FOR I = 0 TO NDX X = XX(I) Y = YY(I) IF LEVEL = 1 THEN LOCATE 1, 1 PRINT "TRYING: "; CHR$(65 + A); 8 - B; "- "; CHR$(65 + X); 8 - Y CALL SHOWMAN(X, Y, 8) END IF OLDSCORE = SCORE MOVER = BOARD(B, A) TARGET = BOARD(Y, X) CALL MAKEMOVE(A, B, X, Y) IF (LEVEL < MAXLEVEL) THEN SCORE = SCORE + EVALUATE(-ID, BESTSCORE - TARGET + ID * (8 - ABS(4 - X) - ABS(4 - Y))) SCORE = SCORE + TARGET - ID * (8 - ABS(4 - X) - ABS(4 - Y)) IF (ID < 0 AND SCORE > BESTSCORE) OR (ID > 0 AND SCORE < BESTSCORE) THEN BESTA(LEVEL) = A BESTB(LEVEL) = B BESTX(LEVEL) = X BESTY(LEVEL) = Y BESTSCORE = SCORE IF (ID < 0 AND BESTSCORE >= PRUNE) OR (ID > 0 AND BESTSCORE <= PRUNE) THEN BOARD(B, A) = MOVER BOARD(Y, X) = TARGET SCORE = OLDSCORE IF (LEVEL = 1) THEN CALL SHOWMAN(X, Y, 0) IF (LEVEL = 1) THEN CALL SHOWMAN(A, B, 0) LEVEL = LEVEL - 1 EVALUATE = BESTSCORE EXIT FUNCTION END IF END IF BOARD(B, A) = MOVER BOARD(Y, X) = TARGET SCORE = OLDSCORE IF (LEVEL = 1) THEN CALL SHOWMAN(X, Y, 0) NEXT
1
IF (LEVEL = 1) THEN CALL SHOWMAN(A, B, 0) NEXT NEXT LEVEL = LEVEL - 1 EVALUATE = BESTSCORE
END FUNCTION
FUNCTION INCHECK (X)
DIM XX(27), YY(27), NDX FOR B = 0 TO 7 FOR A = 0 TO 7 IF BOARD(B, A) >= 0 THEN GOTO 6 CALL MOVELIST(A, B, XX(), YY(), NDX) FOR I = 0 TO NDX STEP 1 X = XX(I) Y = YY(I) IF BOARD(Y, X) = 5000 THEN PRINT "YOU ARE IN CHECK!" PRINT " " PRINT " " INCHECK = 1 EXIT FUNCTION END IF NEXT
6 '
NEXT NEXT INCHECK = 0
END FUNCTION
SUB IO (A, B, X, Y, RESULT)
DIM XX(0 TO 26), YY(0 TO 26) CLS IF A >= 0 THEN IF RESULT < -2500 THEN PRINT "I RESIGN" SLEEP SYSTEM END IF PIECE = BOARD(Y, X) CALL MAKEMOVE(A, B, X, Y) PRINT "MY MOVE: "; CHR$(65 + A); 8 - B; "- "; CHR$(65 + X); 8 - Y IF PIECE THEN PRINT "I TOOK YOUR "; IF PIECE = 100 THEN PRINT "PAWN" IF PIECE = 270 THEN PRINT "KNIGHT" IF PIECE = 300 THEN PRINT "BISHOP" IF PIECE = 500 THEN PRINT "ROOK" IF PIECE = 900 THEN PRINT "QUEEN" IF PIECE = 5000 THEN PRINT "KING" END IF NULL = INCHECK(0) END IF DO CALL SHOWBD LOCATE 24, 1 INPUT "YOUR MOVE: ", IN$ IF UCASE$(IN$) = "QUIT" THEN CLS : END IF UCASE$(IN$) = "O-O" OR IN$ = "0-0" THEN IF CFLAG THEN GOTO 16 IF BOARD(7, 7) <> 500 THEN GOTO 16 IF BOARD(7, 6) OR BOARD(7, 5) THEN GOTO 16 BOARD(7, 6) = 5000 BOARD(7, 4) = 0 BOARD(7, 5) = 500 BOARD(7, 7) = 0 CFLAG = 1 EXIT SUB END IF IF UCASE$(IN$) = "O-O-O" OR IN$ = "0-0-0" THEN IF CFLAG THEN GOTO 16 IF BOARD(7, 0) <> 500 THEN GOTO 16 IF BOARD(7, 1) OR BOARD(7, 2) OR BOARD(7, 3) THEN GOTO 16 BOARD(7, 2) = 5000 BOARD(7, 4) = 0 BOARD(7, 3) = 500 BOARD(7, 0) = 0 CFLAG = 1 EXIT SUB END IF IF LEN(IN$) < 5 THEN GOTO 16 B = 8 - (ASC(MID$(IN$, 2, 1)) - 48) A = ASC(UCASE$(MID$(IN$, 1, 1))) - 65 X = ASC(UCASE$(MID$(IN$, 4, 1))) - 65 Y = 8 - (ASC(MID$(IN$, 5, 1)) - 48) IF B > 7 OR B < 0 OR A > 7 OR A < 0 OR X > 7 OR X < 0 OR Y > 7 OR Y < 0 THEN GOTO 16 IF BOARD(B, A) <= 0 THEN GOTO 16 CALL MOVELIST(A, B, XX(), YY(), NDX) FOR K = 0 TO NDX STEP 1 IF X = XX(K) AND Y = YY(K) THEN MOVER = BOARD(B, A) TARGET = BOARD(Y, X) CALL MAKEMOVE(A, B, X, Y) LOCATE 1, 1 IF INCHECK(0) = 0 THEN EXIT SUB BOARD(B, A) = MOVER BOARD(Y, X) = TARGET GOTO 16 END IF NEXT
16 ' CLS
LOOP
END SUB
SUB KING (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A)) FOR DY = -1 TO 1 IF B + DY < 0 OR B + DY > 7 THEN GOTO 12 FOR DX = -1 TO 1 IF A + DX < 0 OR A + DX > 7 THEN GOTO 11 IF ID <> SGN(BOARD(B + DY, A + DX)) THEN NDX = NDX + 1 XX(NDX) = A + DX YY(NDX) = B + DY END IF
11 '
NEXT
12 '
NEXT
END SUB
SUB KNIGHT (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A)) X = A - 1 Y = B - 2 GOSUB 5 X = A - 2 Y = B - 1 GOSUB 5 X = A + 1 Y = B - 2 GOSUB 5 X = A + 2 Y = B - 1 GOSUB 5 X = A - 1 Y = B + 2 GOSUB 5 X = A - 2 Y = B + 1 GOSUB 5 X = A + 1 Y = B + 2 GOSUB 5 X = A + 2 Y = B + 1 GOSUB 5 EXIT SUB
5 '
IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN RETURN IF ID <> SGN(BOARD(Y, X)) THEN NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y RETURN
END SUB
SUB MAKEMOVE (A, B, X, Y)
BOARD(Y, X) = BOARD(B, A) BOARD(B, A) = 0 IF Y = 0 AND BOARD(Y, X) = 100 THEN BOARD(Y, X) = 900 IF Y = 7 AND BOARD(Y, X) = -100 THEN BOARD(Y, X) = -900
END SUB
SUB MOVELIST (A, B, XX(), YY(), NDX)
PIECE = INT(ABS(BOARD(B, A))) NDX = -1 IF PIECE = 100 THEN CALL PAWN(A, B, XX(), YY(), NDX) ELSEIF PIECE = 270 THEN CALL KNIGHT(A, B, XX(), YY(), NDX) ELSEIF PIECE = 300 THEN CALL BISHOP(A, B, XX(), YY(), NDX) ELSEIF PIECE = 500 THEN CALL ROOK(A, B, XX(), YY(), NDX) ELSEIF PIECE = 900 THEN CALL QUEEN(A, B, XX(), YY(), NDX) ELSE CALL KING(A, B, XX(), YY(), NDX) END IF
END SUB
SUB PAWN (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A)) IF (A - 1) >= 0 AND (A - 1) <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN IF SGN(BOARD((B - ID), (A - 1))) = -ID THEN NDX = NDX + 1 XX(NDX) = A - 1 YY(NDX) = B - ID END IF END IF IF (A + 1) >= 0 AND (A + 1) <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN IF SGN(BOARD((B - ID), (A + 1))) = -ID THEN NDX = NDX + 1 XX(NDX) = A + 1 YY(NDX) = B - ID END IF END IF IF A >= 0 AND A <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN IF BOARD((B - ID), A) = 0 THEN NDX = NDX + 1 XX(NDX) = A YY(NDX) = B - ID IF (ID < 0 AND B = 1) OR (ID > 0 AND B = 6) THEN IF BOARD((B - ID - ID), A) = 0 THEN NDX = NDX + 1 XX(NDX) = A YY(NDX) = B - 2 * ID END IF END IF END IF END IF
END SUB
SUB QUEEN (A, B, XX(), YY(), NDX)
CALL BISHOP(A, B, XX(), YY(), NDX) CALL ROOK(A, B, XX(), YY(), NDX)
END SUB
SUB ROOK (A, B, XX(), YY(), NDX)
ID = SGN(BOARD(B, A)) FOR X = A - 1 TO 0 STEP -1 IF ID <> SGN(BOARD(B, X)) THEN NDX = NDX + 1 XX(NDX) = X YY(NDX) = B END IF IF (BOARD(B, X)) THEN EXIT FOR NEXT FOR X = A + 1 TO 7 STEP 1 IF ID <> SGN(BOARD(B, X)) THEN NDX = NDX + 1 XX(NDX) = X YY(NDX) = B END IF IF (BOARD(B, X)) THEN EXIT FOR NEXT FOR Y = B - 1 TO 0 STEP -1 IF ID <> SGN(BOARD(Y, A)) THEN NDX = NDX + 1 XX(NDX) = A YY(NDX) = Y END IF IF (BOARD(Y, A)) THEN EXIT FOR NEXT FOR Y = B + 1 TO 7 STEP 1 IF ID <> SGN(BOARD(Y, A)) THEN NDX = NDX + 1 XX(NDX) = A YY(NDX) = Y END IF IF (BOARD(Y, A)) THEN EXIT FOR NEXT
END SUB
SUB SHOWBD
LOCATE 3, 30 COLOR 7, 0 PRINT "A B C D E F G H" FOR K = 0 TO 25 LOCATE 4, 28 + K COLOR 6, 0 PRINT CHR$(220) NEXT FOR B = 0 TO 7 LOCATE 2 * B + 5, 26 COLOR 7, 0 PRINT CHR$(56 - B) LOCATE 2 * B + 5, 28 COLOR 6, 0 PRINT CHR$(219) LOCATE 2 * B + 6, 28 COLOR 6, 0 PRINT CHR$(219) FOR A = 0 TO 7 IF ((A + B) MOD 2) THEN COLOUR = 8 ELSE COLOUR = 12 END IF CALL SQUARE(3 * A + 31, 2 * B + 5, COLOUR) NEXT LOCATE 2 * B + 5, 53 COLOR 6, 0 PRINT CHR$(219) LOCATE 2 * B + 6, 53 COLOR 6, 0 PRINT CHR$(219) LOCATE 2 * B + 6, 55 COLOR 7, 0 PRINT CHR$(56 - B) NEXT FOR K = 0 TO 25 LOCATE 21, 28 + K COLOR 6, 0 PRINT CHR$(223) NEXT LOCATE 22, 30 COLOR 7, 0 PRINT "A B C D E F G H" FOR B = 0 TO 7 FOR A = 0 TO 7 CALL SHOWMAN(A, B, 0) NEXT NEXT COLOR 7, 0
END SUB
SUB SHOWMAN (A, B, FLAG)
IF BOARD(B, A) < 0 THEN BACK = 0 IF BOARD(B, A) > 0 THEN BACK = 7 FORE = 7 - BACK + FLAG IF BOARD(B, A) = 0 THEN IF (A + B) AND 1 THEN BACK = 8 ELSE BACK = 12 FORE = BACK + -1 * (FLAG > 0) END IF N$ = " " PIECE = INT(ABS(BOARD(B, A))) IF PIECE = 0 THEN N$ = CHR$(219) IF PIECE = 100 THEN N$ = "P" IF PIECE = 270 THEN N$ = "N" IF PIECE = 300 THEN N$ = "B" IF PIECE = 500 THEN N$ = "R" IF PIECE = 900 THEN N$ = "Q" IF PIECE = 5000 OR PIECE = 7500 THEN N$ = "K" LOCATE 2 * B + 5 - (BOARD(B, A) > 0), 3 * A + 30 COLOR FORE, BACK PRINT N$ LOCATE 1, 1 COLOR 7, 0
END SUB
SUB SQUARE (A, B, C)
MT$ = CHR$(219) MT$ = MT$ + MT$ + MT$ LOCATE B, A - 2 COLOR C, C PRINT MT$ LOCATE B + 1, A - 2 COLOR C, C PRINT MT$ COLOR 7, 0
END SUB</lang>
Go
There are a number of open source Chess programs written in Go on Github.
Rather than spend a lot of time trying to write my own (likely mediocre) program, I thought I'd simply post a link to notnil/chess which explains its various capabilities quite well. However, you need to look at the code itself to see that it can cope with all types of move including castling, en passant capture and promotion to a piece of the player's choice.
Perl
Primarily written to see if I could find all moves with one regex. The answer was "mostly", the main problem being some moves require history (the current state of the board is not sufficient for castling and en passant). I also wanted to try different methods of making moves. It does not play well, but then neither do I. <lang perl>#!/usr/bin/perl
use strict; use warnings; use Tk; use Tk::ROText; use List::Util qw( any sum0 shuffle first );
my $startingposition = our $board = <<END; rnbqkbnr pppppppp
PPPPPPPP RNBQKBNR END
my $size = 80; my $message = 'Initializing...'; my ($from, $moving, $over); my (%legal, %canmove, @previous, $castleleft, $castleright, $enpassant); my @location = map { my $row = $_; map "$_$row", 'a' .. 'i' } reverse 1 .. 8; my %values = qw( - 0 p 100 n 350 b 350 r 525 q 1e3 k 1e4); my %names = qw(p pawn r rook n knight b bishop q queen k king); our @moves;
my $g = qr/.{8}/s; my $gm = qr/.{9}/s; my $gp = qr/.{7}/s; my $gpp = qr/.{6}/s;
my $opp = qr/[a-z]/; my $oppe = qr/[a-z-]/; my $whitemoves = qr/(?|
(?| # forward (Q|R) (?: -* | $g (?:- $g)* ) ($oppe) # rectangular | (Q|B) (?: $gp (?:- $gp)* | $gm (?:- $gm)* ) ($oppe) # diagonal | (K) (?: | $gp | $g | $gm ) ($oppe) | (N) (?: $gm . $g | $gp . $g | . $gm | $gpp (?=..) ) ($oppe) ) (?{ push @moves, [$1, @-[1,2], $2] }) | (?| # backward ($oppe) (?: -* | $g (?:- $g)* ) (Q|R) # rectangular | ($oppe) (?: $gp (?:- $gp)* | $gm (?:- $gm)* ) (Q|B) # diagonal | ($oppe) (?: | $gp | $g | $gm ) (K) | ($oppe) (?: $gm . $g | $gp . $g | . $gm | $gpp (?=..) ) (N) | (-) $g (P) | ($opp) (?: $gm | $gp ) (P) ) (?{ push @moves, [$2, @-[2,1], $1] }) | (-) $g (-) $g (P) .*\n.{8}$ (?{ push @moves, [$3, @-[3,1], $1, $-[2]] }) ) (*FAIL) /x;
$opp = qr/[A-Z]/; $oppe = qr/[A-Z-]/; my $blackmoves = qr/(?|
(?| # forward (q|r) (?: -* | $g (?:- $g)* ) ($oppe) # rectangular | (q|b) (?: $gp (?:- $gp)* | $gm (?:- $gm)* ) ($oppe) # diagonal | (k) (?: | $gp | $g | $gm ) ($oppe) | (n) (?: $gm . $g | $gp . $g | . $gm | $gpp (?=..) ) ($oppe) | (p) $g (-) | (p) (?: $gm | $gp ) ($opp) ) (?{ push @moves, [$1, @-[1,2], $2] }) | ^.{8}\n.* (p) $g (-) $g (-) (?{ push @moves, [$1, @-[1,3], $3, $-[2]] }) | (?| # backward ($oppe) (?: -* | $g (?:- $g)* ) (q|r) # rectangular | ($oppe) (?: $gp (?:- $gp)* | $gm (?:- $gm)* ) (q|b) # diagonal | ($oppe) (?: | $gp | $g | $gm ) (k) | ($oppe) (?: $gm . $g | $gp . $g | . $gm | $gpp (?=..) ) (n) ) (?{ push @moves, [$2, @-[2,1], $1] }) ) (*FAIL) /x;
my $mw = MainWindow->new; $mw->title( 'Chess' ); my $label = $mw->Label( -textvariable => \$message, -font => 'times 20',
)->pack(-fill => 'x');
$mw->Frame(-height => 20, -bg => 'darkblue',
)->pack(-fill => 'x', -expand => 1);
my $grid = $mw->Frame->pack; my @squares = map { my $me = $_; $_ % 9 == 8 ? 'oops' :
do { my $w = $grid->Canvas( -width => $size, -height => $size, -bd => 0, -relief => 'flat', -highlightthickness => 0, -bg => ($_ % 9 + int $_ / 9) % 2 ? 'brown3' : 'brown2', )->grid( -row => 1 + int $_ / 9, -column => 1 + $_ % 9 ); $w->Tk::bind('<ButtonRelease-4>' => sub{$w->yviewMoveto(0)} ); $w->Tk::bind('<ButtonRelease-5>' => sub{$w->yviewMoveto(0)} ); $w->Tk::bind('<1>' => sub { click($me) } ); $w } } 0 .. 71;
for my $n (0 .. 7)
{ $grid->Label(-text => $n + 1, )->grid( -row => 8 - $n, -column => $_) for 0, 9; $grid->Label(-text => ('a' ... 'h')[$n], )->grid( -row => $_, -column => 1 + $n) for 0, 9; }
$mw->Frame(-height => 20, -bg => 'darkblue',
)->pack(-fill => 'x', -expand => 1);
$mw->Button(-text => $_->[0], -command => $_->[1], -font => 24,
)->pack( -side => 'left', -fill => 'x', -expand => 1) for [Restart => \&restart], ['Previous State' => \&previous], ['Random Move' => \&random], [Help => \&help], [Exit => sub {$mw->destroy}];
restart();
MainLoop; -M $0 < 0 and exec $0, @ARGV;
sub restart
{ $from = $over = undef; $enpassant = -1; $castleleft = $castleright = 1; @previous = [ ($board = $startingposition), $castleleft, $castleright, $enpassant ]; show( $board ); $message = (incheck($board, 1) && "** IN CHECK ** ") . 'White to move'; $label->configure(-bg => 'gray85'); $label->configure(-fg => 'black'); findlegal(); }
sub previous
{ $over and $mw->bell, return; @previous and ($board, $castleleft, $castleright, $enpassant) = @{ pop @previous }; show($board); findlegal(); }
sub random
{ $over || keys %legal == 0 and $mw->bell, return; ($from, my $to) = split ' ', (keys %legal)[rand keys %legal];
- ($from, my $to) = map @$_,
- (sort { $values{substr $board, $b->[1], 1} <=>
- $values{substr $board, $a->[1], 1} }
- map [ split ],
- shuffle keys %legal)[0];
$moving = substr $board, $from, 1; click($to); }
sub click
{ $over and $mw->bell, return; my $pos = shift; my $piece = substr $board, $pos, 1; if( defined $from ) { if( $piece eq 'R' and $legal{"$from $pos"} and $from == 67 and $pos == 63 || $pos == 70 ) # castle { push @previous, [ $board, $castleleft, $castleright, $enpassant ]; $pos == 63 ? $board =~ s/R---K/--KR-/ : $board =~ s/K--R/-RK-/; $castleright = $castleleft = 0; playblack(); } elsif( $pos == $enpassant and $piece eq '-' and $from == $enpassant + 8 and substr($board, $from, 1) eq 'P' ) { substr($board, $enpassant, 10) =~ s/-(.{7})Pp/P$1--/s or die "enpassant"; $enpassant = -1; playblack(); } elsif( $pos == $enpassant and $piece eq '-' and $from == $enpassant + 10 and substr($board, $from, 1) eq 'P' ) { substr($board, $enpassant, 11) =~ s/-(.{8})pP/P$1--/s or die "enpassant"; $enpassant = -1; playblack(); } elsif( $piece =~ /[a-z-]/ and $legal{"$from $pos"} ) { push @previous, [ $board, $castleleft, $castleright, $enpassant ]; substr $board, $from, 1, '-'; substr $board, $pos, 1, $moving; 1 while $board =~ s/^.*\KP/Q/; # promotion $board =~ s/p(?=.*$)/q/g; # promotion $from == 67 and $castleleft = $castleright = 0; # no castle king $from == 63 and $castleleft = 0; # left rook $from == 70 and $castleright = 0; # right rook playblack(); } else { $mw->bell } $from = $piece = undef; if( not $over ) { $message = 'White to move'; $label->configure(-bg => 'gray85'); findlegal(); if( ! $over and incheck($board, 1) ) { $message =~ s/^/** IN CHECK ** /; $label->configure(-bg => 'yellow'); } } show($board); } elsif( $piece =~ /[A-Z]/ and $canmove{$pos} ) { $from = $pos; $moving = $piece; $message = "White moving $names{lc $moving} from $location[$from]"; $squares[$from]->itemconfigure('all', -fill => 'yellow'); } else { $piece =~ /[A-Z]/ and $mw->bell; $from = $piece = undef; findlegal(); $message = 'White to move'; show($board); } }
sub scale { map $size * $_ >> 3, @_ };
sub show
{ while( $board =~ /./g ) { my $c = $squares[ my $pos = $-[0] ]; my $char = uc $&; my $color = $& =~ /[A-Z]/ ? 'white' : 'black'; $c->delete('all'); if( $char eq 'P' ) { $c->createOval(scale(3, 3, 5, 5)); $c->createArc(scale(2, 4.8, 6, 9), -start => 0, -extent => 180); $c->itemconfigure('all', -outline => undef); } elsif( $char eq 'N' ) { $c->createPolygon( scale(2, 7, 1, 4, 3, 1, 7, 4, 6, 5, 4, 4, 5.5, 7)); } elsif( $char eq 'K' ) { $c->createPolygon( scale(1, 7, 3.5, 4, 3.5, 3, 2.5, 3, 2.5, 2, 3.5, 2, 3.5, 1, 4.5, 1, 4.5, 2, 5.5, 2, 5.5, 3, 4.5, 3, 4.5, 4, 7, 7)); $c->createArc( scale(1, 4, 4, 10), -start => 60, -extent => 120, -outline => undef); $c->createArc( scale(4, 4, 7, 10), -start => 0, -extent => 120, -outline => undef); } elsif( $char eq 'Q' ) { $c->createPolygon( scale(2, 7, 1, 2, 3, 5, 4, 1, 5, 5, 7, 2, 6, 7)); } elsif( $char eq 'R' ) { $c->createPolygon( scale(1, 7, 2, 3, 1, 3, 1, 1, 2, 1, 2, 2, 3, 2, 3, 1, 5, 1, 5, 2, 6, 2, 6, 1, 7, 1, 7, 3, 6, 3, 7, 7)); } elsif( $char eq 'B' ) { $c->createPolygon(scale(3, 7, 2, 6, 4, 1, 6, 6, 5, 7)); $c->createOval(scale(3.5, 1, 4.5, 2), -outline => undef); } $c->itemconfigure('all', -fill => $color); } }
sub newboard
{ my ($piece, $from, $to, $was) = @{ +shift }; my $newboard = $board; substr $newboard, $from, 1, '-'; substr $newboard, $to, 1, $piece; $newboard; }
sub incheck # board, 1=whiteincheck 0=blackincheck
{ my ($newboard, $who) = @_; local @moves; $newboard =~ ( $who ? $blackmoves : $whitemoves ); any { $_->[3] =~ /k/i } @moves; }
sub blink
{ my $pos = shift; $message = 'Black moving...'; for ( ('green', 'red') x 2 ) { $squares[$pos]->itemconfigure('all', -fill => $_); $mw->update; select undef, undef, undef, 0.1; } }
sub findlegal
{ local @moves; $board =~ $whitemoves; %legal = %canmove = (); $legal{ $_->[1] . ' ' . $_->[2] } = $canmove{$_->[1]} = 1 for grep { ! incheck(newboard($_), 1) } @moves; @moves = (); if( $castleleft and $board =~ /R---K...\n\z/ ) { $board =~ $blackmoves; my $attack = any { $_->[2] =~ /6[567]/ } @moves; $attack or $legal{"67 63"} = $canmove{67} = 1; } if( $castleright and $board =~ /K--R\n\z/ ) { @moves or $board =~ $blackmoves; my $attack = any { $_->[2] =~ /6[789]/ } @moves; $attack or $legal{"67 70"} = $canmove{67} = 1; } if( $enpassant > 0 ) { substr($board, $enpassant + $_, 1) eq 'P' and $legal{$enpassant + $_ . " $enpassant"} = $canmove{$enpassant + $_} = 1 for 8, 10; } if( not %legal ) { $over = 1; $message = incheck($board, 1) ? "CHECKMATE" : "DRAW"; $label->configure(-bg => 'red'); $label->configure(-fg => 'white'); } }
sub islegal { $legal{"@_"} }
sub score
{ my $bb = newboard(shift); sum0 map(-$values{+lc}, $bb =~ /[A-Z]/g), map $values{$_}, $bb =~ /[a-z]/g; }
sub lookahead
{ my $bb = shift; local @moves; $bb =~ $blackmoves;
- print "black moves : " . @moves, "\n";
my @bbest; for my $bmove ( @moves ) { my $freedom; local $board = newboard($bmove); local @moves; $board =~ $whitemoves; $freedom = @moves; my @wbest; for my $wmove ( @moves ) { local $board = newboard($wmove); local @moves; $board =~ $blackmoves; my @bbest2; for my $bmove2 ( @moves ) { push @bbest2, [ $bmove, score($bmove2), $freedom ]; } push @wbest, first { not incheck( newboard($wmove, 0) ) } sort { $b->[1] <=> $a->[1] } shuffle @bbest2; } push @bbest, first { not incheck( newboard($bmove, 1) ) } sort { $a->[1] <=> $b->[1] } grep defined $_->[1], shuffle @wbest; } map $_->[0], sort { $b->[1] <=> $a->[1] or $b->[2] <=> $a->[2] } grep defined $_->[1], shuffle @bbest; }
sub playblack
{ show($board); $message = 'Black thinking...'; $label->configure(-bg => 'gray85'); $mw->update; @moves = lookahead($board); my $themove = first { ! incheck(newboard($_), 0) } @moves; if( not $themove ) { $over = 1; $message = incheck( $board, 0 ) ? "CHECKMATE" : "DRAW"; $label->configure(-bg => 'red'); $label->configure(-fg => 'white'); return; } blink( $themove->[1] ); $board = newboard $themove; $enpassant = $themove->[4] // -1; 1 while $board =~ s/^.*\KP/Q/; $board =~ s/p(?=.*$)/q/g; show($board); }
sub help
{ my $help = $mw->Toplevel; $help->title("Chess Help"); my $ro = $help->ROText( -font => 'times 14', -height => 12, -width => 60, )->pack; $help->Button(-text => 'Dismiss', -command => sub {$help->destroy}, )->pack(-fill => 'x'); $ro->insert(end => <<END);
You are playing White, the program is playing Black.
To move or capture : left click on piece to move,
it should turn yellow if a legal move for that piece exists, then left click on the destination square.
To castle : left click on the King, then left click on a Rook.
To capture "en passant" : left click on your Pawn,
then left click on the square the opponent's Pawn skipped over.
END
}</lang>
Phix
Version 0.8.1+ contains demo\rosetta\chess.exw, a slightly cleaned-up copy of a 20-year old translation of TSCP.
It isn't particularly good (though perhaps a reasonable starting point for something better), at over 1,600 lines it does not really bear any useful comparison to the lisp version, and is simply not worth posting on this site, especially in light of potential copyright issues.
PicoLisp
This implementation supports all chess rules (including castling, pawn promotion and en passant), switching sides, unlimited undo/redo, and the setup, saving and loading of board positions to/from files.
# *Board a1 .. h8
# *White *Black *WKPos *BKPos *Pinned
# *Depth *Moved *Undo *Redo *Me *You
(load "@lib/simul.l")
### Fields/Board ###
# x y color piece whAtt blAtt
(setq *Board (grid 8 8))
(for (X . Lst) *Board
(for (Y . This) Lst
(=: x X)
(=: y Y)
(=: color (not (bit? 1 (+ X Y)))) ) )
(de *Straight `west `east `south `north)
(de *Diagonal
((This) (: 0 1 1 0 -1 1)) # Southwest
((This) (: 0 1 1 0 -1 -1)) # Northwest
((This) (: 0 1 -1 0 -1 1)) # Southeast
((This) (: 0 1 -1 0 -1 -1)) ) # Northeast
(de *DiaStraight
((This) (: 0 1 1 0 -1 1 0 -1 1)) # South Southwest
((This) (: 0 1 1 0 -1 1 0 1 1)) # West Southwest
((This) (: 0 1 1 0 -1 -1 0 1 1)) # West Northwest
((This) (: 0 1 1 0 -1 -1 0 -1 -1)) # North Northwest
((This) (: 0 1 -1 0 -1 -1 0 -1 -1)) # North Northeast
((This) (: 0 1 -1 0 -1 -1 0 1 -1)) # East Northeast
((This) (: 0 1 -1 0 -1 1 0 1 -1)) # East Southeast
((This) (: 0 1 -1 0 -1 1 0 -1 1)) ) # South Southeast
### Pieces ###
(de piece (Typ Cnt Fld)
(prog1
(def
(pack (mapcar '((Cls) (cdr (chop Cls))) Typ))
Typ )
(init> @ Cnt Fld) ) )
(class +White)
# color ahead
(dm init> (Cnt Fld)
(=: ahead north)
(extra Cnt Fld) )
(dm name> ()
(pack " " (extra) " ") )
(dm move> (Fld)
(adjMove '*White '*WKPos whAtt- whAtt+) )
(class +Black)
# color ahead
(dm init> (Cnt Fld)
(=: color T)
(=: ahead south)
(extra Cnt Fld) )
(dm name> ()
(pack '< (extra) '>) )
(dm move> (Fld)
(adjMove '*Black '*BKPos blAtt- blAtt+) )
(class +piece)
# cnt field attacks
(dm init> (Cnt Fld)
(=: cnt Cnt)
(move> This Fld) )
(dm ctl> ())
(class +King +piece)
(dm name> () 'K)
(dm val> () 120)
(dm ctl> ()
(unless (=0 (: cnt)) -10) )
(dm moves> ()
(make
(unless
(or
(n0 (: cnt))
(get (: field) (if (: color) 'whAtt 'blAtt)) )
(tryCastle west T)
(tryCastle east) )
(try1Move *Straight)
(try1Move *Diagonal) ) )
(dm attacks> ()
(make
(try1Attack *Straight)
(try1Attack *Diagonal) ) )
(class +Castled)
(dm ctl> () 30)
(class +Queen +piece)
(dm name> () 'Q)
(dm val> () 90)
(dm moves> ()
(make
(tryMoves *Straight)
(tryMoves *Diagonal) ) )
(dm attacks> ()
(make
(tryAttacks *Straight)
(tryAttacks *Diagonal T) ) )
(class +Rook +piece)
(dm name> () 'R)
(dm val> () 47)
(dm moves> ()
(make (tryMoves *Straight)) )
(dm attacks> ()
(make (tryAttacks *Straight)) )
(class +Bishop +piece)
(dm name> () 'B)
(dm val> () 33)
(dm ctl> ()
(when (=0 (: cnt)) -10) )
(dm moves> ()
(make (tryMoves *Diagonal)) )
(dm attacks> ()
(make (tryAttacks *Diagonal T)) )
(class +Knight +piece)
(dm name> () 'N)
(dm val> () 28)
(dm ctl> ()
(when (=0 (: cnt)) -10) )
(dm moves> ()
(make (try1Move *DiaStraight)) )
(dm attacks> ()
(make (try1Attack *DiaStraight)) )
(class +Pawn +piece)
(dm name> () 'P)
(dm val> () 10)
(dm moves> ()
(let (Fld1 ((: ahead) (: field)) Fld2 ((: ahead) Fld1))
(make
(and
(tryPawnMove Fld1 Fld2)
(=0 (: cnt))
(tryPawnMove Fld2 T) )
(tryPawnCapt (west Fld1) Fld2 (west (: field)))
(tryPawnCapt (east Fld1) Fld2 (east (: field))) ) ) )
(dm attacks> ()
(let Fld ((: ahead) (: field))
(make
(and (west Fld) (link @))
(and (east Fld) (link @)) ) ) )
### Move Logic ###
(de inCheck (Color)
(if Color (get *BKPos 'whAtt) (get *WKPos 'blAtt)) )
(de whAtt+ (This Pce)
(=: whAtt (cons Pce (: whAtt))) )
(de whAtt- (This Pce)
(=: whAtt (delq Pce (: whAtt))) )
(de blAtt+ (This Pce)
(=: blAtt (cons Pce (: blAtt))) )
(de blAtt- (This Pce)
(=: blAtt (delq Pce (: blAtt))) )
(de adjMove (Var KPos Att- Att+)
(let (W (: field whAtt) B (: field blAtt))
(when (: field)
(put @ 'piece NIL)
(for F (: attacks) (Att- F This)) )
(nond
(Fld (set Var (delq This (val Var))))
((: field) (push Var This)) )
(ifn (=: field Fld)
(=: attacks)
(put Fld 'piece This)
(and (isa '+King This) (set KPos Fld))
(for F (=: attacks (attacks> This)) (Att+ F This)) )
(reAtttack W (: field whAtt) B (: field blAtt)) ) )
(de reAtttack (W W2 B B2)
(for This W
(unless (memq This W2)
(for F (: attacks) (whAtt- F This))
(for F (=: attacks (attacks> This)) (whAtt+ F This)) ) )
(for This W2
(for F (: attacks) (whAtt- F This))
(for F (=: attacks (attacks> This)) (whAtt+ F This)) )
(for This B
(unless (memq This B2)
(for F (: attacks) (blAtt- F This))
(for F (=: attacks (attacks> This)) (blAtt+ F This)) ) )
(for This B2
(for F (: attacks) (blAtt- F This))
(for F (=: attacks (attacks> This)) (blAtt+ F This)) ) )
(de try1Move (Lst)
(for Dir Lst
(let? Fld (Dir (: field))
(ifn (get Fld 'piece)
(link (list This (cons This Fld)))
(unless (== (: color) (get @ 'color))
(link
(list This
(cons (get Fld 'piece))
(cons This Fld) ) ) ) ) ) ) )
(de try1Attack (Lst)
(for Dir Lst
(and (Dir (: field)) (link @)) ) )
(de tryMoves (Lst)
(for Dir Lst
(let Fld (: field)
(loop
(NIL (setq Fld (Dir Fld)))
(T (get Fld 'piece)
(unless (== (: color) (get @ 'color))
(link
(list This
(cons (get Fld 'piece))
(cons This Fld) ) ) ) )
(link (list This (cons This Fld))) ) ) ) )
(de tryAttacks (Lst Diag)
(use (Pce Cls Fld2)
(for Dir Lst
(let Fld (: field)
(loop
(NIL (setq Fld (Dir Fld)))
(link Fld)
(T
(and
(setq Pce (get Fld 'piece))
(<> (: color) (get Pce 'color)) ) )
(T (== '+Pawn (setq Cls (last (type Pce))))
(and
Diag
(setq Fld2 (Dir Fld))
(= (get Fld2 'y) (get ((get Pce 'ahead) Fld) 'y))
(link Fld2) ) )
(T (memq Cls '(+Knight +Queen +King)))
(T (and Pce (xor Diag (== Cls '+Bishop)))) ) ) ) ) )
(de tryPawnMove (Fld Flg)
(unless (get Fld 'piece)
(if Flg
(link (list This (cons This Fld)))
(for Cls '(+Queen +Knight +Rook +Bishop)
(link
(list This
(cons This)
(cons
(piece (list (car (type This)) Cls) (: cnt))
Fld ) ) ) ) ) ) )
(de tryPawnCapt (Fld1 Flg Fld2)
(if (get Fld1 'piece)
(unless (== (: color) (get @ 'color))
(if Flg
(link
(list This
(cons (get Fld1 'piece))
(cons This Fld1) ) )
(for Cls '(+Queen +Knight +Rook +Bishop)
(link
(list This
(cons (get Fld1 'piece))
(cons This)
(cons
(piece (list (car (type This)) Cls) (: cnt))
Fld1 ) ) ) ) ) )
(let? Pce (get Fld2 'piece)
(and
(== Pce (car *Moved))
(= 1 (get Pce 'cnt))
(isa '+Pawn Pce)
(n== (: color) (get Pce 'color))
(link (list This (cons Pce) (cons This Fld1))) ) ) ) )
(de tryCastle (Dir Long)
(use (Fld1 Fld2 Fld Pce)
(or
(get (setq Fld1 (Dir (: field))) 'piece)
(get Fld1 (if (: color) 'whAtt 'blAtt))
(get (setq Fld2 (Dir Fld1) Fld Fld2) 'piece)
(when Long
(or
(get (setq Fld (Dir Fld)) 'piece)
(get Fld (if (: color) 'whAtt 'blAtt)) ) )
(and
(== '+Rook (last (type (setq Pce (get (Dir Fld) 'piece)))))
(=0 (get Pce 'cnt))
(link
(list This
(cons This)
(cons
(piece (cons (car (type This)) '(+Castled +King)) 1)
Fld2 )
(cons Pce Fld1) ) ) ) ) ) )
(de pinned (Fld Lst Color)
(use (Pce L P)
(and
(loop
(NIL (setq Fld (Dir Fld)))
(T (setq Pce (get Fld 'piece))
(and
(= Color (get Pce 'color))
(setq L
(make
(loop
(NIL (setq Fld (Dir Fld)))
(link Fld)
(T (setq P (get Fld 'piece))) ) ) )
(<> Color (get P 'color))
(memq (last (type P)) Lst)
(cons Pce L) ) ) )
(link @) ) ) )
### Moves ###
# Move ((p1 (p1 . f2)) . ((p1 . f1)))
# Capture ((p1 (p2) (p1 . f2)) . ((p1 . f1) (p2 . f2)))
# Castle ((K (K) (C . f2) (R . f4)) . ((R . f3) (K . f1)))
# Promote ((P (P) (Q . f2)) . ((Q) (P . f1)))
# Capt/Prom ((P (p1) (P) (Q . f2)) . ((Q) (P . f1) (p1 . f2)))
(de moves (Color)
(filter
'((Lst)
(prog2
(move (car Lst))
(not (inCheck Color))
(move (cdr Lst)) ) )
(mapcan
'((Pce)
(mapcar
'((Lst)
(cons Lst
(flip
(mapcar
'((Mov) (cons (car Mov) (get Mov 1 'field)))
(cdr Lst) ) ) ) )
(moves> Pce) ) )
(if Color *Black *White) ) ) )
(de move (Lst)
(if (atom (car Lst))
(inc (prop (push '*Moved (pop 'Lst)) 'cnt))
(dec (prop (pop '*Moved) 'cnt)) )
(for Mov Lst
(move> (car Mov) (cdr Mov)) ) )
### Evaluation ###
(de mate (Color)
(and (inCheck Color) (not (moves Color))) )
(de battle (Fld Prey Attacker Defender)
(use Pce
(loop
(NIL (setq Pce (mini 'val> Attacker)) 0)
(setq Attacker (delq Pce Attacker))
(NIL (and (asoq Pce *Pinned) (not (memq Fld @)))
(max 0 (- Prey (battle Fld (val> Pce) Defender Attacker))) ) ) ) )
# Ref. Sargon, Dan and Kate Spracklen, Hayden 1978
(de cost (Color)
(if (mate (not Color))
-9999
(setq *Pinned
(make
(for Dir *Straight
(pinned *WKPos '(+Rook +Queen))
(pinned *BKPos '(+Rook +Queen) T) )
(for Dir *Diagonal
(pinned *WKPos '(+Bishop +Queen))
(pinned *BKPos '(+Bishop +Queen) T) ) ) )
(let (Ctl 0 Mat 0 Lose 0 Win1 NIL Win2 NIL Flg NIL)
(use (White Black Col Same B)
(for Lst *Board
(for This Lst
(setq White (: whAtt) Black (: blAtt))
((if Color inc dec) 'Ctl (- (length White) (length Black)))
(let? Val (and (: piece) (val> @))
(setq Col (: piece color) Same (== Col Color))
((if Same dec inc) 'Ctl (ctl> (: piece)))
(unless
(=0
(setq B
(if Col
(battle This Val White Black)
(battle This Val Black White) ) ) )
(dec 'Val 5)
(if Same
(setq
Lose (max Lose B)
Flg (or Flg (== (: piece) (car *Moved))) )
(when (> B Win1)
(xchg 'B 'Win1)
(setq Win2 (max Win2 B)) ) ) )
((if Same dec inc) 'Mat Val) ) ) ) )
(unless (=0 Lose) (dec 'Lose 5))
(if Flg
(* 4 (+ Mat Lose))
(when Win2
(dec 'Lose (>> 1 (- Win2 5))) )
(+ Ctl (* 4 (+ Mat Lose))) ) ) ) )
### Game ###
(de display (Res)
(when Res
(disp *Board T
'((This)
(cond
((: piece) (name> @))
((: color) " - ")
(T " ") ) ) ) )
(and (inCheck *You) (prinl "(+)"))
Res )
(de moved? (Lst)
(or
(> 16 (length Lst))
(find '((This) (n0 (: cnt))) Lst) ) )
(de bookMove (From To)
(let Pce (get From 'piece)
(list 0 (list (list Pce (cons Pce To)) (cons Pce From))) ) )
(de myMove ()
(let? M
(cadr
(cond
((moved? (if *Me *Black *White))
(game *Me *Depth moves move cost) )
(*Me
(if (member (get *Moved 1 'field 'x) (1 2 3 5))
(bookMove 'e7 'e5)
(bookMove 'd7 'd5) ) )
((rand T) (bookMove 'e2 'e4))
(T (bookMove 'd2 'd4)) ) )
(move (car (push '*Undo M)))
(off *Redo)
(cons
(caar M)
(cdr (asoq (caar M) (cdr M)))
(pick cdr (cdar M)) ) ) )
(de yourMove (From To Cls)
(when
(find
'((Mov)
(and
(== (caar Mov) (get From 'piece))
(== To (pick cdr (cdar Mov)))
(or
(not Cls)
(isa Cls (car (last (car Mov)))) ) ) )
(moves *You) )
(prog1 (car (push '*Undo @))
(off *Redo)
(move @) ) ) )
(de undo ()
(move (cdr (push '*Redo (pop '*Undo)))) )
(de redo ()
(move (car (push '*Undo (pop '*Redo)))) )
(de setup (Depth You Init)
(setq *Depth (or Depth 5) *You You *Me (not You))
(off *White *Black *Moved *Undo *Redo)
(for Lst *Board
(for This Lst (=: piece) (=: whAtt) (=: blAtt)) )
(if Init
(for L Init
(with (piece (cadr L) 0 (car L))
(unless (caddr L)
(=: cnt 1)
(push '*Moved This) ) ) )
(mapc
'((Cls Lst)
(piece (list '+White Cls) 0 (car Lst))
(piece '(+White +Pawn) 0 (cadr Lst))
(piece '(+Black +Pawn) 0 (get Lst 7))
(piece (list '+Black Cls) 0 (get Lst 8)) )
'(+Rook +Knight +Bishop +Queen +King +Bishop +Knight +Rook)
*Board ) ) )
(de main (Depth You Init)
(setup Depth You Init)
(display T) )
(de go Args
(display
(cond
((not Args) (xchg '*Me '*You) (myMove))
((== '- (car Args)) (and *Undo (undo)))
((== '+ (car Args)) (and *Redo (redo)))
((apply yourMove Args) (display T) (myMove)) ) ) )
# Print position to file
(de ppos (File)
(out File
(println
(list 'main *Depth *You
(lit
(mapcar
'((This)
(list
(: field)
(val This)
(not (memq This *Moved)) ) )
(append *White *Black) ) ) ) ) ) )
Start:
$ pil chess.l -main + +---+---+---+---+---+---+---+---+ 8 |<R>|<N>|<B>|<Q>|<K>|<B>|<N>|<R>| +---+---+---+---+---+---+---+---+ 7 |<P>|<P>|<P>|<P>|<P>|<P>|<P>|<P>| +---+---+---+---+---+---+---+---+ 6 | | - | | - | | - | | - | +---+---+---+---+---+---+---+---+ 5 | - | | - | | - | | - | | +---+---+---+---+---+---+---+---+ 4 | | - | | - | | - | | - | +---+---+---+---+---+---+---+---+ 3 | - | | - | | - | | - | | +---+---+---+---+---+---+---+---+ 2 | P | P | P | P | P | P | P | P | +---+---+---+---+---+---+---+---+ 1 | R | N | B | Q | K | B | N | R | +---+---+---+---+---+---+---+---+ a b c d e f g h
Entering moves:
: (go e2 e4)
Undo moves:
: (go -)
Redo:
: (go +)
Switch sides:
: (go)
Save position to a file:
: (ppos "file")
Load position from file:
: (load "file")
Python
"Python Chess" is a chess game at the PyGame-Website and Homepage.
There is a 3D-Chess-Board in the VPython contributed section.
A very simple chess engine using python-chess. The computer plays Black. The program uses a two-ply search which computes material value for both sides and its own piece mobility after Black and White have made their moves.
The default Unicode board may look wonky and misaligned with certain terminal fonts. To use an ASCII board instead (like in the output shown below), set UNICODE = False. If your terminal uses dark mode, set DARKMODE = True.
Increasing RANDFAC, e.g. to 10 or even 100, creates more variety in computer moves, so that there is less repetition in games and openings.
The computer may say some things that allude to the chess game in 2001: A Space Odyssey, by the way. <lang python># Simple Python chess engine
- Computer plays Black
import sys, random, chess from collections import Counter
UNICODE = True # Print board with Unicode symbols? DARKMODE = False # Invert symbol colors? RANDFAC = 1 # Randomness factor
board = chess.Board()
def hal9000():
print("Thank you for a very enjoyable game.")
def pboard():
"Print board" if UNICODE and DARKMODE: print(board.unicode(invert_color=True)) elif UNICODE: print(board.unicode()) else: print(board)
pboard()
while not board.outcome():
while True: try: move = input("Your move? ") if move in ("q", "quit", "resign", "exit"): hal9000() sys.exit() board.push_uci(move) except ValueError: print("Sorry?") else: break
moves = {} for mymove in board.legal_moves: board.push(mymove) if board.result() == "0-1": # Can Black win? If so, end the game. print(mymove) pboard() print("I'm sorry, Frank. I think you missed it:") pm = board.peek() pn = chess.piece_name(board.piece_at(pm.to_square).piece_type) ps = chess.square_name(pm.to_square) print(f"{pn.capitalize()} to {ps}, mate.") hal9000() sys.exit()
for yourmove in board.legal_moves: board.push(yourmove) if board.result() == "1-0": # Has White won? If so, avoid move. board.pop() moves[mymove] = -1000 break v = Counter(board.fen().split()[0]) p = (9 * (v['q']-v['Q']) + 5 * (v['r']-v['R']) + 3 * (v['b']-v['B']) + 3 * (v['n']-v['N']) + v['p'] - v['P']) mobility = len(list(board.legal_moves)) + RANDFAC * random.random() p += mobility / 1000 #print(mymove, yourmove, p) old = moves.get(mymove, 1e6) if p < old: moves[mymove] = p board.pop() board.pop() try: sel = sorted(moves.items(), key=lambda item: -item[1])[0][0] except: break print(sel) board.push(sel) pboard()
print(f"Game finished, result is {board.result()}") hal9000()</lang>
- Output:
(in ASCII)
$ python3 simplechess.py r n b q k b n r p p p p p p p p . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . P P P P P P P P R N B Q K B N R Your move? e2e4 e7e6 r n b q k b n r p p p p . p p p . . . . p . . . . . . . . . . . . . . . P . . . . . . . . . . . P P P P . P P P R N B Q K B N R Your move? g1f3 d8f6 r n b . k b n r p p p p . p p p . . . . p q . . . . . . . . . . . . . . P . . . . . . . . N . . P P P P . P P P R N B Q K B . R Your move? …
Here is the PGN of a full game against Stockfish. Like many simple chess engines, it has an unfortunate tendency to rush out with its Queen early in the game, because that kind of move looks wonderful to the computer in terms of maximizing piece mobility. But unfortunately the Queen is often in danger there, leading to its loss:
[Event "Stockfish vs Python World Championship"] [Site "Rosetta Code"] [Date "2022.05.08"] [Round "1"] [White "Stockfish"] [Black "Python Simple Chess"] [Result "1-0"] 1.e4 e6 2.Nf3 Qf6 3.Nc3 Qf4 4.d4 Qg4 5.Be2 Qxg2 6.Rg1 Qh3 7.Bg5 Nc6 8.Rg3 Qh5 9.Nh4 Qxg5 10.Rxg5 Bd6 11.Rxg7 Nf6 12.e5 Bxe5 13.dxe5 Nxe5 14.Qd4 Ke7 15.Qxe5 Ne8 16.Qg5+ Kd6 17.O-O-O+ Kc6 18.Qb5# 1-0
Opening play could be improved a lot by using book moves, which is easy to do in python-chess with its Polyglot support.
Here is an example of a won game against a random mover chess bot, just to show this Python engine can actually win, provided its opponent is inept enough. (Human chess beginners tend to play on a random mover level, so this is a useful benchmark.)
[Event "Rosetta Code Chess Classics"] [Site "Rosetta Code"] [Date "2022.05.08"] [Round "1"] [White "Random Mover"] [Black "Python Simple Chess"] [Result "0-1"] 1.Nf3 e6 2.c4 Qf6 3.Ng1 Qf4 4.h4 Qxc4 5.e3 Qe4 6.Qg4 Qxg4 7.Nh3 Qxh4 8.d3 Bb4+ 9.Bd2 Bd6 10.a4 Nc6 11.Bc3 Qg4 12.Ba5 Nxa5 13.Be2 Qxg2 14.Ng1 Qxh1 15.b4 Qxg1+ 16.Bf1 Bxb4+ 17.Nc3 Bxc3+ 18.Ke2 Bxa1 19.Kd2 Qxf1 20.Kc2 Qxf2+ 21.Kb1 Qb2# 0-1
Wren
<lang ecmascript>import "/trait" for Stepped import "/fmt" for Fmt import "/ioutil" for Input, Output import "/str" for Str
var Board = List.filled(8, null)
// initialize Board var starting = [
[-500, -270, -300, -900, -7500, -300, -270, -500], [-100, -100, -100, -100, -100, -100, -100, -100], [ 0, 0, 0, 0, 0, 0, 0, 0], [ 0, 0, 0, 0, 0, 0, 0, 0], [ 0, 0, 0, 0, 0, 0, 0, 0], [ 0, 0, 0, 0, 0, 0, 0, 0], [ 100, 100, 100, 100, 100, 100, 100, 100], [ 500, 270, 300, 900, 5000, 300, 270, 500]
] for (x in 0..7) {
Board[x] = List.filled(8, 0) for (y in 0..7) Board[x][y] = starting[x][y]
}
// best moves var BestA = List.filled(8, 0) var BestB = List.filled(8, 0) var BestX = List.filled(8, 0) var BestY = List.filled(8, 0)
// current Levels var Cflag = false var Level = 0 var MaxLevel = 5 var Score = 0 var End = false
// helper classes class Terminal {
static clear() { Output.fwrite("\e[2J") locate(1, 1) }
static locate(r, c) { Output.fwrite("\e[%(r);%(c)H") }
}
class Color {
static set(fore, back) { fore = (fore < 8) ? fore + 30 : fore + 82 back = (back < 8) ? back + 40 : back + 92 Output.fwrite("\e[%(fore);%(back)m") }
static reset() { Output.fwrite("\e[39;49m") }
}
class Chess {
// generate list of moves for bishop static bishop(a, b, xx, yy, ndx) { var id = Board[b][a].sign
var f = Fn.new { |x, y| // make sure no piece of same color if (id != Board[y][x].sign) { ndx = ndx + 1 xx[ndx] = x yy[ndx] = y } }
// work out diagonal moves in each of four directions for (dxy in 1..7) { var x = a - dxy var y = b + dxy // stop if go off the board if (x < 0 || x > 7 || y < 0 || y > 7) break f.call(x, y) // stop when hit a piece if (Board[y][x] != 0) break } for (dxy in 1..7) { var x = a + dxy var y = b + dxy if (x < 0 || x > 7 || y < 0 || y > 7) break f.call(x, y) if (Board[y][x] != 0) break } for (dxy in 1..7) { var x = a - dxy var y = b - dxy if (x < 0 || x > 7 || y < 0 || y > 7) break f.call(x, y) if (Board[y][x] != 0) break } for (dxy in 1..7) { var x = a + dxy var y = b - dxy if (x < 0 || x > 7 || y < 0 || y > 7) break f.call(x, y) if (Board[y][x] != 0) break } return ndx }
// evaluate possible moves static evaluate(id, prune) { var xx = List.filled(27, 0) var yy = List.filled(27, 0) Level = Level + 1 // update recursion level var bestScore = 10000 * id for (b in 7..0) { // loop through each square for (a in 7..0) { // if square doesn't have right color piece, go to next square if (Board[b][a].sign != id) { if (Level == 1) showman(a, b, 0) continue } if (Level == 1) showman(a, b, 8) // show move currently being tried var ndx = 0 ndx = moveList(a, b, xx, yy, ndx) // get list of moves for current piece for (i in Stepped.ascend(0..ndx)) { // loop through each possible move var x = xx[i] var y = yy[i] if (Level == 1) { Terminal.locate(1, 1) Fmt.print("Trying: $c$d-$c$d", 65+a, 8-b, 65+x, 8-y) showman(x, y, 8) } var oldScore = Score var mover = Board[b][a] // store these locations var target = Board[y][x] // so we can set the move back makeMove(a, b, x, y) // make the move so we can evaluate if (Level < MaxLevel) { var p = bestScore - target + id*(8 - (4-x).abs - (4-y).abs) Score = Score + evaluate(-id, p) } // work out score for move Score = Score + target - id*(8 - (4-x).abs - (4-y).abs) if ((id < 0 && Score > bestScore) || (id > 0 && Score < bestScore)) { // update current best score BestA[Level] = a BestB[Level] = b BestX[Level] = x BestY[Level] = y bestScore = Score if ((id < 0 && bestScore >= prune) || (id > 0 && bestScore <= prune)) { // prune to avoid wasting time Board[b][a] = mover // restore position prior to modification Board[y][x] = target Score = oldScore if (Level == 1) showman(x, y, 0) if (Level == 1) showman(a, b, 0) Level = Level - 1 return bestScore } } Board[b][a] = mover Board[y][x] = target Score = oldScore if (Level == 1) showman(x, y, 0) } if (Level == 1) showman(a, b, 0) } } Level = Level - 1 return bestScore }
// determine whether 'in check' or not static inCheck() { var xx = List.filled(27, 0) var yy = List.filled(27, 0) var ndx = 0 for (b in 0..7) { for (a in 0..7) { if (Board[b][a] >= 0) continue ndx = moveList(a, b, xx, yy, ndx) for (i in Stepped.ascend(0..ndx)) { var x = xx[i] var y = yy[i] if (Board[y][x] == 5000) { System.print("You are in check!\n\n") return true } } } } return false }
// get player move static io(a, b, x, y, result) { var xx = List.filled(27, 0) var yy = List.filled(27, 0) Terminal.clear() if (a >= 0) { if (result < -2500) { System.print("I resign") End = true return } var piece = Board[y][x] makeMove(a, b, x, y) // show computer move Fmt.print("My move: $c$d-$c$d", 65+a, 8-b, 65+x, 8-y) if (piece != 0) { System.write("I took your ") System.print( (piece == 100) ? "pawn" : (piece == 270) ? "knight" : (piece == 300) ? "bishop" : (piece == 500) ? "rook" : (piece == 900) ? "queen" : (piece == 5000) ? "king" : "") } inCheck() } while (true) { showbd() Terminal.locate(24, 1) var inp = Str.upper(Input.text("Your move (ex: E2-E4): ")) if (inp == "QUIT") { Terminal.clear() End = true return } // castling, kingside rook if (inp == "O-O" || inp == "0-0") { if (Cflag || Board[7][7] != 500 || Board[7][6] != 0 || Board[7, 5] != 0) { Terminal.clear() continue } Board[7][6] = 5000 Board[7][4] = 0 Board[7][5] = 500 Board[7][7] = 0 Cflag = true return } // castling, queenside rook if (inp == "O-O-O" || inp == "0-0-0") { if (Cflag || Board[7][0] != 500 || Board[7][1] != 0 || Board[7, 2] != 0 || Board[7][3] != 0) { Terminal.clear() continue } Board[7][2] = 5000 Board[7][4] = 0 Board[7][3] = 500 Board[7][0] = 0 Cflag = true return } if (inp.count < 5) { Terminal.clear() continue } b = 8 - (inp[1].bytes[0] - 48) a = inp[0].bytes[0] - 65 x = inp[3].bytes[0] - 65 y = 8 - (inp[4].bytes[0] - 48) if (b > 7 || b < 0 || a > 7 || a < 0 || x > 7 || x < 0 || y > 7 || y < 0 || Board[b][a] <= 0) { Terminal.clear() continue } var ndx = 0 ndx = moveList(a, b, xx, yy, ndx) // validate move for (k in Stepped.ascend(0..ndx)) { if (x == xx[k] && y == yy[k]) { var mover = Board[b][a] var target = Board[y][x] makeMove(a, b, x, y) Terminal.locate(1, 1) // make sure move out of check if (!inCheck()) return Board[b][a] = mover // otherwise move out of check and reset board Board[y][x] = target Terminal.clear() break } } Terminal.clear() } return }
// generate list of moves for king static king(a, b, xx, yy, ndx) { var id = Board[b][a].sign // go through each of 8 possible moves, checking for same color and off board for (dy in -1..1) { if (b + dy < 0 || b + dy > 7) continue for (dx in -1..1) { if (a + dx < 0 || a + dx > 7) continue if (id != Board[b+dy][a+dx].sign) { ndx = ndx + 1 xx[ndx] = a + dx yy[ndx] = b + dy } } } return ndx }
// generate list of moves for knight static knight(a, b, xx, yy, ndx) { var id = Board[b][a].sign // get color
var f = Fn.new { |x, y| // make sure on board if (x < 0 || x > 7 || y < 0 || y > 7) return // make sure no piece of same color if (id != Board[y][x].sign) { ndx = ndx + 1 xx[ndx] = x yy[ndx] = y } }
// work out each of the knight's eight moves f.call(a - 1, b - 2) f.call(a - 2, b - 1) f.call(a + 1, b - 2) f.call(a + 2, b - 1) f.call(a - 1, b + 2) f.call(a - 2, b + 1) f.call(a + 1, b + 2) f.call(a + 2, b + 1) return ndx }
// make a move on the board static makeMove(a, b, x, y) { Board[y][x] = Board[b][a] // move piece to target square Board[b][a] = 0 // old square now empty if (y == 0 && Board[y][x] == 100) Board[y][x] = 900 // pawn promoted if (y == 7 && Board[y][x] == -100) Board[y][x] = -900 }
// generate list of moves for current piece static moveList(a, b, xx, yy, ndx) { var piece = Board[b][a].abs.truncate // get value corresponding to piece ndx = -1 // call proper move listing routine depending on piece if (piece == 100) { ndx = pawn(a, b, xx, yy, ndx) } else if (piece == 270) { ndx = knight(a, b, xx, yy, ndx) } else if (piece == 300) { ndx = bishop(a, b, xx, yy, ndx) } else if (piece == 500) { ndx = rook(a, b, xx, yy, ndx) } else if (piece == 900) { ndx = queen(a, b, xx, yy, ndx) } else { ndx = king(a, b, xx, yy, ndx) } return ndx }
// generate list of moves for pawn static pawn(a, b, xx, yy, ndx) { var id = Board[b][a].sign // get color if (a - 1 >= 0 && a - 1 <= 7 && b - id >= 0 && b - id <= 7) { // if there's a piece to capture, do so if (Board[b-id][a-1].sign == -id) { ndx = ndx + 1 xx[ndx] = a - 1 yy[ndx] = b - id } } if (a + 1 >= 0 && a + 1 <= 7 && b - id >= 0 && b - id <= 7) { if (Board[b-id][a+1].sign == -id) { ndx = ndx + 1 xx[ndx] = a + 1 yy[ndx] = b - id } } if (a >= 0 && a <= 7 && b - id >= 0 && b - id <= 7) { // make sure square is empty if (Board[b-id][a] == 0) { ndx = ndx + 1 xx[ndx] = a yy[ndx] = b - id if ((id < 0 && b == 1) || (id > 0 && b == 6)) { // if it's empty move two squares forward if (Board[b-id-id][a] == 0) { ndx = ndx + 1 xx[ndx] = a yy[ndx] = b - 2*id } } } } return ndx }
// generate list of moves for queen static queen(a, b, xx, yy, ndx) { // queen's move = bishop + rook ndx = bishop(a, b, xx, yy, ndx) ndx = rook(a, b, xx, yy, ndx) return ndx }
// generate list of moves for rook static rook(a, b, xx, yy, ndx) { var id = Board[b][a].sign // work out vert/horiz moves in each direction for (x in Stepped.descend(a-1..0)) { if (id != Board[b][x].sign) { // if no piece of same color ndx = ndx + 1 xx[ndx] = x yy[ndx] = b } if (Board[b][x] != 0) break } for (x in Stepped.ascend(a+1..7)) { if (id != Board[b][x].sign) { ndx = ndx + 1 xx[ndx] = x yy[ndx] = b } if (Board[b][x] != 0) break } for (y in Stepped.descend(b-1..0)) { if (id != Board[y][a].sign) { ndx = ndx + 1 xx[ndx] = a yy[ndx] = y } if (Board[y][a] != 0) break } for (y in Stepped.ascend(b+1..7)) { if (id != Board[y][a].sign) { ndx = ndx + 1 xx[ndx] = a yy[ndx] = y } if (Board[y][a] != 0) break } return ndx }
// show board static showbd() { Terminal.locate(3, 30) Color.set(7, 0) System.print("A B C D E F G H") for (k in 0..25) { Terminal.locate(4, 28 + k) Color.set(3, 0) System.print(String.fromCodePoint(0x2584)) } for (b in 0..7) { Terminal.locate(2*b + 5, 26) Color.set(7, 0) System.print(String.fromCodePoint(56 - b)) Terminal.locate(2*b + 5, 28) Color.set(3, 0) System.print(String.fromCodePoint(0x2588)) Terminal.locate(2*b + 6, 28) Color.set(3, 0) System.print(String.fromCodePoint(0x2588)) for (a in 0..7) { var colour = (((a + b) % 2) != 0) ? 8 : 9 square(3*a + 31, 2*b + 5, colour) } Terminal.locate(2*b + 5, 53) Color.set(3, 0) System.print(String.fromCodePoint(0x2588)) Terminal.locate(2*b + 6, 53) Color.set(3, 0) System.print(String.fromCodePoint(0x2588)) Terminal.locate(2*b + 6, 55) Color.set(7, 0) System.print(String.fromCodePoint(56 - b)) } for (k in 0..25) { Terminal.locate(21, 28 + k) Color.set(3, 0) System.print(String.fromCodePoint(0x2580)) } Terminal.locate(22, 30) Color.set(7, 0) System.print("A B C D E F G H") for (b in 0..7) { for (a in 0..7) showman(a, b, 0) } Color.set(7, 0) }
// show piece static showman(a, b, flag) { var back = (Board[b][a] <= 0) ? 0 : 7 var fore = 7 - back + flag if (Board[b][a] == 0) { back = (((a + b) & 1) != 0) ? 8 : 9 fore = back + (-1) * ((flag > 0) ? -1 : 0) } var piece = Board[b][a].abs.truncate var n = (piece == 0) ? String.fromCodePoint(0x2588) : (piece == 100) ? "P" : (piece == 270) ? "N" : (piece == 300) ? "B" : (piece == 500) ? "R" : (piece == 900) ? "Q" : (piece == 5000) ? "K" : (piece == 7500) ? "K" : " " Terminal.locate(2*b + 5 - ((Board[b][a] > 0) ? -1 : 0), 3*a + 30) Color.set(fore, back) System.print(n) Terminal.locate(1, 1) Color.set(7, 0) }
// display a square static square(a, b, c) { var mt = String.fromCodePoint(0x2588) * 3 Terminal.locate(b, a - 2) Color.set(c, c) System.print(mt) Terminal.locate(b + 1, a - 2) Color.set(c, c) System.print(mt) Color.set(7, 0) }
// start a game static start() { var a = -1 var b = 0 var x = 8 var y = 8 var result = 0 while (true) { Score = 0 io(a, b, x, y, result) // get white's move if (End) { Color.reset() Terminal.clear() return } Terminal.clear() showbd() // update board to show white's move result = evaluate(-1, 10000) // get black's move a = BestA[1] // start column for black's move b = BestB[1] // start row for black's move x = BestX[1] // end column for black's move y = BestY[1] // end row for black's move } }
}
Chess.start()</lang>