Tcl-Bindings for the Javascript chess-library chess.js edit
An easy wrapper for the famous chess.js library using the Tcl-bindings to the Javascript-Duktape library by
dbohdan.
Links
Provide
# Author: Detlef Groth
# License MIT (same as chess.js, duktape, tcl-duktape)
# Version 0.1 working and usable, not fast however ...
package require duktape
package require duktape::oo
package require fileutil
package require http
oo::class create Chess4Tcl {
variable dto
constructor {{fen ""}} {
set dto [::duktape::oo::Duktape new]
set chessfile [file join [file dirname [info script]] chess.js]
# code fom dbohdan
if {![file exists $chessfile]} {
set req [::http::geturl http://cdnjs.cloudflare.com/ajax/libs/chess.js/0.10.2/$chessfile]
set c [::http::data $req]
::http::cleanup $req
::fileutil::writeFile $chessfile $c
}
# Set up the game.
$dto eval [::fileutil::cat $chessfile]
if {$fen ne ""} {
$dto eval " chess = new Chess (\"$fen\") "
} else {
$dto eval { chess =new Chess () }
}
$dto jsmethod FromTo {{fromarg "" string} {toarg "" string}} {
return chess.move({from: fromarg, to: toarg});
}
$dto jsmethod myboard {} { return JSON.stringify(chess.board()); }
$dto jsmethod loadPgn2 {{pgnstr "" string}} {
chess = new Chess();
fixstr=pgnstr.replace(/\n +\n/g, '\n\n');
return(chess.load_pgn(fixstr));
}
}
method ascii {} {
return [$dto call-method-str chess.ascii undefined]
}
method board {{ttf false}} {
set fields [string repeat wbwbwbwbbwbwbwbw 4]
set json1 [::duktape::oo::JSON new $dto [$dto myboard]]
set res ""
if {$ttf} {
set res "1222222223\n"
}
set x 0
for {set row 0} {$row < 8} { incr row } {
if {$ttf} {
append res "4"
}
for {set col 0} {$col < 8} { incr col } {
set field [string range $fields $x $x]
set slot [$json1 get $row $col]
if {$slot eq "null"} {
if {$ttf && $field eq "w"} {
append res " "
} elseif {$ttf && $field eq "b"} {
append res "+"
} else {
append res .
}
} else {
set piece [$json1 get $row $col type]
set color [$json1 get $row $col color]
if {$color eq "w"} {
set piece [string toupper $piece]
}
if {$ttf && $field eq "w"} {
set piece [string map {K k Q q R r B b N h P p k l q w r t b n n j p o} $piece]
} elseif {$ttf && $field eq "b"} {
set piece [string map {K K Q Q R R B B N H P P k L q W r T b N n J p O} $piece]
}
append res $piece
}
incr x
}
if {$ttf} {
append res "5"
}
append res "\n"
}
if {$ttf} {
append res "7888888889"
}
return $res
}
method clear { } {
return [$dto call-method-str chess.clear undefined]
#$dto eval "chess.clear()"
}
method moves { } {
return [split [$dto eval { moves = chess.moves() }] ,]
}
method move {args} {
if {[llength $args]== 1} {
set move [lindex $args 0]
$dto eval " chess.move(\"$move\") "
} else {
set from [lindex $args 0]
set to [lindex $args 1]
$dto moveFromTo $from $to
}
}
method fen { } {
return [$dto call-method-str chess.fen undefined]
}
method load {fen} {
$dto eval "chess.load(\"$fen\")"
}
method game_over {} {
return [$dto call-method-str chess.game_over undefined]
}
method get {square} {
if {[$dto eval "chess.get(\"$square\")"] eq "null"} {
return [list "" ""]
} else {
return [list [$dto eval "chess.get(\"$square\").type"] \
[$dto eval "chess.get(\"$square\").color"]]
}
}
method header {args} {
foreach {key value} $args {
$dto eval "chess.header(\"$key\",\"$value\")"
}
if {[llength $args] == 0} {
return [$dto eval "Object.keys(chess.header())"]
}
}
method history {{verbose false}} {
if {$verbose} {
set nmove [llength [[self] history]]
set res [list]
for {set i 0} {$i < $nmove} {incr i 1} {
set move [list]
foreach key [list color from to flags piece san] {
set val [$dto eval " chess.history({verbose:true})\[$i\].$key "]
lappend move $key
lappend move $val
}
lappend res $move
}
return $res
} else {
return [split [$dto eval { chess.history() }] ,]
}
}
method in_check {} {
return [$dto call-method-str chess.in_check undefined]
}
method in_checkmate {} {
return [$dto call-method-str chess.in_checkmate undefined]
}
method in_draw {} {
return [$dto call-method-str chess.in_draw undefined]
}
method in_stalemate {} {
return [$dto call-method-str chess.in_stalemate undefined]
}
method in_threefold_repetition {} {
return [$dto call-method-str chess.in_threefold_repetition undefined]
}
method insufficient_material {} {
return [$dto call-method-str chess.insufficient_material undefined]
}
method new { } {
$dto eval "chess =new Chess ()"
}
method load_pgn2 {pgn} {
# did not work
set pgn [regsub -all {\n +\n} $pgn {\n\n}]
set results [$dto call-str chess.load_pgn $pgn]
puts "results=$results"
return
}
method load_pgn {pgn} {
return [$dto loadPgn2 $pgn]
}
method pgn {} {
return [$dto call-method-str chess.pgn undefined]
}
method put {piece color square} {
return [$dto eval "chess.put({type: '$piece',color: '$color'},'$square')"]
}
method reset {} {
return [$dto call-method-str chess.reset undefined]
}
method remove {square} {
set res [list]
puts [$dto eval "chess.remove(\"$square\")"]
if {[$dto eval "chess.remove(\"$square\")"] eq "null"} {
return $res
}
foreach key [$dto eval "Object.keys(chess.remove(\"$square\"))"] {
lappend res [list $key [$dto eval "chess.remove(\"$square\").$key"]]
}
return $res
}
method turn {} {
$dto call-method-str chess.turn undefined
}
}
if {$argv0 eq [info script]} {
set chess [Chess4Tcl new]
foreach move [$chess moves] { puts $move }
$chess move e4
$chess turn
$chess move e5
$chess move f4
puts [$chess ascii]
puts [$chess fen]
$chess reset
$chess header White Plunky Black Plinkie
$chess move e4
$chess move e5
$chess move f4
$chess move d5
puts [$chess pgn]
puts [$chess ascii]
puts [$chess game_over]
$chess load "4k3/4P3/4K3/8/8/8/8/8 b - - 0 78"
puts [$chess ascii]
if {[$chess game_over]} {
puts "it's over!!"
}
$chess load "rnb1kbnr/pppp1ppp/8/4p3/5PPq/8/PPPPP2P/RNBQKBNR w KQkq - 1 3"
puts [$chess ascii]
puts [$chess game_over]
puts [$chess get a8]
puts [$chess get a5]
puts "puts in mate? "
puts [$chess in_check]
$chess load "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
$chess move e4
$chess move e5
$chess move f4
puts [$chess history]
puts [$chess history true]
$chess load "rnb1kbnr/pppp1ppp/8/4p3/5PPq/8/PPPPP2P/RNBQKBNR w KQkq - 1 3"
puts [$chess game_over]
#puts [$chess in_mate]
$chess load "rnb1kbnr/pppp1ppp/8/4p3/5PPq/8/PPPPP2P/RNBQKBNR w KQkq - 1 3"
puts [$chess game_over]
#puts [$chess in_mate]
#puts [$chess in draw]
#puts [$chess in check]
set pgn {[Event "Casual Game"]
[Site "Berlin GER"]
[Date "1852.??.??"]
[EventDate "?"]
[Round "?"]
[Result "1-0"]
[White "Adolf Anderssen"]
[Black "Jean Dufresne"]
[ECO "C52"]
[WhiteElo "?"]
[BlackElo "?"]
[PlyCount "47"]
1.e4 e5 2.Nf3 Nc6 3.Bc4 Bc5 4.b4 Bxb4 5.c3 Ba5 6.d4 exd4 7.O-O
d3 8.Qb3 Qf6 9.e5 Qg6 10.Re1 Nge7 11.Ba3 b5 12.Qxb5 Rb8 13.Qa4
Bb6 14.Nbd2 Bb7 15.Ne4 Qf5 16.Bxd3 Qh5 17.Nf6+ gxf6 18.exf6
Rg8 19.Rad1 Qxf3 20.Rxe7+ Nxe7 21.Qxd7+ Kxd7 22.Bf5+ Ke8
23.Bd7+ Kf8 24.Bxe7# 1-0
}
# did not work
$chess load_pgn $pgn
puts "loaded?"
puts [$chess ascii]
puts [$chess pgn]
puts "result?"
puts [$chess header]
$chess load "k7/8/n7/8/8/8/8/7K b - - 0 1"
$chess header White "Robert J. Fisher"
$chess header Black "Mikhail Tal"
puts [$chess insufficient_material]
$chess clear
puts [$chess put p b a5]
puts [$chess put k w h1]
puts [$chess fen]
puts [$chess put z w a1] ;# invalid
puts [$chess insufficient_material]
puts [$chess remove a5]
puts [$chess remove a1] ;# not possible
$chess clear
$chess load "rnbqkbnr/pppppppp/8/8/4P3/8/PPPP1PPP/RNBQKBNR b KQkq e3 0 1"
puts [$chess turn]
puts [$chess in_check]
$chess clear
puts "loading start position"
$chess load "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
#$chess new
$chess move e4
$chess move e5
$chess move Na3
$chess move Qh4
$chess move Ke2
puts "check? [$chess in_check]"
$chess move Qxe4
puts [$chess ascii]
puts "check? [$chess in_check]"
puts "mate? [$chess in_checkmate]"
puts [$chess board]
puts [$chess board true]
package require Tk
font create chessberlin -family "Chess Berlin" -size 20
option add *font chessberlin
pack [text .t]
.t insert end [regsub -all " " [$chess board true] " "]
}
Sample Session
% set chess [Chess4Tcl new]
::oo::Obj16
% foreach move [$chess moves] { puts -nonewline " $move" }
a3 a4 b3 b4 c3 c4 d3 d4 e3 e4 f3 f4 g3 g4 h3 h4 Na3 Nc3 Nf3 Nh3
% $chess move e4
[object Object]
% $chess turn
b
% $chess move e5
[object Object]
% $chess move f4
[object Object]
% $chess ascii
+------------------------+
8 | r n b q k b n r |
7 | p p p p . p p p |
6 | . . . . . . . . |
5 | . . . . p . . . |
4 | . . . . P P . . |
3 | . . . . . . . . |
2 | P P P P . . P P |
1 | R N B Q K B N R |
+------------------------+
a b c d e f g h
% $chess fen
rnbqkbnr/pppp1ppp/8/4p3/4PP2/8/PPPP2PP/RNBQKBNR b KQkq f3 0 2
% $chess load "4k3/4P3/4K3/8/8/8/8/8 b - - 0 78"
true
% $chess ascii
+------------------------+
8 | . . . . k . . . |
7 | . . . . P . . . |
6 | . . . . K . . . |
5 | . . . . . . . . |
4 | . . . . . . . . |
3 | . . . . . . . . |
2 | . . . . . . . . |
1 | . . . . . . . . |
+------------------------+
a b c d e f g h
% $chess game_over
true
% puts "loading start position"
loading start position
% $chess load "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
true
% $chess move e4
[object Object]
% $chess move e5
[object Object]
% $chess move Na3
[object Object]
% $chess move Qh4
[object Object]
% $chess in_check
false
% $chess in_checkmate
false
% $chess move Ke2
[object Object]
% $chess move Qxe4
[object Object]
% $chess in_checkmate
true
% $chess ascii
+------------------------+
8 | r n b . k b n r |
7 | p p p p . p p p |
6 | . . . . . . . . |
5 | . . . . p . . . |
4 | . . . . q . . . |
3 | N . . . . . . . |
2 | P P P P K P P P |
1 | R . B Q . B N R |
+------------------------+
a b c d e f g h
% $chess board
rnb.kbnr
pppp.ppp
........
....p...
....q...
N.......
PPPPKPPP
R.BQ.BNR
% $chess board true
1222222223
4TjN LnJt5
4oOoO OoO5
4+ + + + 5
4 + +o+ +5
4+ + W + 5
4h+ + + +5
4PpPpKpPp5
4r+bQ BhR5
7888888889
% package require Tk
% font create chessberlin -family "Chess Berlin" -size 20
% option add *font chessberlin
% pack [text .t]
% .t insert end [regsub -all " " [$chess board true] " "]
for examples and API
