Scid  4.6.5
edit.tcl
Go to the documentation of this file.
1 ############################################################
2 ### Board setup window:
3 
4 # Global variables for entry of the start position:
5 set epFile {} ;# legal values are empty, or "a"-"h".
6 set moveNum 1 ;# legal values are 1-999.
7 set setupStatus {} ;# stores the FEN string.
8 set castling KQkq ;# will be empty or some combination of KQkq letters.
9 set toMove White ;# side to move, "White" or "Black".
10 set pastePiece K ;# Piece being pasted, "K", "k", "Q", "q", etc.
11 
12 # Traces to keep entry values sensible:
13 trace variable moveNum w {::utils::validate::Integer 999 0}
14 trace variable epFile w {::utils::validate::Regexp {^(-|[a-h])?$}}
15 trace variable castling w {::utils::validate::Regexp {^(-|[KQkq]*)$}}
16 
17 set setupBd {}
18 set setupFen {}
19 
20 # setupBoard:
21 # The main procedure for creating the dialog for setting the start board.
22 # Calls switchPastePiece and makeSetupFen.
23 # On "Setup" button press, calls sc_pos startBoard to try to set the
24 # starting board.
25 #
26 proc setupBoard {} {
27  global boardSizes boardSize lite dark setupBd pastePiece toMove epFile moveNum
28  global origFen
29  global setupStatus castling setupFen highcolor
30  if {[winfo exists .setup]} { return}
31  set setupBd [lindex [sc_pos board] 0]
32  set origFen [sc_pos fen]
33 
34  set w ".setup"
35  toplevel $w
36  wm title $w "Scid: Setup Board"
37  wm minsize $w 640 450
38 
39  #Frames
40  ttk::frame $w.spaceTop -height 10
41  ttk::frame $w.l
42  ttk::frame $w.r
43  ttk::frame $w.statusbar
44  ttk::frame $w.buttons
45  grid $w.spaceTop -row 0 -column 0 -columnspan 5 -sticky news
46  grid $w.l -row 1 -column 0 -sticky news
47  grid rowconfigure $w 1 -weight 1
48  grid columnconfigure $w 0 -weight 1
49  grid $w.r -row 1 -column 4 -sticky news
50  grid $w.statusbar -row 2 -column 0 -columnspan 5 -sticky news
51  grid $w.buttons -row 3 -column 0 -columnspan 5 -sticky news
52 
53  #Board
54  ::board::new $w.l.bd
55  ::board::coords $w.l.bd
56  for {set i 0} { $i < 64 } { incr i} {
57  ::board::bind $w.l.bd $i <B1-Motion> "dragBoardPiece $w.l.bd %X %Y $i"
58  ::board::bind $w.l.bd $i <ButtonRelease-1> "setupBoardPiece $w.l.bd %X %Y"
59  }
60  grid $w.l.bd -sticky news
61  grid rowconfigure $w.l.bd 0 -weight 1
62  grid columnconfigure $w.l.bd 0 -weight 1
63 
64  ### Piece Buttons
65  foreach psize $::boardSizes {
66  if {$psize >= 40} { break}
67  }
68  grid [ttk::frame $w.spacePiecesLeft -width 10] -row 1 -column 1 -sticky news
69  grid [ttk::frame $w.pieces] -row 1 -column 2 -sticky news
70  grid [ttk::frame $w.pieces.spaceTop -height 2] -row 0 -columnspan 2
71  grid [ttk::frame $w.pieces.w] -row 1 -column 0 -sticky news
72  grid [ttk::frame $w.pieces.b] -row 1 -column 1 -sticky news
73  foreach i {p n b r q k} {
74  foreach color {w b} value "[string toupper $i] $i" {
75  radiobutton $w.pieces.$color.$i -image $color$i$psize -indicatoron 0 -variable pastePiece -value $value -activebackground $highcolor
76  grid $w.pieces.$color.$i -column 0 -pady 2 -padx 2
77  }
78  }
79  set ::setupBoardFlipped [::board::isFlipped .main.board]
80  ::board::flip .setup.l.bd $::setupBoardFlipped
81  checkbutton $w.pieces.rotate -text " Rotate" -image tb_BD_Flip -compound left \
82  -indicatoron 0 -variable ::setupBoardFlipped -command {
83  set ::setupBd [string reverse $::setupBd]
84  set ::setupFen [makeSetupFen]
85  ::board::update .setup.l.bd $::setupBd
86  ::board::flip .setup.l.bd
87  set ::setupBoardFlipped [::board::isFlipped .setup.l.bd]
88  }
89  grid $w.pieces.rotate -row 2 -columnspan 2 -sticky news -padx 2 -pady 2
90 
91 
92  ### Side to move frame.
93  set toMove [lindex {White Black} [string equal [lindex $origFen 1] b]]
94  ttk::frame $w.r.tomove
95  ttk::label $w.r.tomove.label -textvar ::tr(SideToMove:)
96  ttk::frame $w.r.tomove.buttons
97  ttk::radiobutton $w.r.tomove.buttons.w -text $::tr(White) -variable toMove -value White \
98  -command {set setupFen [makeSetupFen]}
99  ttk::radiobutton $w.r.tomove.buttons.b -text $::tr(Black) -variable toMove -value Black \
100  -command {set setupFen [makeSetupFen]}
101 
102  pack $w.r.tomove -pady 7
103  pack $w.r.tomove.label -side top -pady 2
104  pack $w.r.tomove.buttons -side top
105  pack $w.r.tomove.buttons.w $w.r.tomove.buttons.b -side left
106 
107  ### Entry boxes: Move number, Castling and En Passant file.
108  pack [ttk::frame $w.r.mid] -padx 5 -pady 5
109 
110  set moveNum [lindex $origFen 5]
111  ttk::frame $w.r.mid.movenum
112  ttk::label $w.r.mid.movenum.label -textvar ::tr(MoveNumber:)
113  ttk::entry $w.r.mid.movenum.e -width 3 -background white -textvariable moveNum
114 
115  pack $w.r.mid.movenum -pady 10 -expand yes -fill x
116  pack $w.r.mid.movenum.label $w.r.mid.movenum.e -side left -anchor w -expand yes -fill x
117 
118  set castling [lindex $origFen 2]
119  ttk::frame $w.r.mid.castle
120  ttk::label $w.r.mid.castle.label -textvar ::tr(Castling:)
121  ttk::combobox $w.r.mid.castle.e -width 5 -textvariable castling -values {KQkq K Q k q - KQ kq Kk Kq Kkq Qk Qq Qkq KQk KQq}
122 
123  pack $w.r.mid.castle -pady 10 -expand yes -fill x
124  pack $w.r.mid.castle.label $w.r.mid.castle.e -side left -anchor w -expand yes -fill x
125 
126  set epFile [string index [lindex $origFen 3] 0]
127  ttk::frame $w.r.mid.ep
128  ttk::label $w.r.mid.ep.label -textvar ::tr(EnPassantFile:)
129  ttk::combobox $w.r.mid.ep.e -width 2 -textvariable epFile -values {- a b c d e f g h}
130 
131  pack $w.r.mid.ep -pady 10 -expand yes -fill x
132  pack $w.r.mid.ep.label $w.r.mid.ep.e -side left -anchor w -expand yes -fill x
133 
134  # Set bindings so the Fen string is updated at any change. The "after idle"
135  # is needed to ensure any keypress which causes a text edit is processed
136  # before we regenerate the FEN text.
137 
138  foreach i "$w.r.mid.ep.e $w.r.mid.castle.e $w.r.mid.movenum.e" {
139  bind $i <Any-KeyPress> {after idle {set setupFen [makeSetupFen]}}
140  bind $i <FocusOut> {
141  after idle {set setupFen [makeSetupFen]}}
142  }
143 
144  ### Buttons: Clear Board and Initial Board.
145  ttk::frame $w.r.b
146  ttk::button $w.r.b.clear -textvar ::tr(EmptyBoard) -command {
147  set setupBd "................................................................"
148  ::board::update .setup.l.bd $setupBd
149  set castling {}
150  set setupFen [makeSetupFen]
151  }
152  ttk::button $w.r.b.initial -textvar ::tr(InitialBoard) -command {
153  setSetupBoardToFen %W "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"
154  }
155  ttk::button $w.r.b.switchcolor -text "Switch colors" -command {
156  regsub -all {(?:([A-Z])|([a-z]))} $::setupBd {[string tolower "\1"][string toupper "\2"]} invertCase
157  set ::setupBd [subst $invertCase]
158  set ::toMove [expr {$::toMove == "White" ? "Black" : "White"}]
159  regsub -all {(?:([A-Z])|([a-z]))} $::castling {[string tolower "\1"][string toupper "\2"]} invertCase
160  set ::castling [subst $invertCase]
161  set epFile {-}
162  ::board::update .setup.l.bd $setupBd
163  set ::setupFen [makeSetupFen]
164  }
165  ttk::button $w.r.b.flip -text "Flip Board" -command {
166  ::board::flip .setup.l.bd
167  set ::setupBoardFlipped [::board::isFlipped .setup.l.bd]
168  }
169 
170  pack $w.r.b -side top -pady 15
171  pack $w.r.b.clear -side top -padx 5 -pady 5 -fill x
172  pack $w.r.b.initial -side top -padx 5 -pady 5 -fill x
173  pack $w.r.b.switchcolor -side top -padx 5 -pady 5 -fill x
174  pack $w.r.b.flip -side top -padx 5 -pady 5 -fill x
175 
176  ### Buttons: Setup and Cancel.
177  ttk::button $w.buttons.ok -text "OK" -width 7 -command exitSetupBoard
178  ttk::button $w.buttons.cancel -textvar ::tr(Cancel) -width 7 -command {destroy .setup}
179  pack [ttk::frame $w.buttons.spaceTop -height 4] -side top
180  pack $w.buttons.cancel -side right -padx 5
181  pack $w.buttons.ok -side right -padx 5
182 
183  ttk::button .setup.paste -textvar ::tr(PasteFen) -command {
184  if {[catch {set setupFen [selection get -selection CLIPBOARD]} ]} {
185  # PRIMARY is the X selection, unsure about CLIPBOARD
186  if {[catch {set setupFen [selection get -selection PRIMARY]}]} { return }
187  }
188  setSetupBoardToFen %W $setupFen
189  }
190  ttk::button .setup.clear -textvar ::tr(ClearFen) -command {set setupFen ""}
191 
192  ttk::combobox .setup.status -textvariable setupFen -height 10
193  bind .setup.status <<ComboboxSelected>> {setSetupBoardToFen %W $setupFen}
194  ::utils::history::SetCombobox setupFen .setup.status
195  ::utils::history::SetLimit setupFen 20
196 
197  pack .setup.paste .setup.clear -in .setup.statusbar -side left
198  pack .setup.status -in .setup.statusbar -side right -expand yes -fill x -anchor w
199 
200  bind $w.l <Configure> "::board::resizeAuto $w.l.bd \[grid bbox $w 0 1\]"
201  bind $w <Destroy> "if {\[string equal $w %W\]} { set ::winGeometry($w) \[wm geometry $w\]; options.save ::winGeometry($w) }"
202  bind $w <Escape> {destroy .setup}
203  if {[info exists ::winGeometry($w)]} { wm geometry $w $::winGeometry($w)}
204 
205  set setupFen [makeSetupFen]
206 }
207 
208 proc setSetupBoardToFen {w setupFen} {
209  global setupBd toMove castling epFile moveNum
210 
211  sc_game push
212  if {[catch {sc_game startBoard $setupFen} err]} {
213  fenErrorDialog $err
214  } else {
215  set ::setupFen [sc_pos fen]
216  set setupBd [lindex [sc_pos board] 0]
217  set toMove [lindex {White Black} [string equal [lindex $setupFen 1] b]]
218  set castling [lindex $setupFen 2]
219  set epFile [string index [lindex $setupFen 3] 0]
220  set moveNum [lindex $setupFen 5]
221  ::board::update .setup.l.bd $setupBd
222  }
223  sc_game pop
224 }
225 
226 
227 # makeSetupFen:
228 # Reconstructs the FEN string from the current settings in the
229 # setupBoard dialog. Check to see if the position is
230 # acceptable (a position can be unacceptable by not having exactly
231 # one King per side, or by having more than 16 pieces per side).
232 #
233 proc makeSetupFen {} {
234  global setupFen setupBd moveNum toMove castling epFile
235  set fenStr ""
236  set errorStr [validateSetup]
237  if {$errorStr != ""} {
238  set fenStr "Invalid board: "
239  append fenStr $errorStr
240  return $fenStr
241  }
242  for {set bRow 56} {$bRow >= 0} {incr bRow -8} {
243  if {$bRow < 56} { append fenStr "/"}
244  set emptyRun 0
245  for {set bCol 0} {$bCol < 8} {incr bCol} {
246  set sq [expr {$bRow + $bCol}]
247  set piece [string index $setupBd $sq]
248  if {$piece == "."} {
249  incr emptyRun
250  } else {
251  if {$emptyRun > 0} {
252  append fenStr $emptyRun
253  set emptyRun 0
254  }
255  append fenStr $piece
256  }
257  }
258  if {$emptyRun > 0} { append fenStr $emptyRun}
259  }
260  append fenStr " " [string tolower [string index $toMove 0]] " "
261  if {$castling == ""} {
262  append fenStr "- "
263  } else {
264  append fenStr $castling " "
265  }
266  if {$epFile == "" || $epFile == "-"} {
267  append fenStr "-"
268  } else {
269  append fenStr $epFile
270  if {$toMove == "White"} {
271  append fenStr "6"
272  } else {
273  append fenStr "3"
274  }
275  }
276  # We assume a halfmove clock of zero:
277  append fenStr " 0 " $moveNum
278  set setupFen $fenStr
279  return $fenStr
280 }
281 
282 # validateSetup:
283 # Called by makeSetupFen to check that the board is sensible: that is,
284 # that there is one king per side and there are at most 16 pieces per
285 # side and there are no pawn in the 1st or 8th row
286 #
287 proc validateSetup {} {
288  global setupBd
289  set wkCount 0; set bkCount 0; set wCount 0; set bCount 0
290  set wpCount 0; set bpCount 0
291  for {set i 0} {$i < 64} {incr i} {
292  set p [string index $setupBd $i]
293  if {$p == "."} {
294  } elseif {$p == "P"} { incr wCount; incr wpCount
295  } elseif {$p == "p"} { incr bCount; incr bpCount
296  } elseif {$p == "N" || $p == "B" || $p == "R" || $p == "Q"} {
297  incr wCount
298  } elseif {$p == "n" || $p == "b" || $p == "r" || $p == "q"} {
299  incr bCount
300  } elseif {$p == "K"} { incr wCount; incr wkCount
301  } elseif {$p == "k"} { incr bCount; incr bkCount
302  } else { return "Invalid piece: $p"}
303  if {$p == "P" || $p == "p"} {
304  if {$i < 8} { return "There must be no pawn in the 1st row"}
305  if {$i >= 56} { return "There must be no pawn in the 8th row"}
306  }
307  }
308  if {$wkCount != 1} { return "There must be one white king"
309  } elseif {$bkCount != 1} { return "There must be one black king"
310  } elseif {$wCount > 16} { return "Too many white pieces"
311  } elseif {$bCount > 16} { return "Too many black pieces"
312  } elseif {$wpCount > 8} { return "Too many white pawns"
313  } elseif {$bpCount > 8} { return "Too many black pawns"}
314  return ""
315 }
316 
317 proc dragBoardPiece {w x y startSq} {
318  set square [::board::getSquare $w $x $y]
319  if {$square != $startSq && [::board::getDragSquare $w] == -1} {
320  set tmp [string index $::setupBd $startSq]
321  if {$tmp == "."} { return}
322  set ::pastePiece $tmp
323  ::board::setDragSquare .setup.l.bd $startSq
324  }
325 
326  ::board::dragPiece .setup.l.bd $x $y
327 }
328 
329 proc setupBoardPiece {w x y} {
330  global setupBd pastePiece setupFen
331 
332  set square [::board::getSquare $w $x $y]
333  set newPiece $pastePiece
334  set oldPiece [string index $setupBd $square]
335  set delSq [::board::setDragSquare .setup.l.bd -1]
336  if {$delSq != -1} {
337  #Dragged
338  if {$delSq == $square} { return}
339  set setupBd [string replace $setupBd $delSq $delSq "."]
340  } else {
341  #Left click
342  if {$oldPiece == $newPiece} {
343  set newPiece "."
344  }
345  }
346 
347  set setupBd [string replace $setupBd $square $square $newPiece]
348  ::board::update .setup.l.bd $setupBd
349  set setupFen [makeSetupFen]
350 }
351 
352 proc exitSetupBoard {} {
353  global setupFen
354 
355  undoFeature save
356  if {[catch {sc_game startBoard $setupFen} err]} {
357  undoFeature undo
358  fenErrorDialog $err
359  } else {
360  ::utils::history::AddEntry setupFen $setupFen
361  destroy .setup
362  ::board::flipAuto .main.board $::setupBoardFlipped
364  }
365 }
366 
367 ### End of Board setup window
368 ############################################################
369 
370 
371 proc fenErrorDialog {{msg {}}} {
372  if {[winfo exists .setup]} {
373  tk_messageBox -icon info -type ok -title "Scid: Invalid FEN" -message $msg -parent .setup
374  } else {
375  tk_messageBox -icon info -type ok -title "Scid: Invalid FEN" -message $msg
376  }
377 }
378 
379 # copyFEN
380 #
381 # Copies the FEN of the current position to the text clipboard.
382 #
383 proc copyFEN {} {
384  set fen [sc_pos fen]
385  # Create a text widget to hold the fen so it can be the owner
386  # of the current text selection:
387  set w .tempFEN
388  if {! [winfo exists $w]} { text $w}
389  $w delete 1.0 end
390  $w insert end $fen sel
391  clipboard clear
392  clipboard append $fen
393  selection own $w
394  selection get
395 }
396 
397 # pasteFEN
398 #
399 # Bypasses the board setup window and tries to paste the current
400 # text selection as the setup position, producing a message box
401 # if the selection does not appear to be a valid FEN string.
402 #
403 proc pasteFEN {} {
404  set fenStr ""
405  if {[catch {set fenStr [selection get -selection CLIPBOARD]}]} {
406  catch {set fenStr [selection get -selection PRIMARY]}
407  }
408  set fenStr [string trim $fenStr]
409 
410  set fenExplanation {FEN is the standard text representation of a chess position. As an example, the FEN representation of the standard starting position is:
411  "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"}
412 
413  if {$fenStr == ""} {
414  set msg "The current text selection is empty. To paste the start board, select some text that contains a position in FEN notation.\n\n$fenExplanation"
415  fenErrorDialog $msg
416  return
417  }
418  if {[catch {sc_game startBoard $fenStr}]} {
419  if {[string length $fenStr] > 80} {
420  set fenStr [string range $fenStr 0 80]
421  append fenStr "..."
422  }
423  set msg "\"$fenStr\" is not a valid chess position in FEN notation.\n\n $fenExplanation"
424 
425  fenErrorDialog $msg
426  return
427  }
428  updateBoard -pgn
429 }
430