Scid  4.6.5
game.tcl
Go to the documentation of this file.
1 
2 
3 # ::game::Clear
4 #
5 # Clears the active game, checking first if it is altered.
6 # Updates any affected windows.
7 #
8 proc ::game::Clear {} {
9  set confirm [::game::ConfirmDiscard]
10  if {$confirm == 0} { return "cancel"}
11  if {$confirm == 1} { ::notify::DatabaseModified $::curr_db}
12  if {$confirm == 2} { ::notify::DatabaseModified $::clipbase_db}
13 
14  sc_game new
16 }
17 
18 # ::game::Strip
19 #
20 # Strips all comments or variations from a game
21 #
22 proc ::game::Strip {type} {
23  undoFeature save
24  if {[catch {sc_game strip $type} result]} {
25  tk_messageBox -parent . -type ok -icon info -title "Scid" -message $result
26  return
27  }
28  updateBoard -pgn
30 }
31 
32 # ::game::TruncateBegin
33 #
34 proc ::game::TruncateBegin {} {
35  undoFeature save
36  if {[catch {sc_game truncate -start} result]} {
37  tk_messageBox -parent . -type ok -icon info -title "Scid" -message $result
38  return
39  }
40  updateBoard -pgn
42 }
43 
44 # ::game::Truncate
45 #
46 proc ::game::Truncate {} {
47  undoFeature save
48  if {[catch {sc_game truncate} result]} {
49  tk_messageBox -parent . -type ok -icon info -title "Scid" -message $result
50  return
51  }
52  updateBoard -pgn
54 }
55 
56 # game::LoadNextPrev
57 #
58 # Loads the next or previous filtered game in the database.
59 # The parameter <action> should be "previous" or "next".
60 #
61 proc ::game::LoadNextPrev {action} {
62  global pgnWin statusBar
63  set number [sc_filter $action]
64  if {$number == 0} {
65  set statusBar " There is no $action game in the current filter."
66  return
67  }
68  ::game::Load $number
69 }
70 
71 # ::game::Reload
72 #
73 # Reloads the current game.
74 #
75 proc ::game::Reload {} {
76  if {![sc_base inUse]} { return}
77  if {[sc_game number] < 1} { return}
78  ::game::Load [sc_game number]
79 }
80 
81 # ::game::LoadRandom
82 #
83 # Loads a random game from the database.
84 #
85 proc ::game::LoadRandom {} {
86  set db [sc_base current]
87  set filter "dbfilter"
88  set ngames [sc_filter count $db $filter]
89  if {$ngames == 0} { return}
90  set r [expr {(int (rand() * $ngames))}]
91  set gnumber [sc_base gameslist $db $r 1 $filter N+]
92  ::game::Load [split [lindex $gnumber 0] "_"]
93 }
94 
95 # ::game::LoadMenu
96 #
97 # Produces a popup dialog for loading a game or other actions
98 # such as merging it into the current game.
99 #
100 proc ::game::LoadMenu {w base gnum x y} {
101  set m $w.gLoadMenu
102  if {! [winfo exists $m]} {
103  menu $m
104  $m add command -label $::tr(BrowseGame)
105  $m add command -label $::tr(LoadGame)
106  $m add command -label $::tr(MergeGame)
107  }
108  $m entryconfigure 0 -command "::gbrowser::new $base $gnum"
109  $m entryconfigure 1 -command "::file::SwitchToBase $base 0; ::game::Load $gnum"
110  $m entryconfigure 2 -command "mergeGame $base $gnum"
111  event generate $w <ButtonRelease-1>
112  $m post $x $y
113  event generate $m <ButtonPress-1>
114 }
115 
116 
117 # ::game::moveEntryNumber
118 #
119 # Entry variable for GotoMoveNumber dialog.
120 #
121 set ::game::moveEntryNumber ""
122 trace variable ::game::moveEntryNumber w {::utils::validate::Regexp {^[0-9]*$}}
123 
124 # ::game::GotoMoveNumber
125 #
126 # Prompts for the move number to go to in the current game.
127 #
128 proc ::game::GotoMoveNumber {} {
129  set ::game::moveEntryNumber ""
130  set w [toplevel .mnumDialog]
131  wm title $w "Scid: [tr GameGotoMove]"
132  grab $w
133 
134  label $w.label -text $::tr(GotoMoveNumber)
135  pack $w.label -side top -pady 5 -padx 5
136 
137  entry $w.entry -background white -width 10 -textvariable ::game::moveEntryNumber
138  bind $w.entry <Escape> { .mnumDialog.buttons.cancel invoke }
139  bind $w.entry <Return> { .mnumDialog.buttons.load invoke }
140  pack $w.entry -side top -pady 5
141 
142  set b [frame $w.buttons]
143  pack $b -side top -fill x
144  dialogbutton $b.load -text "OK" -command {
145  grab release .mnumDialog
146  if {$::game::moveEntryNumber > 0} {
147  catch {sc_move ply [expr {($::game::moveEntryNumber - 1) * 2}]}
148  }
149  focus .
150  destroy .mnumDialog
151  updateBoard -pgn
152  }
153  dialogbutton $b.cancel -text $::tr(Cancel) -command {
154  focus .
155  grab release .mnumDialog
156  destroy .mnumDialog
157  focus .
158  }
159  packbuttons right $b.cancel $b.load
160 
161  set x [ expr {[winfo width .] / 4 + [winfo rootx .] }]
162  set y [ expr {[winfo height .] / 4 + [winfo rooty .] }]
163  wm geometry $w "+$x+$y"
164 
165  focus $w.entry
166 }
167 
168 ################################################################################
169 # merge game gnum in base srcBase in current game in base destBase
170 # then switch to destbase
171 ################################################################################
172 proc ::game::mergeInBase { srcBase destBase gnum } {
173  ::file::SwitchToBase $destBase
174  mergeGame $srcBase $gnum
175 }
176 
177 
178 
179 # Scid (Shane's Chess Information Database)
180 #
181 # Copyright (C) 2012-2015 Fulvio Benini
182 #
183 # Scid is free software: you can redistribute it and/or modify
184 # it under the terms of the GNU General Public License as published by
185 # the Free Software Foundation.
186 
187 # ::game::Load
188 #
189 # Loads a specified game from the active database.
190 #
191 proc ::game::Load { selection {ply ""} } {
192  ::gameHistory::updatePos $::curr_db [sc_game number] [sc_pos location]
193 
194  set confirm [::game::ConfirmDiscard]
195  if {$confirm == 0} { return 0}
196  if {$confirm == 1} { ::notify::DatabaseModified $::curr_db}
197  if {$confirm == 2} { ::notify::DatabaseModified $::clipbase_db}
198 
199  if {[catch {sc_game load $selection}]} {
201  return 0
202  }
203 
204  if {$ply != ""} { eval "sc_move ply $ply"}
205 
206  ::gameHistory::pushBack $::curr_db [sc_game number] [sc_pos location]
207 
208  set extraTags [sc_game tag get Extra]
209  regexp {FlipB "([01])"\n} $extraTags -> flipB
210  if {![info exists flipB]} { set flipB -1}
211  ::board::flipAuto .main.board $flipB
212 
214 }
215 
216 
217 # ::game::ConfirmDiscard
218 # Prompts the user if they want to discard the changes to the
219 # current game. Returns :
220 # 0 -> cancel action
221 # 1 -> continue (saved)
222 # 2 -> continue (added to clipbase)
223 # 3 -> continue (discarded or no changes)
224 #
225 # If the game has been saved (res == 1 || res == 2) the caller should
226 # ::notify::DatabaseModified
227 #
228 proc ::game::ConfirmDiscard {} {
229  if {! [sc_game altered]} { return 3}
230 
231  #Default value: cancel action
232  set ::game::answer 0
233 
234  set fname [file tail [sc_base filename $::curr_db]]
235  set gnum [sc_game number]
236  set players "[sc_game info white] - [sc_game info black]\n"
237  if {[string equal " - \n" $players]} { set players ""}
238 
239  set w .confirmDiscard
240  set bgcolor [ttk::style lookup Button.label -background]
241  toplevel $w -background $bgcolor
242  wm resizable $w 0 0
243  wm title $w "Scid: [tr Save]"
244 
245  ttk::frame $w.msg
246  ttk::label $w.msg.image -image tb_iconSave
247  ttk::frame $w.msg.txt
248  label $w.msg.txt.l1 -text "$players$fname: [tr game] $gnum" -background $bgcolor -relief groove
249  ttk::label $w.msg.txt.l2 -text $::tr(ClearGameDialog) -wraplength 360 -font font_Bold -justify left
250  grid $w.msg.txt.l1 -row 0 -sticky news -pady 4 -padx 2
251  grid $w.msg.txt.l2 -row 1 -sticky news
252  grid $w.msg.txt -row 0 -column 0 -pady 6 -padx 10 -sticky w
253  grid $w.msg.image -row 0 -column 1 -pady 6 -padx 6 -sticky ne
254 
255  #The first button that gets keyboard focus when pressing <tab>
256  #Coincide with default value
257  ttk::button $w.backBtn -text $::tr(GoBack) -command {
258  destroy .confirmDiscard
259  }
260 
261  ttk::label $w.saveTxt -text [tr SaveAndContinue]
262  ttk::button $w.saveBtn -image tb_BD_Save -command {
263  set gnum [sc_game number]
264  if {[catch {sc_game save $gnum $::curr_db}]} {
265  ERROR::MessageBox
266  set ::game::answer 0
267  } else {
268  ::gameHistory::updatePos $::curr_db $gnum [sc_pos location]
269  set ::game::answer 1
270  }
271  destroy .confirmDiscard
272  }
273 
274  ttk::label $w.clipbaseTxt -text [tr EditCopy]
275  ttk::button $w.clipbaseBtn -image tb_BD_SaveAs -command {
276  if {[catch {sc_game save 0 $::clipbase_db}]} {
277  ERROR::MessageBox
278  set ::game::answer 0
279  } else {
280  set gnum [sc_base numGames $::clipbase_db]
281  ::gameHistory::pushBack $::clipbase_db $gnum [sc_pos location]
282  set ::game::answer 2
283  }
284  destroy .confirmDiscard
285  }
286 
287  ttk::label $w.discardTxt -text [tr DiscardChangesAndContinue]
288  ttk::button $w.discardBtn -image tb_BD_VarDelete -command {
289  set ::game::answer 3
290  destroy .confirmDiscard
291  }
292 
293  grid $w.msg -row 0 -columnspan 3
294  grid $w.saveBtn -row 1 -sticky w -padx 10 -pady 4
295  grid $w.saveTxt -row 1 -column 1 -sticky w
296  grid $w.clipbaseBtn -row 2 -sticky w -padx 10 -pady 4
297  grid $w.clipbaseTxt -row 2 -column 1 -sticky w
298  grid $w.discardBtn -row 3 -sticky w -padx 10 -pady 4
299  grid $w.discardTxt -row 3 -column 1 -sticky w
300  grid $w.backBtn -row 3 -column 2 -sticky e -padx 10 -pady 4
301  grid [ttk::frame $w.pad] -row 4 -columnspan 3 -pady 3
302  grid columnconfigure $w 2 -weight 1
303 
304  tk::PlaceWindow $w
305  grab $w
306  tkwait window $w
307  return $::game::answer
308 }
309 
310 
311 namespace eval ::gameHistory {
312  set list_ {}
313 
314  proc updatePos {db game pos} {
315  global gameHistory::list_
316 
317  set idx [lsearch -index 0 $list_ "$db $game"]
318  if {$idx < 0} { return}
319 
320  set elem [list "$db $game" "$pos"]
321  set list_ [lreplace $list_ $idx $idx $elem]
322  }
323 
324  proc pushBack {db game pos} {
325  global gameHistory::list_
326  if {$game == 0} { return}
327 
328  set list_ [lsearch -index 0 -all -inline -not $list_ "$db $game"]
329  if {[llength $list_] > 20} {
330  set list_ [lrange $list_ end-19 end]
331  }
332 
333  set elem [list "$db $game" "$pos"]
334  lappend list_ $elem
335  }
336 
337  proc removeDB {db} {
338  global gameHistory::list_
339  set list_ [lsearch -index 0 -all -inline -not $list_ "$db *"]
340  }
341 
342 }
343 
344 
345 # Grouping intercommunication between windows
346 # When complete this should be moved to a new notify.tcl file
347 namespace eval ::notify {
348  # To be called when the current game change or the Header infos (player names, site, result, etc) are modified
349  proc GameChanged {} {
353  }
354 
355  # To be called when the current position changes
356  # - draw the new position
357  # @-animate: if true will try to animate the moving piece
358  # ignored if more than one piece is in a different position
359  #
360  # - inform the other modules that the current position is changed
361  # @-pgn: must be true if the pgn notation is different (new moves, new tags, etc)
362  #
363  proc PosChanged {args} {
364  set pgnNeedsUpdate 0
365  set animate 0
366  foreach arg $args {
367  if {! [string compare $arg "-pgn"]} { set pgnNeedsUpdate 1}
368  if {! [string compare $arg "-animate"]} { set animate 1}
369  }
370 
371  ::pgn::Refresh $pgnNeedsUpdate
372 
373  ::board::setmarks .main.board [sc_pos getComment]
374  ::board::update .main.board [sc_pos board] $animate
375 
376  after cancel ::notify::privPosChanged
377  update idletasks
378  after idle ::notify::privPosChanged
379  }
380 
381  # To be called when the position of the current game change
382  proc privPosChanged {} {
387  if {$::showGameInfo} { updateGameInfo}
393  if {[winfo exists .twinchecker]} { updateTwinChecker}
394  if {[winfo exists .bookWin]} { ::book::refresh}
395  if {[winfo exists .bookTuningWin]} { ::book::refreshTuning}
398  }
399 
400  # To be called when the current database change or a new base is opened
401  proc DatabaseChanged {} {
402  set ::curr_db [sc_base current]
405  set ::treeWin [winfo exists .treeWin$::curr_db]
407  }
408 
409  # To be called after modifying data in a database
410  proc DatabaseModified {{dbase} {filter -1}} {
414  }
415 }