1############################################################ 2### PGN window 3 4namespace eval pgn { 5 ################################################################################ 6 # 7 ################################################################################ 8 proc ChooseColor {type name} { 9 global pgnColor 10 set x [tk_chooseColor -initialcolor $pgnColor($type) -title "PGN $name color"] 11 if {$x != ""} { set pgnColor($type) $x; ::pgn::ResetColors } 12 } 13 ################################################################################ 14 # 15 ################################################################################ 16 proc ConfigMenus {{lang ""}} { 17 if {! [winfo exists .pgnWin]} { return } 18 if {$lang == ""} { set lang $::language } 19 set m .pgnWin.menu 20 foreach idx {0 1 2 3} tag {File Opt Color Help} { 21 configMenuText $m $idx Pgn$tag $lang 22 } 23 foreach idx {0 1 3} tag {Copy Print Close} { 24 configMenuText $m.file $idx PgnFile$tag $lang 25 } 26 foreach idx {0 1 2 3 4 5 6 7 8} tag { 27 Color Short Symbols IndentC IndentV Space Column StripMarks BoldMainLine 28 } { 29 configMenuText $m.opt $idx PgnOpt$tag $lang 30 } 31 foreach idx {9} tag {GInfoPhotos} { 32 configMenuText $m.opt $idx $tag $lang 33 } 34 foreach idx {0 1 2 3 4 5} tag {Header Anno Comments Vars Background Current} { 35 configMenuText $m.color $idx PgnColor$tag $lang 36 } 37 foreach idx {0 1} tag {Pgn Index} { 38 configMenuText $m.helpmenu $idx PgnHelp$tag $lang 39 } 40 } 41 42 proc PgnClipboardCopy {} { 43 setLanguageTemp E 44 set pgnStr [sc_game pgn -width 75 -indentComments $::pgn::indentComments \ 45 -indentVariations $::pgn::indentVars -space $::pgn::moveNumberSpaces] 46 setLanguageTemp $::language 47 48 set wt .tempFEN 49 50 if {! [winfo exists $wt]} { text $wt } 51 $wt delete 1.0 end 52 $wt insert end $pgnStr sel 53 clipboard clear 54 clipboard append $pgnStr 55 selection own $wt 56 selection get 57 } 58 59 ################################################################################ 60 # 61 ################################################################################ 62 proc OpenClose {} { 63 global pgnWin pgnHeight pgnWidth pgnColor 64 65 set w .pgnWin 66 if {! [::win::createWindow $w [tr PgnWindowTitle] ]} { 67 ::win::closeWindow $w 68 return 69 } 70 71 menu $w.menu 72 ::setMenu $w $w.menu 73 74 $w.menu add cascade -label PgnFile -menu $w.menu.file -underline 0 75 $w.menu add cascade -label PgnOpt -menu $w.menu.opt -underline 0 76 $w.menu add cascade -label PgnColor -menu $w.menu.color -underline 0 77 $w.menu add cascade -label PgnHelp -menu $w.menu.helpmenu -underline 0 78 foreach i {file opt color helpmenu} { 79 menu $w.menu.$i -tearoff 0 80 } 81 82 $w.menu.file add command -label PgnFileCopy -command {::pgn::PgnClipboardCopy } 83 84 $w.menu.file add command -label PgnFilePrint -command { 85 set ftype { 86 { "PGN files" {".pgn"} } 87 { "Text files" {".txt"} } 88 { "All files" {"*"} } 89 } 90 set fname [tk_getSaveFile -initialdir [pwd] -filetypes $ftype -title "Save PGN file"] 91 if {$fname != ""} { 92 if {[file extension $fname] != ".txt" && [file extension $fname] != ".pgn" } { 93 append fname ".pgn" 94 } 95 if {[catch {set tempfile [open $fname w]}]} { 96 tk_messageBox -title "Scid: Error saving file" -type ok -icon warning \ 97 -message "Unable to save the file: $fname\n\n" 98 } else { 99 puts $tempfile \ 100 [sc_game pgn -width 75 -symbols $::pgn::symbolicNags \ 101 -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments \ 102 -space $::pgn::moveNumberSpaces -format plain -column $::pgn::columnFormat \ 103 -markCodes $::pgn::stripMarks] 104 close $tempfile 105 } 106 } 107 } 108 $w.menu.file add separator 109 $w.menu.file add command -label PgnFileClose \ 110 -command "::win::closeWindow $w" 111 112 $w.menu.opt add checkbutton -label PgnOptColor \ 113 -variable ::pgn::showColor -command {updateBoard -pgn} 114 $w.menu.opt add checkbutton -label PgnOptShort \ 115 -variable ::pgn::shortHeader -command {updateBoard -pgn} 116 $w.menu.opt add checkbutton -label PgnOptSymbols \ 117 -variable ::pgn::symbolicNags -command {updateBoard -pgn} 118 $w.menu.opt add checkbutton -label PgnOptIndentC \ 119 -variable ::pgn::indentComments -command {updateBoard -pgn} 120 $w.menu.opt add checkbutton -label PgnOptIndentV \ 121 -variable ::pgn::indentVars -command {updateBoard -pgn} 122 $w.menu.opt add checkbutton -label PgnOptSpace \ 123 -variable ::pgn::moveNumberSpaces -command {updateBoard -pgn} 124 $w.menu.opt add checkbutton -label PgnOptColumn \ 125 -variable ::pgn::columnFormat -command {updateBoard -pgn} 126 $w.menu.opt add checkbutton -label PgnOptStripMarks \ 127 -variable ::pgn::stripMarks -command {updateBoard -pgn} 128 $w.menu.opt add checkbutton -label PgnOptBoldMainLine \ 129 -variable ::pgn::boldMainLine -command {updateBoard -pgn} 130 $w.menu.opt add checkbutton -label GInfoPhotos \ 131 -variable ::pgn::showPhoto -command {::pgn::Refresh 1} 132 133 $w.menu.color add command -label PgnColorHeader \ 134 -command {::pgn::ChooseColor Header "header text"} 135 $w.menu.color add command -label PgnColorAnno \ 136 -command {::pgn::ChooseColor Nag annotation} 137 $w.menu.color add command -label PgnColorComments \ 138 -command {::pgn::ChooseColor Comment comment} 139 $w.menu.color add command -label PgnColorVars \ 140 -command {::pgn::ChooseColor Var variation} 141 $w.menu.color add command -label PgnColorBackground \ 142 -command {::pgn::ChooseColor Background background} 143 $w.menu.color add command -label PgnColorCurrent -command {::pgn::ChooseColor Current current} 144 145 $w.menu.helpmenu add command -label PgnHelpPgn -command {helpWindow PGN} 146 $w.menu.helpmenu add command -label PgnHelpIndex -command {helpWindow Index} 147 148 ::pgn::ConfigMenus 149 150 frame $w.frame 151 text $w.text -wrap word \ 152 -background $pgnColor(Background) -cursor crosshair \ 153 -tabs {1c right 2c 4c} 154 if { $::pgn::boldMainLine } { 155 $w.text configure -font font_Bold 156 } 157 158 autoscrollframe -bars y $w.frame "" $w.text 159 grid $w.frame -sticky news 160 grid rowconfigure $w 0 -weight 1 161 grid columnconfigure $w 0 -weight 1 162 163 set pgnWin 1 164 bind $w <Destroy> { set pgnWin 0 } 165 166 # Take input focus even if -state is disabled 167 bind $w.text <ButtonPress-1> "focus %W" 168 169 # Bind right button to popup a contextual menu: 170 bind $w.text <ButtonPress-$::MB3> "::pgn::contextMenu .pgnWin.text %X %Y" 171 172 # Workaround for Text widget bug (Tk 8.6.6+) 173 # The new "asynchronous update of line heights" does not work if 174 # the Text widget is inside an inactive ttk::notebook tab. 175 if {![catch { $w.text sync }]} { bind $w.text <Visibility> "$w.text sync" } 176 177 $w.text tag add Current 0.0 0.0 178 ::pgn::ResetColors 179 } 180 181 ################################################################################ 182 # 183 ################################################################################ 184 proc contextMenu {win x y} { 185 186 update idletasks 187 188 set mctxt $win.ctxtMenu 189 if { [winfo exists $mctxt] } { destroy $mctxt } 190 if {[sc_var level] == 0} { 191 set state disabled 192 } else { 193 set state normal 194 } 195 196 menu $mctxt 197 198 menu $mctxt.evals1 199 $mctxt.evals1 add command -label "Clear" -command {::addNag X} 200 $mctxt.evals1 add command -label "!" -command {::addNag !} 201 $mctxt.evals1 add command -label "?" -command {::addNag ?} 202 $mctxt.evals1 add command -label "!?" -command {::addNag !?} 203 $mctxt.evals1 add command -label "?!" -command {::addNag ?!} 204 $mctxt.evals1 add command -label "!!" -command {::addNag !!} 205 $mctxt.evals1 add command -label "??" -command {::addNag ??} 206 207 menu $mctxt.evals2 208 $mctxt.evals2 add command -label "Clear" -command {::addNag Y} 209 $mctxt.evals2 add command -label "=" -command {::addNag =} 210 $mctxt.evals2 add command -label "~" -command {::addNag ~} 211 $mctxt.evals2 add command -label "+=" -command {::addNag +=} 212 $mctxt.evals2 add command -label "=+" -command {::addNag =+} 213 $mctxt.evals2 add command -label "+/-" -command {::addNag +/-} 214 $mctxt.evals2 add command -label "-/+" -command {::addNag -/+} 215 $mctxt.evals2 add command -label "+-" -command {::addNag +-} 216 $mctxt.evals2 add command -label "-+" -command {::addNag -+} 217 $mctxt.evals2 add command -label "+--" -command {::addNag +--} 218 $mctxt.evals2 add command -label "--+" -command {::addNag --+} 219 $mctxt.evals2 add command -label "N" -command {::addNag N} 220 $mctxt.evals2 add command -label "D" -command {::addNag D} 221 222 $mctxt add command -label [tr EditDelete] -state $state -command "::pgn::deleteVar" 223 $mctxt add command -label [tr EditFirst] -state $state -command "::pgn::firstVar" 224 $mctxt add command -label [tr EditMain] -state $state -command "::pgn::mainVar" 225 $mctxt add separator 226 $mctxt add command -label "[tr EditStrip]:[tr EditStripBegin]" -command {::game::TruncateBegin} 227 $mctxt add command -label "[tr EditStrip]:[tr EditStripEnd]" -command {::game::Truncate} 228 $mctxt add separator 229 $mctxt add command -label "[tr EditStrip]:[tr EditStripComments]" -command {::game::Strip comments} 230 $mctxt add command -label "[tr EditStrip]:[tr EditStripVars]" -command {::game::Strip variations} 231 $mctxt add separator 232 $mctxt add cascade -label "! ? ..." -menu $mctxt.evals1 233 $mctxt add cascade -label "+- +/- ..." -menu $mctxt.evals2 234 $mctxt add command -label "[tr WindowsComment]" -command {::makeCommentWin} 235 236 tk_popup $mctxt $x $y 237 } 238 239 proc deleteVar {} { 240 undoFeature save 241 sc_var delete 242 updateBoard -pgn 243 } 244 245 proc firstVar {} { 246 undoFeature save 247 sc_var first 248 updateBoard -pgn 249 } 250 251 proc mainVar {} { 252 undoFeature save 253 sc_var promote 254 updateBoard -pgn 255 } 256 ################################################################################ 257 # ::pgn::ShowBoard: 258 # Produces a popup window showing the board position in the 259 # game at the current mouse location in the PGN window. 260 # 261 ################################################################################ 262 proc ShowBoard {win moveTag xc yc} { 263 set offSet [sc_pos pgnOffset] 264 sc_move pgn [string range $moveTag 2 end] 265 set bd [sc_pos board] 266 if {[::board::isFlipped .main.board]} {set bd [string reverse [lindex $bd 0]]} 267 sc_move pgn $offSet 268 269 set w .pgnPopup 270 set psize 30 271 if {$psize > $::boardSize} { set psize $::boardSize } 272 273 if {! [winfo exists $w]} { 274 toplevel $w -relief solid -borderwidth 2 275 wm withdraw $w 276 wm overrideredirect $w 1 277 ::board::new $w.bd $psize 278 pack $w.bd -side top -padx 2 -pady 2 279 wm withdraw $w 280 } 281 282 ::board::update $w.bd $bd 283 284 # Make sure the popup window can fit on the screen: 285 incr xc 5 286 incr yc 5 287 update idletasks 288 set dx [winfo width $w] 289 set dy [winfo height $w] 290 if {($xc+$dx) > [winfo screenwidth $w]} { 291 set xc [expr {[winfo screenwidth $w] - $dx}] 292 } 293 if {($yc+$dy) > [winfo screenheight $w]} { 294 set yc [expr {[winfo screenheight $w] - $dy}] 295 } 296 wm geometry $w "+$xc+$yc" 297 wm deiconify $w 298 raiseWin $w 299 } 300 301 ################################################################################ 302 # ::pgn::HideBoard 303 # 304 # Hides the window produced by ::pgn::ShowBoard. 305 # 306 ################################################################################ 307 proc HideBoard {} { 308 if {[winfo exists .pgnPopup]} {wm withdraw .pgnPopup} 309 } 310 311 ################################################################################ 312 # # ::pgn::ResetColors 313 # 314 # Reconfigures the pgn Colors, after a color is changed by the user 315 # 316 ################################################################################ 317 proc ResetColors {} { 318 global pgnColor 319 if {![winfo exists .pgnWin]} { return } 320 .pgnWin.text configure -background $pgnColor(Background) 321 .pgnWin.text tag configure Current -background $pgnColor(Current) 322 ::htext::init .pgnWin.text 323 ::htext::updateRate .pgnWin.text 0 324 ::pgn::Refresh 1 325 } 326 ################################################################################ 327 # ::pgn::Refresh 328 # 329 # Updates the PGN window. If $pgnNeedsUpdate == 0, then the 330 # window text is not regenerated; only the current and next move 331 # tags will be updated. 332 ################################################################################ 333 proc Refresh { {pgnNeedsUpdate 0} } { 334 if {![winfo exists .pgnWin]} { return } 335 336 if {$pgnNeedsUpdate} { 337 busyCursor . 338 set format plain 339 if {$::pgn::showColor} {set format color} 340 set pgnStr [sc_game pgn -symbols $::pgn::symbolicNags \ 341 -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments \ 342 -space $::pgn::moveNumberSpaces -format $format -column $::pgn::columnFormat \ 343 -short $::pgn::shortHeader -markCodes $::pgn::stripMarks] 344 345 set windowTitle [format $::tr(PgnWindowTitle) [sc_game number]] 346 ::setTitle .pgnWin "$windowTitle" 347 .pgnWin.text configure -state normal 348 .pgnWin.text delete 1.0 end 349 350 if {$::pgn::showColor} { 351 ::htext::display .pgnWin.text $pgnStr 352 } else { 353 .pgnWin.text insert 1.0 $pgnStr 354 } 355 356 if {$::pgn::showPhoto} { 357 updatePlayerPhotos 358 if {[image width photoW] != 0} { 359 .pgnWin.text image create 1.0 -image photoW -padx 10 -pady 10 360 } 361 if {[image width photoB] != 0} { 362 .pgnWin.text image create 1.end -image photoB -padx 10 -pady 10 363 } 364 } 365 366 .pgnWin.text configure -state disabled 367 unbusyCursor . 368 } 369 370 if {$::pgn::showColor} { 371 set offset [sc_pos pgnOffset] 372 .pgnWin.text tag remove Current 1.0 end 373 set moveRange [.pgnWin.text tag nextrange "m_$offset" 1.0] 374 if {[llength $moveRange] == 2} { 375 .pgnWin.text tag add Current [lindex $moveRange 0] [lindex $moveRange 1] 376 .pgnWin.text see [lindex $moveRange 1] 377 } else { 378 .pgnWin.text yview moveto 0 379 } 380 } 381 } 382 ################################################################################ 383 # 384 ################################################################################ 385 386} 387