scid-data 1:4.6.4+dfsg1-2 / usr / share / scid / tcl / board.tcl

# board.tcl: part of Scid
# Copyright (C) 2001-2003 Shane Hudson. All rights reserved.
# Copyright (C) 2014 Fulvio Benini

# letterToPiece
#    Array that maps piece letters to their two-character value.
#
array set ::board::letterToPiece [list \
    "R" wr "r" br "N" wn "n" bn "B" wb "b" bb \
    "Q" wq "q" bq "K" wk "k" bk "P" wp "p" bp "." e \
    ]

# List of color schemes: each sublist contains a reference name (not used),
# then lite, dark, highcolor, bestcolor, white, black, w border, b border.
#
set colorSchemes {
  { "Blue-white" "#f3f3f3" "#7389b6" "#f3f484" "#b8cbf8" "#ffffff" "#000000" "#000000" "#ffffff" }
  { "Green-Yellow" "#e0d070" "#70a070" "#b0d0e0" "#bebebe" }
  { "Brown" "#d0c0a0" "#a08050" "#b0d0e0" "#bebebe" }
  { "Blue-ish" "#d0e0d0" "#80a0a0" "#b0d0e0" "#f0f0a0" }
  { "M. Thomas" "#e0d8b8" "#047c24" "#1c80e0" "#fe0000" }
  { "KM. Skontorp" "#ffdb86" "#ffa200" "#b0d0e0" "#bebebe" }
}
array set newColors {}

proc SetBoardTextures {} {
  global boardfile_dark boardfile_lite
  # handle cases of old configuration files
  image create photo bgl20 -height 20 -width 20
  image create photo bgd20 -height 20 -width 20
  if { [ catch { bgl20 copy $boardfile_lite -from 0 0 20 20 ; bgd20 copy $boardfile_dark -from 0 0 20 20 } ] } {
    set boardfile_dark emptySquare
    set boardfile_lite emptySquare
    bgl20 copy $boardfile_lite -from 0 0 20 20
    bgd20 copy $boardfile_dark -from 0 0 20 20
  }

  set textureSize "[image height $boardfile_lite].0"
  foreach size $::boardSizes {
    # create lite and dark squares
    image create photo bgl$size -width $size -height $size
    image create photo bgd$size -width $size -height $size
    set z [expr int (ceil ($size / $textureSize))]
    bgl$size copy $boardfile_lite -zoom $z
    bgd$size copy $boardfile_dark -zoom $z
  }
}

# setPieceFont:
#   Given a piece font name, resets all piece images in all
#   available board sizes to that font.
#
proc setPieceFont {font} {
	set ::boardSizes {}
	set dname [file join $::scidImgDir pieces $font]
	set fnames [glob -nocomplain -directory $dname *.png]
	append fnames " " [glob -nocomplain -directory $dname *.gif]
	foreach {fname} $fnames {
		if {! [catch {image create photo tmpPieces -file "$fname"}]} {
			set size [image height tmpPieces]
			if {[lsearch -exact $::boardSizes $size] == -1} {
				image create photo e$size -height $size -width $size
				set x 0
				foreach p {wp wn wb wr wq wk bp bn bb br bq bk} {
					image create photo $p$size -width $size -height $size
					$p$size copy tmpPieces -from $x 0 [expr {$x + $size}] $size
					incr x $size
				}
				lappend ::boardSizes $size
			}
			image delete tmpPieces
		}
	}
	if {[llength $::boardSizes] == 0 && $::boardStyle != "Merida"} {
		set ::boardStyle "Merida"
		setPieceFont "$::boardStyle"
		return
	}
	set ::boardSizes [lsort -integer $::boardSizes]
	foreach size $::boardSizes {
		if {$size >= $::boardSize} { break }
	}
	set ::boardSize $size
	menuUpdateBoardSizes
	SetBoardTextures
}

# chooseBoardTextures:
#   Dialog for selecting board textures.
#
proc chooseBoardTextures {i} {
  global boardfile_dark boardfile_lite
  
  set prefix [lindex $::textureSquare $i]
  set boardfile_dark ${prefix}-d
  set boardfile_lite ${prefix}-l
  SetBoardTextures
  
}

