Chess player
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.
Chess player is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
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.
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, chess from collections import Counter
UNICODE = True # Print board with Unicode symbols? DARKMODE = False # Invert symbol colors?
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)
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))
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>