Version 1 of Chess4Tcl

Updated 2017-02-04 15:55:52 by DDG

Tcl-Bindings for the Javascript chess-library chess.js

An easy wrapper for the famous chess.js library using Tcl-bindings to Javascript-Duktape library by dbohdan

*** Links

  • chess.js for examples and API [L1 ]
  • duktape [L2 ]
  • tcl-duktape [L3 ]

Provide

# Author: Detlef Groth
# License BSD (same as chess.js, duktape, tcl-duktape

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 bwbwbwbwwbwbwbwb 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] "   "]
}