# chooseBoardColors:
#   Dialog for selecting board colors.
#
proc chooseBoardColors {{choice -1}} {
  global lite dark highcolor bestcolor
  global colorSchemes newColors
  
  set colors {lite dark highcolor bestcolor}
  
  set w .boardColorDialog
  
  if {[winfo exists $w]} {
    # Just update the dialog box colors and return:
    if {$choice >= 0} {
      set list [lindex $colorSchemes $choice]
      set newColors(lite) [lindex $list 1]
      set newColors(dark) [lindex $list 2]
      set newColors(highcolor) [lindex $list 3]
      set newColors(bestcolor) [lindex $list 4]
    }
    set nlite $newColors(lite)
    set ndark $newColors(dark)
    
    foreach i {wr bn wb bq wk bp} {
      $w.bd.$i configure -background $ndark
    }
    foreach i {br wn bb wq bk wp} {
      $w.bd.$i configure -background $nlite
    }
    $w.bd.bb configure -background $newColors(highcolor)
    $w.bd.wk configure -background $newColors(bestcolor)
    foreach i $colors {
      $w.select.b$i configure -background $newColors($i)
    }
    
    foreach i {0 1 2 3} {
      set c $w.border.c$i
      $c itemconfigure dark -fill $dark -outline $dark
      $c itemconfigure lite -fill $lite -outline $lite
    }
    
    return
  }
  
  toplevel $w
  wm title $w "Scid: [tr OptionsBoardColors]"
  
  foreach i $colors { set newColors($i) [set $i] }
  set bd $w.bd
  pack [ttk::frame $bd] -side top -expand 1
  addHorizontalRule $w
  pack [ttk::frame $w.select] -side top -fill x
  addHorizontalRule $w
  pack [ttk::frame $w.preset] -side top -fill x
  pack [ttk::frame $w.texture] -side top -fill x
  addHorizontalRule $w
  pack [ttk::frame $w.border] -side top
  addHorizontalRule $w
  pack [ttk::frame $w.buttons] -side top -fill x
  
  foreach psize $::boardSizes {
    if {$psize >= 40} { break }
  }
  set column 0
  foreach j {r n b q k p} {
    ttk::label $bd.w$j -image w${j}$psize
    ttk::label $bd.b$j -image b${j}$psize
    grid $bd.b$j -row 0 -column $column
    grid $bd.w$j -row 1 -column $column
    incr column
  }
  
  set f $w.select
  foreach row {0 1 0 1} column {0 0 2 2} c {
    lite dark highcolor bestcolor
  } n {
    LightSquares DarkSquares SelectedSquares SuggestedSquares
  } {
    button $f.b$c -image e20 -background [set $c] -command "
    set x \[ tk_chooseColor -initialcolor \$newColors($c) -title Scid \]
    if {\$x != \"\"} { set newColors($c) \$x; chooseBoardColors }
    "
    ttk::label $f.l$c -text "$::tr($n)  "
    grid $f.b$c -row $row -column $column
    grid $f.l$c -row $row -column [expr {$column + 1} ] -sticky w
  }
  
  # Border width option:
  set f $w.border
  foreach i {0 1 2 3} {
    if {$i != 0} { pack [ttk::frame $f.gap$i -width 20] -side left -padx 1 }
    set b $f.b$i
    ttk::radiobutton $b -text "$i:" -variable newborderwidth -value $i
    set c $f.c$i
    canvas $c -height $psize -width $psize -background black
    $c create rectangle 0 0 [expr {20 - $i}] [expr {20 - $i}] -tag dark
    $c create rectangle [expr {20 + $i}] [expr {20 + $i}] $psize $psize -tag dark
    $c create rectangle 0 [expr {20 + $i}] [expr 20 - $i] $psize -tag lite
    $c create rectangle [expr {20 + $i}] 0 $psize [expr {20 - $i}] -tag lite
    pack $b $c -side left -padx 1
    bind $c <Button-1> "set newborderwidth $i"
  }
  set ::newborderwidth $::borderwidth
  
  set count 0
  foreach list $colorSchemes {
    set f $w.preset.p$count
    pack [ttk::frame $f] -side left -padx 5
    ttk::label $f.blite -image bp$psize -background [lindex $list 1]
    ttk::label $f.bdark -image bp$psize -background [lindex $list 2]
    ttk::label $f.wlite -image wp$psize -background [lindex $list 1]
    ttk::label $f.wdark -image wp$psize -background [lindex $list 2]
    ttk::button $f.select -text [expr {$count + 1}] -command "chooseBoardColors $count ; \
        set ::boardfile_dark emptySquare ; \
        set ::boardfile_lite emptySquare ; \
        ::SetBoardTextures "
    foreach i {blite bdark wlite wdark} {
      bind $f.$i <1> "chooseBoardColors $count ; \
          set ::boardfile_dark emptySquare ; \
          set ::boardfile_lite emptySquare ; \
          ::SetBoardTextures "
    }
    grid $f.blite -row 0 -column 0 -sticky e
    grid $f.bdark -row 0 -column 1 -sticky w
    grid $f.wlite -row 1 -column 1 -sticky w
    grid $f.wdark -row 1 -column 0 -sticky e
    grid $f.select -row 2 -column 0 -columnspan 2 ; # -sticky we
    incr count
  }
  
  #########################################################
  set f $w.texture
  set count 0
  set row 0
  set col 0
  foreach tex $::textureSquare {
    set f $w.texture.p$count
    grid [ ttk::frame $f ] -row $row -column $col -padx 5
    canvas $f.c -width [expr $psize*2] -height [expr $psize*2] -background red
    $f.c create image 0 0 -image ${tex}-l -anchor nw
    $f.c create image $psize 0 -image ${tex}-d -anchor nw
    $f.c create image 0 $psize -image ${tex}-d -anchor nw
    $f.c create image $psize $psize -image ${tex}-l -anchor nw
    
    $f.c create image 0 0 -image bp$psize -anchor nw
    $f.c create image $psize 0 -image wp$psize -anchor nw
    $f.c create image 0 $psize -image wp$psize -anchor nw
    $f.c create image $psize $psize -image bp$psize -anchor nw
    ttk::button $f.select -text [expr {$count + 1}] -command "chooseBoardTextures $count"
    bind $f.c <1> "chooseBoardTextures $count"
    pack $f.c $f.select -side top
    
    incr count
    incr col
    if {$col > 4} { set col 0 ; incr row }
  }
  
  dialogbutton $w.buttons.ok -text "OK" -command "
  foreach i {lite dark highcolor bestcolor} {
    set \$i \$newColors(\$i)
  }
  set borderwidth \$newborderwidth
  ::board::border .main.board \$borderwidth
  grab release $w
  destroy $w
  "
  dialogbutton $w.buttons.cancel -text $::tr(Cancel) \
      -command "catch {grab release $w}; destroy $w"
  bind $w <Escape> "catch {grab release $w}; destroy $w"
  packbuttons right $w.buttons.cancel $w.buttons.ok
  chooseBoardColors
  wm resizable $w 0 0
  catch {grab $w}
}

namespace eval ::board {
  
  namespace export sq
  
  # List of square names in order; used by sq procedure.
  variable squareIndex [list a1 b1 c1 d1 e1 f1 g1 h1 a2 b2 c2 d2 e2 f2 g2 h2 \
      a3 b3 c3 d3 e3 f3 g3 h3 a4 b4 c4 d4 e4 f4 g4 h4 \
      a5 b5 c5 d5 e5 f5 g5 h5 a6 b6 c6 d6 e6 f6 g6 h6 \
      a7 b7 c7 d7 e7 f7 g7 h7 a8 b8 c8 d8 e8 f8 g8 h8]
}

# ::board::sq:
#    Given a square name, returns its index as used in board
#    representations, or -1 if the square name is invalid.
#    Examples: [sq h8] == 63; [sq a1] = 0; [sq notASquare] = -1.
#
proc ::board::sq {sqname} {
  variable squareIndex
  return [lsearch -exact $squareIndex $sqname]
}

# ::board::san --
#
#	Convert a square number (0-63) used in board representations
#	to the SAN square name (a1, a2, ..., h8).
#
# Arguments:
#	sqno	square number 0-63.
# Results:
#	Returns square name "a1"-"h8".
#
proc ::board::san {sqno} {
  if {($sqno < 0) || ($sqno > 63)} { return }
  return [format %c%c \
      [expr {($sqno % 8) + [scan a %c]}] \
      [expr {($sqno / 8) + [scan 1 %c]}]]
  
}

# ::board::new
#   Creates a new board in the specified frame.
#
proc ::board::new {w {psize 40} } {
  if {[winfo exists $w]} { return }

  foreach size $::boardSizes {
    if {$size >= $psize} { break }
  }
  set psize $size

  set ::board::_size($w) $psize
  set ::board::_border($w) $::borderwidth
  set ::board::_coords($w) 2
  set ::board::_flip($w) 0
  set ::board::_data($w) [sc_pos board]
  set ::board::_showMarks($w) 0
  set ::board::_mark($w) {}
  set ::board::_drag($w) -1
  set ::board::_showmat($w) 0
  
  set border $::board::_border($w)
  set bsize [expr {$psize * 8 + $border * 9} ]
  set bgcolor [ttk::style lookup Button.label -background]
  
  ttk::frame $w -class Board
  canvas $w.bd -width $bsize -height $bsize -cursor crosshair -background $bgcolor -borderwidth 0 -highlightthickness 0
  catch { grid anchor $w center }
  
  set startrow 5
  grid $w.bd -row [expr $startrow +1] -column 3 -rowspan 8 -columnspan 8
  set bd $w.bd
  
  # Create empty board:
  for {set i 0} {$i < 64} {incr i} {
    set xi [expr {$i % 8} ]
    set yi [expr {int($i/8)} ]
    set x1 [expr {$xi * ($psize + $border) + $border } ]
    set y1 [expr {(7 - $yi) * ($psize + $border) + $border } ]
    set x2 [expr {$x1 + $psize }]
    set y2 [expr {$y1 + $psize }]
    
    $bd create rectangle $x1 $y1 $x2 $y2 -tag sq$i -outline ""
  }
  
  # Set up coordinate labels:
  for {set i 1} {$i <= 8} {incr i} {
    ttk::label $w.lrank$i -text [expr {9 - $i}]
    grid $w.lrank$i -row [expr $startrow + $i] -column 2 -sticky e -padx 5
    ttk::label $w.rrank$i -text [expr {9 - $i}]
    grid $w.rrank$i -row [expr $startrow + $i] -column 11 -sticky w -padx 5
  }
  foreach i {1 2 3 4 5 6 7 8} file {a b c d e f g h} {
    ttk::label $w.tfile$file -text $file
    grid $w.tfile$file -row $startrow -column [expr $i + 2] -sticky s
    ttk::label $w.bfile$file -text $file
    grid $w.bfile$file -row [expr $startrow + 9] -column [expr $i + 2] -sticky n
  }
  
  canvas $w.mat -width 20 -height $bsize -highlightthickness 0 -background $bgcolor
  grid $w.mat -row 6 -column 12 -rowspan 8 -pady 5 -padx 5
  grid remove $w.mat

  ::board::coords $w
  ::board::update $w
  return $w
}

proc ::board::addNamesBar {w {varname}} {
  set bgcolor #fbfbfb
  frame $w.playerW -background $bgcolor
  frame $w.playerW.color -background #EAE0C8 -width 6 -height 6
  canvas $w.playerW.tomove -borderwidth 0 -background $bgcolor -highlightthickness 0 -width 9 -height 9
  label $w.playerW.name -textvariable ${varname}(nameW) -background $bgcolor -font font_SmallBold
  label $w.playerW.elo -textvariable ${varname}(eloW) -background $bgcolor -font font_Small
  label $w.playerW.clock -textvariable ${varname}(clockW) -background $bgcolor -font font_Small
  grid $w.playerW.color -row 0 -column 0 -sticky news -padx 2 -pady 2
  grid $w.playerW.name -row 0 -column 1 -sticky w
  grid $w.playerW.elo -row 0 -column 2 -sticky w
  grid $w.playerW.clock -row 0 -column 3 -sticky e
  grid $w.playerW.tomove -row 0 -column 4 -sticky w -padx 4
  grid columnconfigure $w.playerW 3 -weight 1
  grid $w.playerW -row 16 -column 3 -columnspan 8 -sticky news -pady 4

  frame $w.playerB -background $bgcolor
  frame $w.playerB.color -background black -width 6 -height 6
  canvas $w.playerB.tomove -borderwidth 0 -background $bgcolor -highlightthickness 0 -width 9 -height 9
  label $w.playerB.name -textvariable ${varname}(nameB) -background $bgcolor -font font_SmallBold
  label $w.playerB.elo -textvariable ${varname}(eloB) -background $bgcolor -font font_Small
  label $w.playerB.clock -textvariable ${varname}(clockB) -background $bgcolor -font font_Small
  grid $w.playerB.color -row 0 -column 0 -sticky news -padx 2 -pady 2
  grid $w.playerB.name -row 0 -column 1 -sticky w
  grid $w.playerB.elo -row 0 -column 2 -sticky w
  grid $w.playerB.clock -row 0 -column 3 -sticky e
  grid $w.playerB.tomove -row 0 -column 4 -sticky w -padx 4
  grid columnconfigure $w.playerB 3 -weight 1
  grid $w.playerB -row 3 -column 3 -columnspan 8 -sticky news -pady 4
}

proc ::board::addInfoBar {w varname} {
  ttk::frame $w.bar
  set $w.bar.info [ttk::frame $w.bar.info]
  autoscrollframe $w.bar.info text $w.bar.info.t -relief flat -bg [ttk::style lookup Button.label -background] \
                                                 -font font_Regular -cursor arrow -state disabled
  $w.bar.info.t tag configure header -font font_Bold
  $w.bar.info.t tag bind click <Any-Enter> "$w.bar.info.t configure -cursor hand2"
  $w.bar.info.t tag bind click <Any-Leave> "$w.bar.info.t configure -cursor {}"
  grid propagate $w.bar.info 0
  grid $w.bar.info.t -sticky news
  ttk::button $w.bar.back -image tb_BD_Back -style Toolbutton
  ttk::button $w.bar.cmd -image tb_BD_ShowToolbar -style Toolbutton -command "::board::toggleInfoBar_ $w"
  ttk::button $w.bar.forward -image tb_BD_Forward -style Toolbutton
  set bar_tb [::board::newToolBar_ $w $varname]
  grid $w.bar.back -row 0 -column 0 -sticky news
  grid $w.bar.cmd -in $w.bar -row 0 -column 1 -sticky news -padx 8
  grid $bar_tb -in $w.bar -row 0 -column 2 -sticky ew
  grid remove $bar_tb
  grid $w.bar.info -in $w.bar -row 0 -column 2 -sticky news
  grid $w.bar.forward -row 0 -column 4 -sticky news
  grid columnconfigure $w.bar 2 -weight 1
  grid $w.bar -row 20 -column 3 -columnspan 8 -sticky news -pady 4
}

proc ::board::setInfo {{w} {msg}} {
  toggleInfoBar_ $w "tmpRestore"
  $w.bar.info.t configure -state normal
  $w.bar.info.t delete 1.0 end
  $w.bar.info.t insert end "$msg"
  $w.bar.info.t configure -state disabled
}


proc ::board::setInfoAlert {{w} {header} {msg} {msgcolor} {cmd}} {
  $w.bar.info.t configure -state normal
  $w.bar.info.t delete 1.0 end
  $w.bar.info.t insert end "$header " {header click}
  $w.bar.info.t insert end "$msg" {color click}
  $w.bar.info.t configure -state disabled
  $w.bar.info.t tag configure color -foreground $msgcolor
  $w.bar.info.t tag bind click <ButtonRelease-1> "
    if {[winfo exists $cmd]} {
      after idle \"tk_popup $cmd %X \[expr -10 + %Y - \[winfo reqheight $cmd\] \]\"
    } else {
      $cmd
    }
  "
  toggleInfoBar_ $w "tmpInfo"
}

set ::board::repeatCmd 400
proc ::board::setButtonCmd {{w} {button} {cmd}} {
  if {$cmd == ""} {
    $w.bar.$button configure -state disabled
  } else {
    $w.bar.$button configure -state normal
    ::bind $w.bar.$button <ButtonPress-1> "
      $cmd
      set ::board::repeatCmd \[expr int(\$::board::repeatCmd *0.8)\]
      after \$::board::repeatCmd \"event generate $w.bar.$button <ButtonPress-1>\"
    "
    ::bind $w.bar.$button <Any-Leave> "
      after cancel \"event generate $w.bar.$button <ButtonPress-1>\"
      set ::board::repeatCmd 400
    "
    ::bind $w.bar.$button <ButtonRelease-1> "
      after cancel \"event generate $w.bar.$button <ButtonPress-1>\"
      set ::board::repeatCmd 400
    "
  }
}

proc ::board::toggleInfoBar_ {{w} {action "click"}} {
  set bstate [$w.bar.cmd state]
  if {$action == "tmpInfo" && $bstate == "pressed"} {
      grid remove $w.buttons;
      grid $w.bar.info
  } elseif {($action == "tmpRestore" && $bstate == "pressed") || \
            ($action == "click" && "$w.bar.info" == [grid slaves $w.bar -column 2])} {
      grid remove $w.bar.info;
      grid $w.buttons
      $w.bar.cmd state pressed
  } else {
      grid remove $w.buttons;
      grid $w.bar.info
      $w.bar.cmd state !pressed
  }
}

proc ::board::updateToolBar_ {{menu} {varname} {mb ""} } {
  global "$varname"
  set i [$menu index end]
  while {$i >= 0} {
    set idx -1
    catch { set idx [lindex [$menu entryconfigure $i -image] 4] }
    if {[info exists "${varname}($idx)"] } {
      $menu entryconfigure $i -foreground black -command "eval \$::${varname}($idx)"
    } else {
      catch { $menu entryconfigure $i -foreground gray -command "" }
    }
    incr i -1
  }
  if {$mb != ""} {
    set x [winfo rootx $mb]
    set y [winfo rooty $mb]
    set bh [winfo height $mb]
    set mh [winfo reqheight $menu]
    if {$y >= $mh} { incr y -$mh } { incr y $bh }
    tk_popup $menu $x $y
  }
}

proc ::board::newToolBar_ {{w} {varname}} {
  global "$varname"
  ttk::frame $w.buttons

  set m [menu $w.buttons.menu_back -bg white -font font_Regular]
  $m add command -label "  Go back to mainline" -image tb_BD_BackToMainline -compound left
  $m add command -label "  Leave variant" -image tb_BD_VarLeave -compound left
  $m add command -label "  Go to start" -image tb_BD_Start -compound left -accelerator "<home>"
  ::bind $w.bar.back <ButtonRelease-$::MB3> "::board::updateToolBar_ $m $varname %W"

  set m [menu $w.buttons.menu_forw -bg white -font font_Regular]
  $m add command -label "  Autoplay" -image tb_BD_Autoplay -compound left
  $m add command -label "  Go to end" -image tb_BD_End -compound left -accelerator "<end>"
  ::bind $w.bar.forward <ButtonRelease-$::MB3> "::board::updateToolBar_ $m $varname %W"

  set menus { tb_BD_Changes tb_BD_Comment tb_BD_Variations tb_BD_Layout }
  set i 0
  foreach b $menus {
    menu $w.buttons.menu_$b -bg white -font font_Regular -postcommand "::board::updateToolBar_ $w.buttons.menu_$b $varname"
    ttk::menubutton $w.buttons.$b -style Toolbutton -image $b -menu "$w.buttons.menu_$b" -direction above
    grid $w.buttons.$b -row 0 -column $i -padx 4
    incr i
  }

  set m "$w.buttons.menu_[lindex $menus 0]"
  $m add command -label "  [tr GameAdd]" -image tb_BD_SaveAs -compound left
  $m add command -label "  [tr GameReplace]" -image tb_BD_Save -compound left
  $m add separator
  $m add command -label "  Undo all" -image tb_BD_Revert -compound left
  $m add command -label "  Redo" -image tb_BD_Redo -compound left
  $m add command -label "  Undo" -image tb_BD_Undo -compound left

  set m "$w.buttons.menu_[lindex $menus 1]"
  $m add command -label "  [tr EditSetup]" -image tb_BD_SetupBoard -compound left

  set m "$w.buttons.menu_[lindex $menus 2]"
  $m add command -label "  Delete variant" -image tb_BD_VarDelete -compound left
  $m add command -label "  Promote variant" -image tb_BD_VarPromote -compound left
  $m add command -label "  Leave variant" -image tb_BD_VarLeave -compound left
  $m add command -label "  Go back to mainline" -image tb_BD_BackToMainline -compound left
  $m add separator
  $m add command -label "  Go to start" -image tb_BD_Start -compound left
  $m add command -label "  Go to end" -image tb_BD_End -compound left
  $m add command -label "  Autoplay" -image tb_BD_Autoplay -compound left

  set m "$w.buttons.menu_[lindex $menus 3]"
  $m add command -label "  Rotate" -image tb_BD_Flip -compound left
  $m add command -label "  Show/hide coord" -image tb_BD_Coords -compound left
  $m add command -label "  Show/hide material" -image tb_BD_Material -compound left
  $m add command -label "  Full Screen" -image tb_BD_Fullscreen -compound left
  set ${varname}(tb_BD_Flip) "::board::flip $w"
  set ${varname}(tb_BD_Coords) "::board::coords $w"
  set ${varname}(tb_BD_Material) "::board::toggleMaterial $w"
  set ${varname}(tb_BD_Fullscreen) { wm attributes . -fullscreen [expr ![wm attributes . -fullscreen] ] }

  return $w.buttons
}

proc ::board::flipNames_ { {w} {white_on_top} } {
  if {![winfo exist $w.playerW] } { return }
  if {$white_on_top} {
    grid $w.playerW -row 3
    grid $w.playerB -row 16
  } else {
    grid configure $w.playerW -row 16
    grid configure $w.playerB -row 3
  }
}

proc ::board::sideToMove_ { {w} {side} } {
  if {![winfo exist $w.playerW] } { return }
  if {$side == "w"} {
    $w.playerB.tomove delete -tag tomove
	$w.playerW.tomove create rectangle 0 0 100 100 -fill blue -tag tomove
  } elseif {$side == "b"} {
    $w.playerW.tomove delete -tag tomove
    $w.playerB.tomove create rectangle 0 0 100 100 -fill blue -tag tomove
  }
}

# ::board::defaultColor
#   Returns the color (the value of the global
#   variable "lite" or "dark") depending on whether the
#   specified square number (0=a1, 1=b1, ..., 63=h8) is
#   a light or dark square.
#
proc ::board::defaultColor {sq} {
  return [expr {($sq + ($sq / 8)) % 2 ? "$::lite" : "$::dark"}]
}

# ::board::size
#   Returns the current board size.
#
proc ::board::size {w} {
  return $::board::_size($w)
}

proc ::board::resizeAuto {w bbox} {
  set availw  [lindex $bbox 2]
  set availh  [lindex $bbox 3]
  set extraw  [expr [winfo reqwidth $w]  - $::board::_size($w) * 8]
  set extrah  [expr [winfo reqheight $w] - $::board::_size($w) * 8]
  set availw  [expr $availw - $extraw]
  set availh  [expr $availh - $extrah]
  set maxSize [expr {$availh < $availw ? $availh : $availw}]
  set maxSize [expr $maxSize / 8]

  set newSize 0
  foreach size $::boardSizes {
    if {$size <= $maxSize && $size > $newSize} { set newSize $size }
  }

  return [::board::resize $w $newSize]
}

# ::board::resize
#   Resizes the board. Takes a numeric piece size (which should
#   be in the global boardSizes list variable), or "-1" or "+1".
#   If the size argument is "redraw", the board is redrawn.
#   Returns the new size of the board.
#
proc ::board::resize {w psize} {
  global boardSizes
  
  set oldsize $::board::_size($w)
  if {$psize == $oldsize} { return $oldsize }
  if {$psize == "redraw"} { set psize $oldsize }
  if {$psize == "-1"} {
    set index [lsearch -exact $boardSizes $oldsize]
    if {$index == 0} { return $oldsize }
    incr index -1
    set psize [lindex $boardSizes $index]
  } elseif {$psize == "+1"} {
    set index [lsearch -exact $boardSizes $oldsize]
    incr index
    if {$index == [llength $boardSizes]} { return $oldsize }
    set psize [lindex $boardSizes $index]
  }
  
  # Verify that we have a valid size:
  if {[lsearch -exact $boardSizes $psize] < 0} { return $oldsize }
  
  set border $::board::_border($w)
  set bsize [expr {$psize * 8 + $border * 9} ]
  
  $w.bd configure -width $bsize -height $bsize
  set ::board::_size($w) $psize
  
  # Resize each square:
  for {set i 0} {$i < 64} {incr i} {
    set xi [expr {$i % 8}]
    set yi [expr {int($i/8)}]
    set x1 [expr {$xi * ($psize + $border) + $border }]
    set y1 [expr {(7 - $yi) * ($psize + $border) + $border }]
    set x2 [expr {$x1 + $psize }]
    set y2 [expr {$y1 + $psize }]
    set pos $i
    if {$::board::_flip($w)} { set pos [expr {63 - $i}] }
    $w.bd coords sq$pos $x1 $y1 $x2 $y2
  }

  # resize the material canvas
  $w.mat configure -height $bsize
  
  ::board::update $w
  
  return $psize
}

# ::board::border
#   Get or set the border width.
#   If the optional argument is missing or the empty string, returns
#   the width of the board.
#   Otherwise, the board sqyare borders are set to the specified width.
#
proc ::board::border {w {border ""}} {
  if {$border == ""} {
    return $::board::_border($w)
  } else {
    set ::board::_border($w) $border
    ::board::resize $w redraw
  }
}

# ::board::getSquare
#   Given a board frame and root-window X and Y screen coordinates,
#   returns the square number (0-63) containing that screen location,
#   or -1 if the location is outside the board.
#
proc ::board::getSquare {w x y} {
  if {[winfo containing $x $y] != "$w.bd"} {
    return -1
  }
  set x [expr {$x - [winfo rootx $w.bd]}]
  set y [expr {$y - [winfo rooty $w.bd]}]
  set psize $::board::_size($w)
  set border $::board::_border($w)
  set x [expr {int($x / ($psize+$border))}]
  set y [expr {int($y / ($psize+$border))}]
  
  if {$x < 0  ||  $y < 0  ||  $x > 7  ||  $y > 7} {
    set sq -1
  } else {
    set sq [expr {(7-$y)*8 + $x}]
    if {$::board::_flip($w)} { set sq [expr {63 - $sq}] }
  }
  return $sq
}

# ::board::showMarks
#   Turns on/off the showing of marks (colored squares).
#
proc ::board::showMarks {w value} {
  set ::board::_showMarks($w) $value
}

# ::board::colorSquare
#   Colors the specified square (0-63) of the board.
#   If the color is the empty string, the appropriate
#   color for the square (light or dark) is used.
#
proc ::board::colorSquare {w i {color ""}} {
  if {$i < 0  ||  $i > 63} { return }
  if {$color != ""} {
    $w.bd itemconfigure br$i -state hidden
  } else {
    set color [::board::defaultColor $i]
    set brstate "normal"
    if { $::glossOfDanger } {
      array set attacks [sc_pos attacks]
      if {[info exists attacks($i)]} {
        set color $attacks($i)
      }
    }
    foreach mark $::board::_mark($w) {
      if {[lindex $mark 1] == $i && [lindex $mark 0] == "full"} {
        set color [lindex $mark 3]
        set brstate "hidden"        
      }
    }
    $w.bd itemconfigure br$i -state $brstate
  }
  $w.bd itemconfigure sq$i -fill $color -outline ""  
}

# ::board::midSquare
#   Given a board and square number, returns the canvas X/Y
#   coordinates of the midpoint of that square.
#
proc ::board::midSquare {w sq} {
  set c [$w.bd coords sq$sq]
  #Klimmek: calculation change, because some sizes are odd and then some squares are shifted by 1 pixel
  # set x [expr {([lindex $c 0] + [lindex $c 2]) / 2} ]
  # set y [expr {([lindex $c 1] + [lindex $c 3]) / 2} ]
  set psize $::board::_size($w)
  if { $psize % 2 } { set psize [expr {$psize - 1}] }
  set x [expr {[lindex $c 0] + $psize/2} ]
  set y [expr {[lindex $c 1] + $psize/2} ]
  return [list $x $y]
}


# ::board::setmarks --
#
#	Set the marks for the board:
#	colored squares, arrows, circles, etc.
#
# Arguments:
#	w	A frame containing a board '$win.bd'.
#       cmds    Commands to draw the marks
# Results:
#	Sets ::board::_mark($w) with all the right formatted commands.
#       Marks will be drawn by ::board::update
#	Returns nothing.
#
proc ::board::setmarks {w cmds} {
  set ::board::_mark($w) {}
  foreach {cmd discard} [mark::getEmbeddedCmds $cmds] {
    lset cmd 1 [::board::sq [lindex $cmd 1]]
    set dest [::board::sq [lindex $cmd 2]]
    if {$dest != -1} {lset cmd 2 $dest}
    lappend ::board::_mark($w) $cmd
  }
}

### Namespace ::board::mark

namespace eval ::board::mark {
  namespace import [namespace parent]::sq
  
  # Regular expression constants for
  # matching Scid's embedded commands in PGN files.
  
  variable StartTag {\[%}
  variable ScidKey  {mark|arrow}
  variable Command  {draw}
  variable Type     {full|square|arrow|circle|disk|tux}
  variable Text     {[-+=?!A-Za-z0-9]}
  variable Square   {[a-h][1-8]\M}
  variable Color    {[\w#][^]]*\M}	;# FIXME: too lax for #nnnnnn!
  variable EndTag   {\]}
  
  # Current (non-standard) version:
  variable ScidCmdRegex \
      "$StartTag              # leading tag
  ($ScidKey)\\\ +        # (old) command name + space chars
  ($Square)              # mandatory square (e.g. 'a4')
  (?:\\ +($Square))?     # optional: another (destination) square
  (?:\\ *($Color))?      # optional: color name
  $EndTag                # closing tag
  "
  # Proposed new version, according to the
  # PGN Specification and Implementation Guide (Supplement):
  variable StdCmdRegex \
      "${StartTag}            # leading tag
  ${Command}             # command name
  \\                     # a space character
  (?:(${Type}|$Text),)?  # keyword, e.g. 'arrow' (may be omitted)
  # or single char (indicating type 'text')
  ($Square)              # mandatory square (e.g. 'a4')
  (?:,($Square))?        # optional: (destination) square
  (?:,($Color))?         # optional: color name
  $EndTag                # closing tag
  "

  # ChessBase' syntax for markers and arrows
  variable CBSquare    {csl}
  variable CBarrow     {cal}
  variable CBColor     {[GRY]}
  variable Square      {[a-h][1-8]\M}
  variable sqintern    {[a-h][1-8]}

  variable CBSquareRegex \
     "$StartTag
     ($CBSquare)\\\ +
     ($CBColor)
     ($Square)
     (?:,($CBColor)($Square))?
     $EndTag
     "

  variable CBArrowRegex \
     "$StartTag
     ($CBarrow)\\\ +
     ($CBColor)
     ($sqintern)
     ($sqintern)
     $EndTag
     "
}

# ::board::mark::getEmbeddedCmds --
#
#	Scans a game comment string and extracts embedded commands
#	used by Scid to mark squares or draw arrows.
#
# Arguments:
#	comment     The game comment string, containing
#	            embedded commands, e.g.:
#	            	[%mark e4 green],
#	            	[%arrow c4 f7],
#	            	[%draw e4],
#	            	[%draw circle,f7,blue].
# Results:
#	Returns a list of embedded Scid commands,
#		{command indices ?command indices...?},
#	where 'command' is a list representing the embedded command:
#		'{type square ?arg? color}',
#		e.g. '{circle f7 red}' or '{arrow c4 f7 green}',
#	and 'indices' is a list containing start and end position
#	of the command string within the comment.
#
proc ::board::mark::getEmbeddedCmds {comment} {
  if {$comment == ""} {return}
  variable ScidCmdRegex
  variable StdCmdRegex
  variable CBSquareRegex
  variable CBArrowRegex
  set result {}
  
  # Build regex and search script for embedded commands:
  set regex  ""
  foreach r [list $ScidCmdRegex $StdCmdRegex $CBSquareRegex $CBArrowRegex] {
    if {[string equal $regex ""]} {set regex $r} else {append regex "|$r"}
  }
  set locateScript  {regexp -expanded -indices -start $start \
        $regex $comment indices}
  
  # Loop over all embedded commands contained in comment string:
  
  for {set start 0} {[eval $locateScript]} {incr start} {
    foreach {first last} $indices {}	;# just a multi-assign
    foreach re [list $ScidCmdRegex $StdCmdRegex $CBSquareRegex $CBArrowRegex] {
      # Passing matching subexpressions to variables:
      if {![regexp -expanded $re [string range $comment $first $last] \
            match type arg1 arg2 color]} {
        continue
      }
      # CB uses rotated arguments. Bring them in order
      if {[string equal $type "csl"] || [string equal $type "cal"]} {
         set dummy1 $arg1
         set dummy2 $arg2
         set dummy3 $color
         set color $dummy1
         set arg1  $dummy2
         set arg2  $dummy3
         if {[string equal $type "csl"]} {set type  "full"  }
         if {[string equal $type "cal"]} {set type  "arrow" }
         if {[string equal $color "R"]}  {set color "red"   }
         if {[string equal $color "G"]}  {set color "green" }
         if {[string equal $color "Y"]}  {set color "yellow"}
      }
      # Settings of (default) type and arguments:
      if {[string equal $color ""]}   { set color "red" }
      switch -glob -- $type {
        ""   {set type [expr {[string length $arg2] ? "arrow" : "full"}]}
        mark {set type "fu"	;# new syntax}
        ?    {if {[string length $arg2]} break else {
            set arg2 $type; set type "text"}
        }
      }
      # Construct result list:
      lappend result [list $type $arg1 $arg2 $color]
      lappend result $indices
      set start $last	;# +1 by for-loop
    }
  }
  return $result
}

# ::board::mark::remove --
#
#	Removes a specified mark.
#
# Arguments:
#	win	A frame containing a board '$win.bd'.
#	args	List of one or two squares.
# Results:
#	Appends a dummy mark to the bord's list of marks
#	which causes the add routine to delete all marks for
#	the specified square(s).
#
proc ::board::mark::remove {win args} {
  if {[llength $args] == 2} {
    eval add $win arrow $args nocolor 1
  } else {
    add $win DEL [lindex $args 0] "" nocolor 1
  }
}

# ::board::mark::add --
#
#	Draws arrow or mark on the specified square(s).
#
# Arguments:
#	win		A frame containing a board 'win.bd'.
#	args		What kind of mark:
#	  type  	  Either type id (e.g., square, circle) or
#			    a single character, which is of type 'text'.
#	  square	  Square number 0-63 (0=a1, 1=a2, ...).
#	  ?arg2?	  Optional: additional type-specific parameter.
#	  color 	  Color to use for marking the square (mandatory).
#	  ?new? 	  Optional: whether or not this mark should be
#			    added to the list of marks; defaults to 'true'.
# Results:
#	For a given square, mark type, color, and optional (type-specific)
#	destination arguments, creates the proper canvas object.
#
proc ::board::mark::add {win args} {
  # Rearrange list if "type" is simple character:
  if {[string length [lindex $args 0]] == 1} {
    # ... e.g.,  {c e4 red} --> {text e4 c red}
    set args [linsert $args 1 "text"]
    set args [linsert [lrange $args 1 end] 2 [lindex $args 0]]
  }
  # Add default arguments:
  if {![regexp true|false|1|0 [lindex $args end]]} {
    lappend args "true"
  }
  if {[llength $args] == 4} { set args [linsert $args 2 ""]}
  
  # Here we (should) have: args == <type> <square> ?<arg>? <color> <new>
  foreach {type square dest color new} $args {break}	;# assign
  if {[llength $args] != 5 } { return }
  
  set board $win.bd
  set type  [lindex $args 0]
  
  # Remove existing marks:
  if {$type == "arrow"} {
    $board delete "mark${square}:${dest}" "mark${dest}:${square}"
    if {[string equal $color "nocolor"]} { set type DEL }
  } else {
    $board delete "mark${square}"
    #not needed anymore
    #    ::board::colorSquare $win $square [::board::defaultColor $square]
  }
  
  switch -- $type {
    full    { ::board::colorSquare $win $square $color }
    DEL     { set new 1 }
    default {
      # Find a subroutine to draw the canvas object:
      set drawingScript "Draw[string totitle $type]"
      if {![llength [info procs $drawingScript]]} { return }
      
      # ... and try it:
      if {[catch {eval $drawingScript $board $square $dest $color}]} {
        return
      }
    }
  }
  if {$new} { lappend ::board::_mark($win) [lrange $args 0 end-1] }
}

# ::board::mark::DrawXxxxx --
#
#	Draws specified canvas object,
#	where "Xxxxx" is some required type, e.g. "Circle".
#
# Arguments:
#	pathName	Name of the canvas widget.
#	args		Type-specific arguments, e.g.
#				<square> <color>,
#				<square> <square> <color>,
#				<square> <char> <color>.
# Results:
#	Constructs and evaluates the proper canvas command
#	    "pathName create type coordinates options"
#	for the specified object.
#

# ::board::mark::DrawCircle --
#
proc ::board::mark::DrawCircle {pathName square color} {
  # Some "constants":
  set size 0.6	;# inner (enclosing) box size, 0.0 <  $size < 1.0
  set width 0.1	;# outline around circle, 0.0 < $width < 1.0
  
  set box [GetBox $pathName $square $size]
  lappend pathName create oval [lrange $box 0 3] \
      -tag [list mark circle mark$square p$square]
  if {$width > 0.5} {
    ;# too thick, draw a disk instead
    lappend pathName -fill $color
  } else {
    set width [expr {[lindex $box 4] * $width}]
    if {$width <= 0.0} {set width 1.0}
    lappend pathName -fill "" -outline $color -width $width
  }
  eval $pathName
}

# ::board::mark::DrawDisk --
#
proc ::board::mark::DrawDisk {pathName square color} {
  # Size of the inner (enclosing) box within the square:
  set size 0.6	;# 0.0 <  $size < 1.0 = size of rectangle

  set box [GetBox $pathName $square $size]
  eval $pathName \
      {create oval [lrange $box 0 3]} \
      -fill $color \
      {-tag [list mark disk mark$square p$square]}
}

# ::board::mark::DrawText --
# Pascal Georges : if shadow!="", try to make the text visible even if fg and bg colors are close
proc ::board::mark::DrawText {pathName square char color {size 0} {shadowColor ""}} {
  set box [GetBox $pathName $square 0.8]
  set len [expr {($size > 0) ? $size : int([lindex $box 4])}]
  set x   [lindex $box 5]
  set y   [lindex $box 6]
  $pathName delete text$square mark$square
  if {$shadowColor!=""} {
    eval $pathName \
        create text [expr $x+1] [expr $y+1] -fill $shadowColor \
        {-font [list helvetica $len bold]} \
        {-text [string index $char 0]}     \
        {-anchor c} \
        {-tag  [list mark text text$square mark$square p$square]}
    
  }
  eval $pathName \
      create text $x $y -fill $color     \
      {-font [list helvetica $len bold]} \
      {-text [string index $char 0]}     \
      {-anchor c} \
      {-tag  [list mark text text$square mark$square p$square]}
}

# ::board::mark::DrawArrow --
#
proc ::board::mark::DrawArrow {pathName from to color} {
  if {$from < 0  ||  $from > 63} { return }
  if {$to   < 0  ||  $to   > 63} { return }
  set coord [GetArrowCoords $pathName $from $to]
  eval $pathName \
      {create line $coord} \
      -fill $color -arrow last -width 2 \
      {-tag [list mark arrows "mark${from}:${to}"]}
}

# ::board::mark::DrawRectangle --
# Draws a rectangle surrounding the square
proc ::board::mark::DrawRectangle { pathName square color pattern } {
  if {$square < 0  ||  $square > 63} { return }
  set box [::board::mark::GetBox $pathName $square]
  $pathName create rectangle [lindex $box 0] [lindex $box 1] [lindex $box 2] [lindex $box 3] \
      -outline $color -width $::highlightLastMoveWidth -dash $pattern -tag highlightLastMove
}

# ::board::mark::DrawTux --
#
image create photo tux16x16 -data \
    {R0lGODlhEAAQAPUyAAAAABQVFiIcBi0tLTc0Kj4+PkQ3CU9ADVVFD1hJFV1X
      P2pXFWJUKHttLnttOERERVVWWWRjYWlqcYNsGJR5GrSUIK6fXsKdGMCdI8er
      ItCuNtm2KuS6KebAKufBOvjJIfnNM/3TLP/aMP/lM+/We//lQ//jfoGAgJaU
      jpiYmqKipczBmv/wk97e3v//3Ojo6f/96P7+/v///wAAAAAAAAAAAAAAAAAA
      AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEBADIALAAAAAAQABAAAAbm
      QJlMJpMBAAAAQCaTyWQymUwmAwQAAQAAIJPJZDKZTCYDQCInCQAgk8lkMplM
      JgMwOBoHACCTyYAymUwmkwEao5IFAADIZDKZTCaTAVQu2GsAAMhkMplMJgMU
      YrFY7AQAAGQymUwmA6RisVjsFQAAATKZTCYDBF6xWCwWewAAAJlMJjMoYrFY
      LBaDAAAAmUwW+oBWsVgsxlokFgCZTBYChS6oWCxmAn5CHYNMJhOJQiFS7JXS
      iEQjCkAmw3BCow0hAMiMNggAQCYDAAyTAwAASEwEAABAJpPJAAAAAACUAQAA
      gEwmCwIAOw==}
set ::board::mark::tux16x16 tux16x16

image create photo tux32x32 -data \
    {R0lGODlhIAAgAPU0AAAAABANAxERESAaBiwkCDAnCSQkJEM2DEA3GVBBDllJ
      EFNKLG5aFHBbFHpkFnZoMkBAQFBQUGBgYHBwcIBpF4xyGZ+DHZ+GKqmKHq+T
      Lb+hNsynJNSuJtu0J9+6NeW8Kc+wQPnMLPTJMP7QLv/UO//aVf/dYv/ifIiI
      hp+fn6+vr7+/v//lif/ol//rpM/Pz9/f3//22O/u6v/55f///////wAAAAAA
      AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEBADUALAAAAAAgACAAAAb+
      wFqtVqvVarVarQYAAAAAAABQq9VqtVqtVqvVarVarVar1Wq1Wg0AAAAAAAAA
      AKjVarVarVar1YC1Wq1Wq9VqtVqtBgAAAAAAAAAAAGq1Wq1Wq9VqtVqtVqvV
      arVaDQAAAAAAAAAAAABqtVqtVqsBa7VarVar1Wq1Wq0GMMgighdtAgAAALVa
      rVar1Wq1Wq1Wq9VqtVqtBphEUpCUQQUAAAC1Wq1WA9ZqtVqtVqvVarVarVYD
      RBYejwahAgAAgFqtVqvVarVarVar1Wq1Wq1WAxRIIdFolAEAAABArQas1Wq1
      Wq1Wq9VqtVqtVqvVGqPRaDTSAAAAAKBWq9VqtVr+rVar1Wq1Wq1Wq9UMp9Fo
      xJIJAAAAAFir1Wq1Wq1Wq9VqtVqtVqvVABGaqzWj0SYAAAAAqNVqtVqtVqvV
      arVarVarAQQyGo1Go9FgAAAQAAAAarVarVar1Wq1Wq1WqwEAExqNRqPRaDSD
      AAAAAGq1Wq1Wq9VqtVqtVqsBAC8ajUaj0Wg0oAoAAAAAgFqtVqvVarVarVar
      AQACGo1Go9FoNBpNAAAAAIBarVar1Wq1Wq1WqwEAKhqNRqPRaEAajYYCAAAA
      AKBWq9VqtVqtVqvVAAIajUaj0Wg0Go22AgAAAACgVqvVarVarVarAQARGo1G
      o9GANBqNRpMBAAAAAAD+qNVqtVqtVqvVAAAUjUaj0Wg0Go1GowkAAAAAAKjV
      arVarVar1QgUFI1GowFpNBqNRqPRDAZDAAAA1Gq1Wq1Wq9VGo1HpRaPRaDQa
      jUY7iQAAwUMBANRqtVqtVhuFRqPR6LIC0mg0Go1Go5lGiYBlVAEAarVarVar
      jUaj0Wg0KqRoNBqNRqOZRqPRaPQBAGq1Wq1Wq41Go9FoBBxtADIajUaj0Uyj
      0Wg0Gn0YgFqtVqvVRqPRaDQajVw0Go1Go6VGo9FoNBqNOABArVar1Uaj0Qg4
      Go1GoxiNRntFBqPRaDQajT4KAKBWq9Vqo9FoNBqNRiOHASIAAAqj0Wg0CmGW
      AAAAoFar1WoYDlAUGo1Go1FFAAAAAInRaDT6EAAAAABQq9VqNQAAAHB0QqNO
      AQAAAACA0Gi0AQAAAECtVqvVajUgAAAAAAAAAAAAAAAAAAAAAAAAAIBarVar
      1Wq1Wq1WqwEAAAAAAKjVarUaAAAAAAC1Wq1Wq9VqwFqtVqvVarVarVar1Wq1
      Wq1Wq9VqtVqtVqvVarUgADs=
    }
set ::board::mark::tux32x32 tux32x32

proc ::board::mark::DrawTux {pathName square discard} {
  variable tux16x16
  variable tux32x32
  set box [::board::mark::GetBox $pathName $square]
  for {set len [expr {int([lindex $box 4])}]} {$len > 0} {incr len -1} {
    if {[info exists tux${len}x${len}]} break
  }
  if {!$len} return
  $pathName create image [lrange $box 5 6] \
      -image tux${len}x${len} \
      -tag [list mark "mark$square" tux]
}

# ::board::mark::GetArrowCoords --
#
#	Auxiliary function:
#	Similar to '::board::midSquare', but this function returns
#	coordinates of two (optional adjusted) squares.
#
# Arguments:
#	board	A board canvas ('win.bd' for a frame 'win').
#	from	Source square number (0-63).
#	to	Destination square number (0-63).
#	shrink	Optional shrink factor (0.0 - 1.0):
#		  0.0 = no shrink, i.e. just return midpoint coordinates,
#		  1.0 = start and end at edge (unless adjacent squares).
# Results:
#	Returns a list of coordinates {x1 y1 x2 y2} for drawing
#	an arrow "from" --> "to".
#
proc ::board::mark::GetArrowCoords {board from to {shrink 0.6}} {
  if {$shrink < 0.0} {set shrink 0.0}
  if {$shrink > 1.0} {set shrink 1.0}
  
  # Get left, top, right, bottom, length, midpoint_x, midpoint_y:
  set fromXY [GetBox $board $from]
  set toXY   [GetBox $board $to]
  # Get vector (dX,dY) = to(x,y) - from(x,y)
  # (yes, misusing the foreach multiple features)
  foreach {x0 y0} [lrange $fromXY 5 6] {x1 y1} [lrange $toXY 5 6] {break}
  set dX [expr {$x1 - $x0}]
  set dY [expr {$y1 - $y0}]
  
  # Check if we have good coordinates and shrink factor:
  if {($shrink == 0.0) || ($dX == 0.0 && $dY == 0.0)} {
    return [list $x0 $y0 $x1 $y1]
  }
  
  # Solve equation: "midpoint + (lambda * vector) = edge point":
  if {abs($dX) > abs($dY)} {
    set edge [expr {($dX > 0) ? [lindex $fromXY 2] : [lindex $fromXY 0]}]
    set lambda [expr {($edge - $x0) / $dX}]
  } else {
    set edge [expr {($dY > 0) ? [lindex $fromXY 3] : [lindex $fromXY 1]}]
    set lambda [expr {($edge - $y0) / $dY}]
  }
  
  # Check and adjust shrink factor for adjacent squares
  # (i.e. don't make arrows too short):
  set maxShrinkForAdjacent 0.667
  if {$shrink > $maxShrinkForAdjacent} {
    set dFile [expr {($to % 8) - ($from % 8)}]
    set dRank [expr {($from / 8) - ($to / 8)}]
    if {(abs($dFile) <= 1) && (abs($dRank) <= 1)} {
      set shrink $maxShrinkForAdjacent
    }
  }
  
  # Return shrinked line coordinates {x0', y0', x1', y1'}:
  set shrink [expr {$shrink * $lambda}]
  return [list [expr {$x0 + $shrink * $dX}] [expr {$y0 + $shrink * $dY}]\
      [expr {$x1 - $shrink * $dX}] [expr {$y1 - $shrink * $dY}]]
}

# ::board::mark::GetBox --
#
#	Auxiliary function:
#	Get coordinates of an inner box for a specified square.
#
# Arguments:
#	pathName	Name of a canvas widget containing squares.
#	square		Square number (0..63).
#	portion		Portion (length inner box) / (length square)
#			(1.0 means: box == square).
# Results:
#	Returns a list whose elements are upper left and lower right
#	corners, length, and midpoint (x,y) of the inner box.
#
proc ::board::mark::GetBox {pathName square {portion 1.0}} {
  set coord [$pathName coords sq$square]
  set len [expr {[lindex $coord 2] - [lindex $coord 0]}]
  if {$portion < 1.0} {
    set dif [expr {$len * (1.0 -$portion) * 0.5}]
    foreach i {0 1} { lappend box [expr {[lindex $coord $i] + $dif}] }
    foreach i {2 3} { lappend box [expr {[lindex $coord $i] - $dif}] }
  } else {
    set box $coord
  }
  lappend box [expr { [lindex $box 2] - [lindex $box 0]     }]
  lappend box [expr {([lindex $box 0] + [lindex $box 2]) / 2}]
  lappend box [expr {([lindex $box 1] + [lindex $box 3]) / 2}]
  return $box
}

### End of namespace ::board::mark

# ::board::piece {w sq}
#   Given a board and square number, returns the piece type
#   (e for empty, wp for White Pawn, etc) of the square.
proc ::board::piece {w sq} {
  set p [string index $::board::_data($w) $sq]
  return $::board::letterToPiece($p)
}

# ::board::setDragSquare
#   Sets the square from whose piece should be dragged.
#   To drag nothing, the square value should be -1.
#   If the previous value is a valid square (0-63), the
#   piece being dragged is returned to its home square first.
#
proc ::board::setDragSquare {w sq} {
  set oldSq $::board::_drag($w)
  if {$oldSq >= 0  &&  $oldSq <= 63} {
    ::board::drawPiece $w $oldSq [string index $::board::_data($w) $oldSq]
    $w.bd raise arrows
  }
  set ::board::_drag($w) $sq
  return $oldSq
}

proc ::board::getDragSquare {w} {
  return $::board::_drag($w)
}


# ::board::dragPiece
#   Drags the piece of the drag-square (as set above) to
#   the specified global (root-window) screen coordinates.
#
proc ::board::dragPiece {w x y} {
  set sq $::board::_drag($w)
  if {$sq < 0} { return }
  set x [expr {$x - [winfo rootx $w.bd]} ]
  set y [expr {$y - [winfo rooty $w.bd]} ]
  $w.bd coords p$sq $x $y
  $w.bd raise p$sq
}

# ::board::bind
#   Binds the given event on the given square number to
#   the specified action.
#
proc ::board::bind {w sq event action} {
  if {$sq == "all"} {
    for {set i 0} {$i < 64} {incr i} {
      $w.bd bind p$i $event $action
    }
  } else {
    $w.bd bind p$sq $event $action
  }
}

# ::board::drawPiece
#   Draws a piece on a specified square.
#
proc ::board::drawPiece {w sq piece} {
  set psize $::board::_size($w)
  set flip $::board::_flip($w)
  # Compute the XY coordinates for the centre of the square:
  set midpoint [::board::midSquare $w $sq]
  set xc [lindex $midpoint 0]
  set yc [lindex $midpoint 1]
  # Delete any old image for this square, and add the new one:
  $w.bd delete p$sq
  $w.bd create image $xc $yc -image $::board::letterToPiece($piece)$psize -tag p$sq
}

# ::board::clearText
#   Remove all text annotations from the board.
#
proc ::board::clearText {w} {
  $w.bd delete texts
}

# ::board::drawText
#   Draws the specified text on the specified square.
#   Additional arguments are treated as canvas text parameters.
#
proc ::board::drawText {w sq text color args {shadow ""} } {
  mark::DrawText ${w}.bd $sq $text $color \
      [expr {[catch {font actual font_Bold -size} size] ? 11 : $size}] \
      $shadow
  #if {[llength $args] > 0} {
  #  catch {eval $w.bd itemconfigure text$sq $args}
  #}
}

# Highlight last move played by drawing a red rectangle around the two squares
proc  ::board::lastMoveHighlight {w} {
  $w.bd delete highlightLastMove
  if { ! $::highlightLastMove } {return}
  set moveuci [ sc_game info previousMoveUCI ]
  if {[string length $moveuci] >= 4} {
    set moveuci [ string range $moveuci 0 3 ]
    set square1 [ ::board::sq [string range $moveuci 0 1 ] ]
    set square2 [ ::board::sq [string range $moveuci 2 3 ] ]
    ::board::mark::DrawRectangle $w.bd $square1 $::highlightLastMoveColor $::highlightLastMovePattern
    ::board::mark::DrawRectangle $w.bd $square2 $::highlightLastMoveColor $::highlightLastMovePattern
    if { ! $::arrowLastMove } {return} 
    ::board::mark::DrawArrow $w.bd $square1 $square2 $::highlightLastMoveColor
  }
}

# ::board::update
#   Update the board given a 64-character board string as returned
#   by the "sc_pos board" command. If the board string is empty, it
#   defaults to the previous value for this board.
#   If the optional parameter "animate" is 1 and the changes from
#   the previous board state appear to be a valid chess move, the
#   move is animated.
#
proc ::board::update {w {board ""} {animate 0}} {
  set oldboard $::board::_data($w)
  if {$board == ""} {
    set board $::board::_data($w)
  } else {
    set ::board::_data($w) $board
  }
  set psize $::board::_size($w)

  # Cancel any current animation:
  after cancel "::board::_animate $w"
  
  # Remove all marks (incl. arrows) from the board:
  $w.bd delete mark
  
  # Draw each square:
  for {set sq 0} { $sq < 64 } { incr sq } {
    set piece [string index $board $sq]
    # Compute the XY coordinates for the centre of the square:
    set midpoint [::board::midSquare $w $sq]
    set xc [lindex $midpoint 0]
    set yc [lindex $midpoint 1]
    #update every square with color and texture
    set color [::board::defaultColor $sq]
    $w.bd itemconfigure sq$sq -fill $color -outline "" ; #-outline $color
    
    set boc bgd$psize
    if { ($sq + ($sq / 8)) % 2 } { set boc bgl$psize }
    $w.bd delete br$sq
    $w.bd create image $xc $yc -image $boc -tag br$sq
    
    # Delete any old image for this square, and add the new one:
    $w.bd delete p$sq
    $w.bd create image $xc $yc -image $::board::letterToPiece($piece)$psize -tag p$sq
  }
  
  # Update side-to-move icon:
  ::board::sideToMove_ $w [string index $::board::_data($w) 65]
  
  # Gloss Of Danger:
  if { $::glossOfDanger } {
    foreach {sq col} [sc_pos attacks] {
      ::board::colorSquare $w $sq $col
    }
  }

  # Redraw marks and arrows if required:
  if {$::board::_showMarks($w)} {
    foreach mark $::board::_mark($w) {
      set type  [lindex $mark 0]
      if {$type == "full"}    { 
        ::board::colorSquare $w [lindex $mark 1] [lindex $mark 3]
      } else {
        # Find a subroutine to draw the canvas object:
        set drawingScript "mark::Draw[string totitle $type]"
        if {[llength [info procs $drawingScript]]} {
          catch {eval $drawingScript $w.bd [join [lrange $mark 1 3]]}  
        }
      }
    } 
  }
  
  # Redraw last move highlight if mainboard
  if { $w == ".main.board"} {
    ::board::lastMoveHighlight $w
  }
  
  # Redraw material values
  if {$::board::_showmat($w)} {
      ::board::material $w
  }
  
  # Animate board changes if requested:
  if {$animate  &&  $board != $oldboard} {
    ::board::animate $w $oldboard $board
  }
}

proc ::board::isFlipped {w} {
  return $::board::_flip($w)
}

# ::board::flipAuto
#   Sometimes SCID wants to automatically rotate the board,
#   i.e. when playing a game or loading a game with the "FlipB" flag set.
#   This function flip the board, but allow to restore the last state
#   (rotated, not rotated) selected by the user
#   @newstate:  0 ->white bottom
#               1 ->black bottom
#              -1 ->restore previous state
#
proc ::board::flipAuto {w {newstate -1}} {
  if {$newstate == -1} {
    if {[info exists ::board::flipAuto_($w)]} {::board::flip $w $::board::flipAuto_($w)}
    return
  }
  set tmp $::board::_flip($w)
  if {[info exists ::board::flipAuto_($w)]} { set tmp $::board::flipAuto_($w) }
  ::board::flip $w $newstate
  set ::board::flipAuto_($w) $tmp
}

# ::board::flip
#   Rotate the board 180 degrees.
#
proc ::board::flip {w {newstate -1}} {
  if {! [info exists ::board::_flip($w)]} { return }
  catch {unset ::board::flipAuto_($w)}
  if {$newstate == $::board::_flip($w)} { return }
  set flip [expr {1 - $::board::_flip($w)} ]
  set ::board::_flip($w) $flip
  
  # Swap squares:
  for {set i 0} {$i < 32} {incr i} {
    set swap [expr {63 - $i}]
    set coords(South) [$w.bd coords sq$i]
    set coords(North) [$w.bd coords sq$swap]
    $w.bd coords sq$i    $coords(North)
    $w.bd coords sq$swap $coords(South)
  }
  
  # Change coordinate labels:
  for {set i 1} {$i <= 8} {incr i} {
    set value [expr {9 - [$w.lrank$i cget -text]} ]
    $w.lrank$i configure -text $value
    $w.rrank$i configure -text $value
  }
  if {$flip} {
    foreach file {a b c d e f g h} newvalue {h g f e d c b a} {
      $w.tfile$file configure -text $newvalue
      $w.bfile$file configure -text $newvalue
    }
  } else {
    foreach file {a b c d e f g h} {
      $w.tfile$file configure -text $file
      $w.bfile$file configure -text $file
    }
  }
  ::board::flipNames_ $w $flip
  ::board::update $w
  return $w
}
################################################################################
# ::board::material
# displays material balance
################################################################################
proc ::board::material {w} {
  set f $w.mat
  
  $f delete material
  
  set fen [lindex [sc_pos fen] 0]
  set p 0
  set n 0
  set b 0
  set r 0
  set q 0
  for {set i 0} {$i < [string length $fen]} {incr i} {
    set ch [string index $fen $i]
    switch -- $ch {
      p {incr p -1}
      P {incr p}
      n {incr n -1}
      N {incr n}
      b {incr b -1}
      B {incr b}
      r {incr r -1}
      R {incr r}
      q {incr q -1}
      Q {incr q}
    }
  }
  set sum [expr abs($p) + abs($n) +abs($b) +abs($r) +abs($q) ]
  set rank 0

  foreach pType {q r b n p} {
    set count [expr "\$$pType"]
    if {$count < 0} {
      addMaterial $count $pType $f $rank $sum
      incr rank [expr abs($count) ]
    }
  }
  foreach pType {q r b n p} {
    set count [expr "\$$pType"]
    if {$count > 0} {
      addMaterial $count $pType $f $rank $sum
      incr rank [expr abs($count) ]
    }
  }
}
proc ::board::addMaterial {count piece parent rank sum} {
  if {$count == 0} {return}
  if {$count <0} {
    set col "b"
    set count [expr 0 - $count ]
  } else  {
    set col "w"
  }
  set w [$parent cget -width]
  set h [$parent cget -height]
  set offset [expr ($h - ($sum * 20)) / 2]
  if {$offset <0} { set offset 0 }
  set x [expr $w / 2]
  for {set i 0} {$i<$count} {incr i} {
    set y [expr $rank * 20 +10 + $offset + $i * 20]
    $parent create image $x $y -image $col${piece}20 -tag material
  }
}
proc ::board::toggleMaterial {w} {
  set ::board::_showmat($w) [expr {1 - $::board::_showmat($w)}]
  if {$::board::_showmat($w)} {
    grid $w.mat
  } else {
    grid remove $w.mat
  }
  ::board::update $w
  return $::board::_showmat($w)
}

################################################################################
#
################################################################################

# ::board::coords
#   Add or remove coordinates around the edge of the board.
# Toggle between 0,1,2.
proc ::board::coords {w} {
  set coords [expr {1 + $::board::_coords($w)} ]
  if { $coords > 2 } { set coords 0 }
  set ::board::_coords($w) $coords
  
  if {$coords == 0 } {
    for {set i 1} {$i <= 8} {incr i} {
      grid remove $w.lrank$i
      grid remove $w.rrank$i
    }
    foreach i {a b c d e f g h} {
      grid remove $w.tfile$i
      grid remove $w.bfile$i
    }
  } elseif {$coords == 1 } {
    for {set i 1} {$i <= 8} {incr i} {
      grid configure $w.lrank$i
      grid remove $w.rrank$i
    }
    foreach i {a b c d e f g h} {
      grid remove $w.tfile$i
      grid configure $w.bfile$i
    }
  } else { #Klimmek: coords == 2 then show left and bottom
    for {set i 1} {$i <= 8} {incr i} {
      grid configure $w.lrank$i
      grid configure $w.rrank$i
    }
    foreach i {a b c d e f g h} {
      grid configure $w.tfile$i
      grid configure $w.bfile$i
    }
  }

  return $coords
}

# ::board::animate
#   Check for board changes that appear to be a valid chess move,
#   and start animating the move if applicable.
#
proc ::board::animate {w oldboard newboard} {
  global animateDelay
  if {$animateDelay <= 0} { return }
  
  # Find which squares differ between the old and new boards:
  set diffcount 0
  set difflist [list]
  for {set i 0} {$i < 64} {incr i} {
    if {[string index $oldboard $i] != [string index $newboard $i]} {
      incr diffcount
      lappend difflist $i
    }
  }
  
  # Check the number of differences could mean a valid move:
  if {$diffcount < 2  ||  $diffcount > 4} { return }
  
  for {set i 0} {$i < $diffcount} {incr i} {
    set sq($i) [lindex $difflist $i]
    set old($i) [string index $oldboard $sq($i)]
    set new($i) [string index $newboard $sq($i)]
  }
  
  set from -1
  set to -1
  set captured -1
  set capturedPiece "."
  
  if {$diffcount == 4} {
    # Check for making/unmaking a castling move:
    set castlingList [list [sq e1] [sq g1] [sq h1] [sq f1] \
        [sq e8] [sq g8] [sq h8] [sq f8] \
        [sq e1] [sq c1] [sq a1] [sq d1] \
        [sq e8] [sq c8] [sq a8] [sq d8]]
    
    foreach {kfrom kto rfrom rto} $castlingList {
      if {[lsort $difflist] == [lsort [list $kfrom $kto $rfrom $rto]]} {
        if {[string tolower [string index $oldboard $kfrom]] == "k"  &&
          [string tolower [string index $oldboard $rfrom]] == "r"  &&
          [string tolower [string index $newboard $kto]] == "k"  &&
          [string tolower [string index $newboard $rto]] == "r"} {
          # A castling move animation.
          # Move the rook back to initial square until animation is complete:
          # TODO: It may look nicer if the rook was animated as well...
          eval $w.bd coords p$rto [::board::midSquare $w $rfrom]
          set from $kfrom
          set to $kto
        } elseif {[string tolower [string index $newboard $kfrom]] == "k"  &&
          [string tolower [string index $newboard $rfrom]] == "r"  &&
          [string tolower [string index $oldboard $kto]] == "k"  &&
          [string tolower [string index $oldboard $rto]] == "r"} {
          # An undo-castling animation. No need to move the rook.
          set from $kto
          set to $kfrom
        }
      }
    }
  }
  
  if {$diffcount == 3} {
    # Three squares are different, so check for an En Passant capture:
    foreach i {0 1 2} {
      foreach j {0 1 2} {
        foreach k {0 1 2} {
          if {$i == $j  ||  $i == $k  ||  $j == $k} { continue }
          # Check for an en passant capture from i to j with the enemy
          # pawn on k:
          if {$old($i) == $new($j) && $old($j) == "." && $new($k) == "."  &&
            (($old($i) == "p" && $old($k) == "P") ||
            ($old($i) == "P" && $old($k) == "p"))} {
            set from $sq($i)
            set to $sq($j)
          }
          # Check for undoing an en-passant capture from j to i with
          # the enemy pawn on k:
          if {$old($i) == $new($j) && $old($k) == "." && $new($i) == "."  &&
            (($old($i) == "p" && $new($k) == "P") ||
            ($old($i) == "P" && $new($k) == "p"))} {
            set from $sq($i)
            set to $sq($j)
            set captured $sq($k)
            set capturedPiece $new($k)
          }
        }
      }
    }
  }
  
  if {$diffcount == 2} {
    # Check for a regular move or capture: one old square should have the
    # same (non-empty) piece as the other new square, and at least one
    # of the old or new squares should be empty.
    
    if {$old(0) != "." && $old(1) != "." && $new(0) != "." && $new(1) != "."} {
      return
    }
    
    foreach i {0 1} {
      foreach j {0 1} {
        if {$i == $j} { continue }
        if {$old($i) == $new($j)  &&  $old($i) != "."} {
          set from $sq($i)
          set to $sq($j)
          set captured $sq($j)
          set capturedPiece $old($j)
        }
        
        # Check for a (white or black) pawn promotion from i to j:
        if {($old($i) == "P"  &&  [string is upper $new($j)]  &&
          $sq($j) >= [sq a8]  &&  $sq($j) <= [sq h8])  ||
          ($old($i) == "p"  &&  [string is lower $new($j)]  &&
          $sq($j) >= [sq a1]  &&  $sq($j) <= [sq h1])} {
          set from $sq($i)
          set to $sq($j)
        }
        
        # Check for undoing a pawn promotion from j to i:
        if {($new($j) == "P"  &&  [string is upper $old($i)]  &&
          $sq($i) >= [sq a8]  &&  $sq($i) <= [sq h8])  ||
          ($new($j) == "p"  &&  [string is lower $old($i)]  &&
          $sq($i) >= [sq a1]  &&  $sq($i) <= [sq h1])} {
          set from $sq($i)
          set to $sq($j)
          set captured $sq($j)
          set capturedPiece $old($j)
        }
      }
    }
  }
  
  # Check that we found a valid-looking move to animate:
  if {$from < 0  ||  $to < 0} { return }
  
  # Redraw the captured piece during the animation if necessary:
  if {$capturedPiece != "."  &&  $captured >= 0} {
    ::board::drawPiece $w $from $capturedPiece
    eval $w.bd coords p$from [::board::midSquare $w $captured]
  }
  
  # Move the animated piece back to its starting point:
  eval $w.bd coords p$to [::board::midSquare $w $from]
  $w.bd raise p$to

  # Start the animation:
  set start [clock clicks -milli]
  set ::board::_animate($w,start) $start
  set ::board::_animate($w,end) [expr {$start + $::animateDelay} ]
  set ::board::_animate($w,from) $from
  set ::board::_animate($w,to) $to
  ::board::_animate $w
}

# ::board::_animate
#   Internal procedure for updating a board move animation.
#
proc ::board::_animate {w} {
  if {! [winfo exists $w]} { return }
  set from $::board::_animate($w,from)
  set to $::board::_animate($w,to)
  set start $::board::_animate($w,start)
  set end $::board::_animate($w,end)
  set now [clock clicks -milli]
  if {$now > $end} {
    ::board::update $w
    return
  }
  
  # Compute where the moving piece should be displayed and move it:
  set ratio [expr {double($now - $start) / double($end - $start)} ]
  set fromMid [::board::midSquare $w $from]
  set toMid [::board::midSquare $w $to]
  set fromX [lindex $fromMid 0]
  set fromY [lindex $fromMid 1]
  set toX [lindex $toMid 0]
  set toY [lindex $toMid 1]
  set x [expr {$fromX + round(($toX - $fromX) * $ratio)} ]
  set y [expr {$fromY + round(($toY - $fromY) * $ratio)} ]
  $w.bd coords p$to $x $y
  $w.bd raise p$to
  
  # Schedule another animation update in a few milliseconds:
  after 5 "::board::_animate $w"
}

proc InitBoard {} {
  # Ensure that the current board style is valid:
  if {[lsearch -exact "$::boardStyles" "$::boardStyle"] == -1} {
    set ::boardStyle [lindex $::boardStyles 0]
  }

  setPieceFont "$::boardStyle"
  menuUpdatePieces
}
InitBoard


###
### End of file: board.tcl
###