1
2
3# ::game::Clear
4#
5#   Clears the active game, checking first if it is altered.
6#   Updates any affected windows.
7#
8proc ::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#
22proc ::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#
34proc ::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#
46proc ::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#
61proc ::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#
73proc ::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#
83proc ::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#
98proc ::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#
119set ::game::moveEntryNumber ""
120trace 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#
126proc ::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################################################################################
172proc ::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#
191proc ::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#
224proc ::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
298namespace 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}
384