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