Scid  4.6.5
pgn.tcl
Go to the documentation of this file.
1 ############################################################
2 ### PGN window
3 
4 namespace 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 {} {
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  if {[winfo exists .pgnWin]} {
65  focus .
66  destroy .pgnWin
67  set pgnWin 0
68  return
69  }
70 
71  set w .pgnWin
72 
74 
76  setWinSize $w
77  bind $w <Configure> "recordWinSize $w"
78 
79  menu $w.menu
80  ::setMenu $w $w.menu
81 
82  $w.menu add cascade -label PgnFile -menu $w.menu.file -underline 0
83  $w.menu add cascade -label PgnOpt -menu $w.menu.opt -underline 0
84  $w.menu add cascade -label PgnColor -menu $w.menu.color -underline 0
85  $w.menu add cascade -label PgnHelp -menu $w.menu.helpmenu -underline 0
86  foreach i {file opt color helpmenu} {
87  menu $w.menu.$i -tearoff 0
88  }
89 
90  $w.menu.file add command -label PgnFileCopy -command {::pgn::PgnClipboardCopy }
91 
92  $w.menu.file add command -label PgnFilePrint -command {
93  set ftype {
94  { "PGN files" {".pgn"} }
95  { "Text files" {".txt"} }
96  { "All files" {"*"} }
97  }
98  set fname [tk_getSaveFile -initialdir [pwd] -filetypes $ftype -title "Save PGN file"]
99  if {$fname != ""} {
100  if {[file extension $fname] != ".txt" && [file extension $fname] != ".pgn" } {
101  append fname ".pgn"
102  }
103  if {[catch {set tempfile [open $fname w]}]} {
104  tk_messageBox -title "Scid: Error saving file" -type ok -icon warning \
105  -message "Unable to save the file: $fname\n\n"
106  } else {
107  puts $tempfile \
108  [sc_game pgn -width 75 -symbols $::pgn::symbolicNags \
109  -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments \
110  -space $::pgn::moveNumberSpaces -format plain -column $::pgn::columnFormat \
111  -markCodes $::pgn::stripMarks]
112  close $tempfile
113  }
114  }
115  }
116  $w.menu.file add separator
117  $w.menu.file add command -label PgnFileClose -accelerator Esc \
118  -command "focus .; destroy $w"
119 
120  $w.menu.opt add checkbutton -label PgnOptColor \
121  -variable ::pgn::showColor -command {updateBoard -pgn}
122  $w.menu.opt add checkbutton -label PgnOptShort \
123  -variable ::pgn::shortHeader -command {updateBoard -pgn}
124  $w.menu.opt add checkbutton -label PgnOptSymbols \
125  -variable ::pgn::symbolicNags -command {updateBoard -pgn}
126  $w.menu.opt add checkbutton -label PgnOptIndentC \
127  -variable ::pgn::indentComments -command {updateBoard -pgn}
128  $w.menu.opt add checkbutton -label PgnOptIndentV \
129  -variable ::pgn::indentVars -command {updateBoard -pgn}
130  $w.menu.opt add checkbutton -label PgnOptSpace \
131  -variable ::pgn::moveNumberSpaces -command {updateBoard -pgn}
132  $w.menu.opt add checkbutton -label PgnOptColumn \
133  -variable ::pgn::columnFormat -command {updateBoard -pgn}
134  $w.menu.opt add checkbutton -label PgnOptStripMarks \
135  -variable ::pgn::stripMarks -command {updateBoard -pgn}
136  $w.menu.opt add checkbutton -label PgnOptBoldMainLine \
137  -variable ::pgn::boldMainLine -command {updateBoard -pgn}
138  $w.menu.opt add checkbutton -label GInfoPhotos \
139  -variable ::pgn::showPhoto -command {::pgn::Refresh 1}
140 
141  $w.menu.color add command -label PgnColorHeader \
142  -command {::pgn::ChooseColor Header "header text"}
143  $w.menu.color add command -label PgnColorAnno \
144  -command {::pgn::ChooseColor Nag annotation}
145  $w.menu.color add command -label PgnColorComments \
146  -command {::pgn::ChooseColor Comment comment}
147  $w.menu.color add command -label PgnColorVars \
148  -command {::pgn::ChooseColor Var variation}
149  $w.menu.color add command -label PgnColorBackground \
150  -command {::pgn::ChooseColor Background background}
151  $w.menu.color add command -label PgnColorCurrent -command {::pgn::ChooseColor Current current}
152 
153  $w.menu.helpmenu add command -label PgnHelpPgn \
154  -accelerator F1 -command {helpWindow PGN}
155  $w.menu.helpmenu add command -label PgnHelpIndex -command {helpWindow Index}
156 
158 
159  text $w.text -width $::winWidth($w) -height $::winHeight($w) -wrap word \
160  -background $pgnColor(Background) -cursor crosshair \
161  -yscrollcommand "$w.scroll set" -setgrid 1 -tabs {1c right 2c 4c}
162  if { $::pgn::boldMainLine } {
163  $w.text configure -font font_Bold
164  }
165 
166  ttk::scrollbar $w.scroll -command "$w.text yview" -takefocus 0
167  pack [ttk::frame $w.buttons] -side bottom -fill x
168  pack $w.scroll -side right -fill y
169  pack $w.text -fill both -expand yes
170  ttk::button $w.buttons.help -textvar ::tr(Help) -command { helpWindow PGN }
171  ttk::button $w.buttons.close -textvar ::tr(Close) -command { focus .; destroy .pgnWin }
172  #pack $w.buttons.close $w.buttons.help -side right -padx 5 -pady 2
173  set pgnWin 1
174  bind $w <Destroy> { set pgnWin 0 }
175 
176  # Bind left button to close ctxt menu:
177  bind $w <ButtonPress-1> {
178  if {[winfo exists .pgnWin.text.ctxtMenu]} { destroy .pgnWin.text.ctxtMenu; focus .pgnWin }
179  }
180 
181  bind $w <ButtonRelease-$::MB2> ::pgn::HideBoard
182 
183  # Bind right button to popup a contextual menu:
184  bind $w <ButtonPress-$::MB3> "::pgn::contextMenu .pgnWin.text 5 %x %y %X %Y"
185 
186  # set the same arrow key, etc bindings that the main window has:
187  bind $w <F1> { helpWindow PGN }
188  bind $w <Escape> {
189  if {[winfo exists .pgnWin.text.ctxtMenu]} {
190  destroy .pgnWin.text.ctxtMenu
191  focus .pgnWin
192  } else {
193  focus .
194  destroy .pgnWin
195  }
196  }
198  set ::keyboardShortcutsExcept($w.text) 1
199 
200  $w.text tag add Current 0.0 0.0
202 
204  }
205 
206  ################################################################################
207  #
208  ################################################################################
209  proc contextMenu {win startLine x y xc yc} {
210 
211  update idletasks
212 
213  set mctxt $win.ctxtMenu
214  if { [winfo exists $mctxt] } { destroy $mctxt}
215  if {[sc_var level] == 0} {
216  set state disabled
217  } else {
218  set state normal
219  }
220 
221  menu $mctxt
222 
223  menu $mctxt.evals1
224  $mctxt.evals1 add command -label "Clear" -command {::addNag X}
225  $mctxt.evals1 add command -label "!" -command {::addNag !}
226  $mctxt.evals1 add command -label "?" -command {::addNag ?}
227  $mctxt.evals1 add command -label "!?" -command {::addNag !?}
228  $mctxt.evals1 add command -label "?!" -command {::addNag ?!}
229  $mctxt.evals1 add command -label "!!" -command {::addNag !!}
230  $mctxt.evals1 add command -label "??" -command {::addNag ??}
231 
232  menu $mctxt.evals2
233  $mctxt.evals2 add command -label "Clear" -command {::addNag Y}
234  $mctxt.evals2 add command -label "=" -command {::addNag =}
235  $mctxt.evals2 add command -label "~" -command {::addNag ~}
236  $mctxt.evals2 add command -label "+=" -command {::addNag +=}
237  $mctxt.evals2 add command -label "=+" -command {::addNag =+}
238  $mctxt.evals2 add command -label "+/-" -command {::addNag +/-}
239  $mctxt.evals2 add command -label "-/+" -command {::addNag -/+}
240  $mctxt.evals2 add command -label "+-" -command {::addNag +-}
241  $mctxt.evals2 add command -label "-+" -command {::addNag -+}
242  $mctxt.evals2 add command -label "+--" -command {::addNag +--}
243  $mctxt.evals2 add command -label "--+" -command {::addNag --+}
244  $mctxt.evals2 add command -label "N" -command {::addNag N}
245  $mctxt.evals2 add command -label "D" -command {::addNag D}
246 
247  $mctxt add command -label [tr EditDelete] -state $state -command "::pgn::deleteVar [sc_var number]"
248  $mctxt add command -label [tr EditFirst] -state $state -command "::pgn::firstVar [sc_var number]"
249  $mctxt add command -label [tr EditMain] -state $state -command "::pgn::mainVar"
250  $mctxt add separator
251  $mctxt add command -label "[tr EditStrip]:[tr EditStripBegin]" -command {::game::TruncateBegin}
252  $mctxt add command -label "[tr EditStrip]:[tr EditStripEnd]" -command {::game::Truncate}
253  $mctxt add separator
254  $mctxt add command -label "[tr EditStrip]:[tr EditStripComments]" -command {::game::Strip comments}
255  $mctxt add command -label "[tr EditStrip]:[tr EditStripVars]" -command {::game::Strip variations}
256  $mctxt add separator
257  $mctxt add cascade -label "! ? ..." -menu $mctxt.evals1
258  $mctxt add cascade -label "+- +/- ..." -menu $mctxt.evals2
259  $mctxt add command -label "[tr WindowsComment]" -command {::makeCommentWin}
260 
261  $mctxt post [winfo pointerx .] [winfo pointery .]
262 
263  }
264 
265  proc deleteVar { var } {
266  undoFeature save
267  sc_var exit
268  sc_var delete $var
269  updateBoard -pgn
270  }
271 
272  proc firstVar { var } {
273  sc_var exit
274  sc_var first $var
275  updateBoard -pgn
276  }
277 
278  proc mainVar {} {
279  undoFeature save
280  sc_var promote
281  updateBoard -pgn
282  }
283  ################################################################################
284  # ::pgn::ShowBoard:
285  # Produces a popup window showing the board position in the
286  # game at the current mouse location in the PGN window.
287  #
288  ################################################################################
289  proc ShowBoard {win moveTag xc yc} {
290  set offSet [sc_pos pgnOffset]
291  sc_move pgn [string range $moveTag 2 end]
292  set bd [sc_pos board]
293  if {[::board::isFlipped .main.board]} {set bd [string reverse [lindex $bd 0]]}
294  sc_move pgn $offSet
295 
296  set w .pgnPopup
297  set psize 30
298  if {$psize > $::boardSize} { set psize $::boardSize}
299 
300  if {! [winfo exists $w]} {
301  toplevel $w -relief solid -borderwidth 2
302  wm withdraw $w
303  wm overrideredirect $w 1
304  ::board::new $w.bd $psize
305  pack $w.bd -side top -padx 2 -pady 2
306  wm withdraw $w
307  }
308 
309  ::board::update $w.bd $bd
310 
311  # Make sure the popup window can fit on the screen:
312  incr xc 5
313  incr yc 5
314  update idletasks
315  set dx [winfo width $w]
316  set dy [winfo height $w]
317  if {($xc+$dx) > [winfo screenwidth $w]} {
318  set xc [expr {[winfo screenwidth $w] - $dx}]
319  }
320  if {($yc+$dy) > [winfo screenheight $w]} {
321  set yc [expr {[winfo screenheight $w] - $dy}]
322  }
323  wm geometry $w "+$xc+$yc"
324  wm deiconify $w
325  raiseWin $w
326  }
327 
328  ################################################################################
329  # ::pgn::HideBoard
330  #
331  # Hides the window produced by ::pgn::ShowBoard.
332  #
333  ################################################################################
334  proc HideBoard {} {
335  if {[winfo exists .pgnPopup]} {wm withdraw .pgnPopup}
336  }
337 
338  ################################################################################
339  # # ::pgn::ResetColors
340  #
341  # Reconfigures the pgn Colors, after a color is changed by the user
342  #
343  ################################################################################
344  proc ResetColors {} {
345  global pgnColor
346  if {![winfo exists .pgnWin]} { return}
347  .pgnWin.text configure -background $pgnColor(Background)
348  .pgnWin.text tag configure Current -background $pgnColor(Current)
349  ::htext::init .pgnWin.text
350  ::htext::updateRate .pgnWin.text 0
352  }
353  ################################################################################
354  # ::pgn::Refresh
355  #
356  # Updates the PGN window. If $pgnNeedsUpdate == 0, then the
357  # window text is not regenerated; only the current and next move
358  # tags will be updated.
359  ################################################################################
360  proc Refresh { {pgnNeedsUpdate 0} } {
361  if {![winfo exists .pgnWin]} { return}
362 
363  if {$pgnNeedsUpdate} {
364  busyCursor .
365  set format plain
366  if {$::pgn::showColor} {set format color}
367  set pgnStr [sc_game pgn -symbols $::pgn::symbolicNags \
368  -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments \
369  -space $::pgn::moveNumberSpaces -format $format -column $::pgn::columnFormat \
370  -short $::pgn::shortHeader -markCodes $::pgn::stripMarks]
371 
372  set windowTitle [format $::tr(PgnWindowTitle) [sc_game number]]
373  ::setTitle .pgnWin "$windowTitle"
374  .pgnWin.text configure -state normal
375  .pgnWin.text delete 1.0 end
376 
377  if {$::pgn::showColor} {
378  ::htext::display .pgnWin.text $pgnStr
379  } else {
380  .pgnWin.text insert 1.0 $pgnStr
381  }
382 
383  if {$::pgn::showPhoto} {
385  if {[image width photoW] != 0} {
386  .pgnWin.text image create 1.0 -image photoW -padx 10 -pady 10
387  }
388  if {[image width photoB] != 0} {
389  .pgnWin.text image create 1.end -image photoB -padx 10 -pady 10
390  }
391  }
392 
393  .pgnWin.text configure -state disabled
394  unbusyCursor .
395  }
396 
397  if {$::pgn::showColor} {
398  set offset [sc_pos pgnOffset]
399  .pgnWin.text tag remove Current 1.0 end
400  set moveRange [.pgnWin.text tag nextrange "m_$offset" 1.0]
401  if {[llength $moveRange] == 2} {
402  .pgnWin.text tag add Current [lindex $moveRange 0] [lindex $moveRange 1]
403  .pgnWin.text see [lindex $moveRange 1]
404  } else {
405  .pgnWin.text yview moveto 0
406  }
407  }
408  }
409  ################################################################################
410  #
411  ################################################################################
412 
413 }