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

% 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] "   "]