Scid  4.7.0
•All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros
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
15  ::notify::GameChanged
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
29  updateTitle
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
41  updateTitle
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
53  updateTitle
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  set number [sc_filter $action]
63  if {$number == 0} {
64  return
65  }
66  ::game::Load $number
67 }
68 
69 # ::game::Reload
70 #
71 # Reloads the current game.
72 #
73 proc ::game::Reload {} {
74  if {![sc_base inUse]} { return}
75  if {[sc_game number] < 1} { return}
76  ::game::Load [sc_game number]
77 }
78 
79 # ::game::LoadRandom
80 #
81 # Loads a random game from the database.
82 #
83 proc ::game::LoadRandom {} {
84  set db [sc_base current]
85  set filter "dbfilter"
86  set ngames [sc_filter count $db $filter]
87  if {$ngames == 0} { return}
88  set r [expr {(int (rand() * $ngames))}]
89  set gnumber [sc_base gameslist $db $r 1 $filter N+]
90  ::game::Load [split [lindex $gnumber 0] "_"]
91 }
92 
93 # ::game::LoadMenu
94 #
95 # Produces a popup dialog for loading a game or other actions
96 # such as merging it into the current game.
97 #
98 proc ::game::LoadMenu {w base gnum x y} {
99  set m $w.gLoadMenu
100  if {! [winfo exists $m]} {
101  menu $m
102  $m add command -label $::tr(BrowseGame)
103  $m add command -label $::tr(LoadGame)
104  $m add command -label $::tr(MergeGame)
105  }
106  $m entryconfigure 0 -command "::gbrowser::new $base $gnum"
107  $m entryconfigure 1 -command "::file::SwitchToBase $base 0; ::game::Load $gnum"
108  $m entryconfigure 2 -command "mergeGame $base $gnum"
109  event generate $w <ButtonRelease-1>
110  $m post $x $y
111  event generate $m <ButtonPress-1>
112 }
113 
114 
115 # ::game::moveEntryNumber
116 #
117 # Entry variable for GotoMoveNumber dialog.
118 #
119 set ::game::moveEntryNumber ""
120 trace variable ::game::moveEntryNumber w {::utils::validate::Regexp {^[0-9]*$}}
121 
122 # ::game::GotoMoveNumber
123 #
124 # Prompts for the move number to go to in the current game.
125 #
126 proc ::game::GotoMoveNumber {} {
127  set ::game::moveEntryNumber ""
128  set w [toplevel .mnumDialog]
129  wm title $w "Scid: [tr GameGotoMove]"
130  grab $w
131  set f [ttk::frame $w.f]
132  pack $f -expand 1
133 
134  ttk::label $f.label -text $::tr(GotoMoveNumber)
135  pack $f.label -side top -pady 5 -padx 5
136 
137  ttk::entry $f.entry -width 8 -textvariable ::game::moveEntryNumber
138  bind $f.entry <Escape> { .mnumDialog.f.buttons.cancel invoke }
139  bind $f.entry <Return> { .mnumDialog.f.buttons.load invoke }
140  pack $f.entry -side top -pady 5
141 
142  set b [ttk::frame $f.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 $f.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  set confirm [::game::ConfirmDiscard]
193  if {$confirm == 0} { return 0}
194  if {$confirm == 1} { ::notify::DatabaseModified $::curr_db}
195  if {$confirm == 2} { ::notify::DatabaseModified $::clipbase_db}
196 
197  if {[catch {sc_game load $selection}]} {
198  ERROR::MessageBox
199  return 0
200  }
201 
202  if {$ply != ""} { eval "sc_move ply $ply"}
203 
204  set extraTags [sc_game tag get Extra]
205  regexp {FlipB "([01])"\n} $extraTags -> flipB
206  if {![info exists flipB]} { set flipB -1}
207  ::board::flipAuto .main.board $flipB
208 
209  ::notify::GameChanged
210 }
211 
212 
213 # ::game::ConfirmDiscard
214 # Prompts the user if they want to discard the changes to the
215 # current game. Returns :
216 # 0 -> cancel action
217 # 1 -> continue (saved)
218 # 2 -> continue (added to clipbase)
219 # 3 -> continue (discarded or no changes)
220 #
221 # If the game has been saved (res == 1 || res == 2) the caller should
222 # ::notify::DatabaseModified
223 #
224 proc ::game::ConfirmDiscard {} {
225  if {! [sc_game altered]} { return 3}
226 
227  #Default value: cancel action
228  set ::game::answer 0
229 
230  set fname [file tail [sc_base filename $::curr_db]]
231  set gnum [sc_game number]
232  set players "[sc_game info white] - [sc_game info black]\n"
233  if {[string equal " - \n" $players]} { set players ""}
234 
235  set w .confirmDiscard
236  ::win::createDialog $w
237  wm resizable $w 0 0
238  wm title $w "Scid: [tr Save]"
239 
240  ttk::frame $w.msg
241  ttk::label $w.msg.image -image tb_iconSave
242  ttk::frame $w.msg.txt
243  ttk::label $w.msg.txt.l1 -text "$players$fname: [tr game] $gnum" -relief groove
244  ttk::label $w.msg.txt.l2 -text $::tr(ClearGameDialog) -wraplength 360 -font font_Bold -justify left
245  grid $w.msg.txt.l1 -row 0 -sticky news -pady 4 -padx 2
246  grid $w.msg.txt.l2 -row 1 -sticky news
247  grid $w.msg.txt -row 0 -column 0 -pady 6 -padx 10 -sticky w
248  grid $w.msg.image -row 0 -column 1 -pady 6 -padx 6 -sticky ne
249 
250  #The first button that gets keyboard focus when pressing <tab>
251  #Coincide with default value
252  ttk::button $w.backBtn -text $::tr(GoBack) -command {
253  destroy .confirmDiscard
254  }
255 
256  ttk::button $w.saveBtn -text [tr SaveAndContinue] -image tb_BD_Save -compound left -command {
257  set gnum [sc_game number]
258  if {[catch {sc_game save $gnum $::curr_db}]} {
259  ERROR::MessageBox
260  set ::game::answer 0
261  } else {
262  set ::game::answer 1
263  }
264  destroy .confirmDiscard
265  }
266 
267  ttk::button $w.clipbaseBtn -text [tr EditCopy] -image tb_BD_SaveAs -compound left -command {
268  if {[catch {sc_game save 0 $::clipbase_db}]} {
269  ERROR::MessageBox
270  set ::game::answer 0
271  } else {
272  set gnum [sc_base numGames $::clipbase_db]
273  set ::game::answer 2
274  }
275  destroy .confirmDiscard
276  }
277 
278  ttk::button $w.discardBtn -text [tr DiscardChangesAndContinue] -image tb_BD_VarDelete -compound left -command {
279  set ::game::answer 3
280  destroy .confirmDiscard
281  }
282 
283  grid $w.msg -row 0 -columnspan 2
284  grid $w.saveBtn -row 1 -sticky nwe -padx 10 -pady 4 -columnspan 2
285  grid $w.clipbaseBtn -row 2 -sticky nwe -padx 10 -pady 4 -columnspan 2
286  grid $w.discardBtn -row 3 -sticky nwe -padx 10 -pady 4 -columnspan 2
287  grid $w.backBtn -row 4 -column 1 -sticky e -padx 10 -pady "14 4"
288  grid columnconfigure $w 2 -weight 1
289 
290  tk::PlaceWindow $w
291  grab $w
292  tkwait window $w
293  return $::game::answer
294 }
295 
296 # Grouping intercommunication between windows
297 # When complete this should be moved to a new notify.tcl file
298 namespace eval ::notify {
299  # To be called when the current game change or the Header infos (player names, site, result, etc) are modified
300  proc GameChanged {} {
301  updateMainGame
302  ::notify::PosChanged -pgn
303  ::windows::gamelist::Refresh 0
304  ::maint::Refresh
305  }
306 
307  # To be called when the current position changes
308  # - draw the new position
309  # @-animate: if true will try to animate the moving piece
310  # ignored if more than one piece is in a different position
311  #
312  # - inform the other modules that the current position is changed
313  # @-pgn: must be true if the pgn notation is different (new moves, new tags, etc)
314  #
315  proc PosChanged {args} {
316  set pgnNeedsUpdate 0
317  set animate 0
318  foreach arg $args {
319  if {! [string compare $arg "-pgn"]} { set pgnNeedsUpdate 1}
320  if {! [string compare $arg "-animate"]} { set animate 1}
321  }
322 
323  ::pgn::Refresh $pgnNeedsUpdate
324 
325  ::board::setmarks .main.board [sc_pos getComment]
326  ::board::update .main.board [sc_pos board] $animate
327 
328  after cancel ::notify::privPosChanged
329  update idletasks
330  after idle ::notify::privPosChanged
331 
332  if {$pgnNeedsUpdate} {
333  ::tools::graphs::score::Refresh 0
334  }
335  }
336 
337  # To be called when the position of the current game change
338  proc privPosChanged {} {
339  moveEntry_Clear
340  updateStatusBar
341  updateMainToolbar
342  updateTitle
343  if {$::showGameInfo} { updateGameInfo}
344  updateAnalysis 1
345  updateAnalysis 2
346  ::windows::gamelist::PosChanged
347  ::windows::commenteditor::Refresh
348  ::tb::results
349  if {[winfo exists .twinchecker]} { updateTwinChecker}
350  if {[winfo exists .bookWin]} { ::book::refresh}
351  if {[winfo exists .bookTuningWin]} { ::book::refreshTuning}
352  updateNoveltyWin
353  ::tree::refresh
354  }
355 
356  # To be called when the current database change or a new base is opened
357  proc DatabaseChanged {} {
358  set ::curr_db [sc_base current]
359  ::windows::switcher::Refresh
360  ::windows::stats::refresh_wnd
361  ::maint::Refresh
362  updateStatusBar
363  ::tools::graphs::filter::Refresh
364  ::tools::graphs::absfilter::Refresh
365  set ::treeWin [winfo exists .treeWin$::curr_db]
366  menuUpdateBases
367  if {[winfo exists .ecograph]} { ::windows::eco::update}
368  }
369 
370  # To be called after modifying data in a database
371  # The filter name is provided if it was the only thing modified (searches)
372  proc DatabaseModified {{dbase} {filter -1}} {
373  ::windows::gamelist::DatabaseModified $dbase $filter
374  ::windows::switcher::Refresh
375  ::windows::stats::refresh_wnd
376  ::maint::Refresh
377  updateStatusBar
378  ::search::DatabaseModified $dbase $filter
379  ::tools::graphs::filter::Refresh
380  ::tools::graphs::absfilter::Refresh
381  if {[winfo exists .ecograph]} { ::windows::eco::update}
382  }
383 }
Generated by   doxygen 1.8.13