**Tcl-Bindings for the Javascript chess-library chess.js** An easy wrapper for the famous chess.js library using the Tcl-bindings to the Javascript-Duktape library by [dbohdan]. *** Links *** * chess.js for examples and API [https://github.com/jhlywa/chess.js] * duktape [http://www.duktape.org] * tcl-duktape [https://github.com/dbohdan/tcl-duktape] * free chess font "Chess Berlin" [http://www.enpassant.dk/chess/fonteng.htm] [WikiDBImage Chess4Tcl.png] Provide ====== # Author: Detlef Groth # License BSD (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] " "] ====== [WikiDBImage Chess4Tcl.png] <>Games | Foreign Interfaces