I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

Chess player

From Rosetta Code
This task has been flagged for clarification due to it being believed to be too difficult to implement in a reasonable amount of effort in more than one (usually very specialised) language. It may need to be divided into multiple tasks or modified substantially so that multiple implementations are practical, and that may cause code on this page in its current state to be flagged incorrect afterwards. See this page's Talk page for discussion.
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.

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:

  1. Chess player/Move generation
  2. Chess player/Search and evaluation
  3. 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[edit]

Works with: QBasic

El código es de Dean Menezes

Encontrado en: http://www.petesqbsite.com/sections/express/issue23/Tut_QB_Chess.txt

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


Go[edit]

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[edit]

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.

#!/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
}

Phix[edit]

Version 0.8.1+ will contain 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[edit]

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[edit]

Library: pygame
[edit]

"Python Chess" is a chess game at the PyGame-Website and Homepage.

Library: VPython
[edit]

There is a 3D-Chess-Board in the VPython contributed section.

Wren[edit]

Translation of: BASIC
Library: Wren-trait
Library: Wren-fmt
Library: Wren-ioutil
Library: Wren-str
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()