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