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