Scid  4.6.5
comment.tcl
Go to the documentation of this file.
1 ############################################################
2 ### Comment Editor window
3 # Copyright (C) 2016 Fulvio Benini
4 #
5 # This file is part of Scid (Shane's Chess Information Database).
6 # Scid is free software: you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation.
9 
10 namespace eval ::windows::commenteditor {
11  variable isOpen 0
12  variable w_ .commentWin
13  variable undoComment_ 1
14  variable undoNAGs_ 1
15 
16  proc clearComment_ {} {
17  if {[sc_pos getComment] != ""} {
18  undoFeature save
19  sc_pos setComment ""
20  }
21  notify_
22  }
23 
24  proc clearNAGs_ {} {
25  if {[sc_pos getNags] != 0} {
26  undoFeature save
27  sc_pos clearNags
28  }
29  notify_
30  }
31 
32  proc notify_ {} {
33  after idle "::notify::PosChanged -pgn"
34  }
35 
36  proc storeComment_ {} {
37  variable w_
38  # The "end-1c" below is because Tk adds a newline to text contents:
39  set oldComment [sc_pos getComment]
40  set newComment [$w_.cf.txtframe.text get 1.0 end-1c]
41  if {[string compare "$oldComment" "$newComment"] == 0} { return}
42 
43  variable undoComment_
44  if { $undoComment_ } {
45  set undoComment_ 0
46  undoFeature save
47  }
48  sc_pos setComment $newComment
49  after cancel ::windows::commenteditor::notify_
50  after 1500 ::windows::commenteditor::notify_
51  }
52 
53  proc storeNAGs_ {} {
54  variable w_
55  set nag_stored [sc_pos getNags]
56  set nag_text [$w_.nf.text get]
57  #sc_pos getNags returns 0 when empty
58  if {$nag_text == ""} { set nag_text 0}
59  if {[string compare "$nag_text" "$nag_stored"] == 0} { return}
60 
61  variable undoNAGs_
62  if { $undoNAGs_ } {
63  set undoNAGs_ 0
64  undoFeature save
65  }
66  sc_pos clearNags
67  foreach {nag} [split "$nag_text" " "] {
68  sc_pos addNag $nag
69  }
70  after cancel ::windows::commenteditor::notify_
71  after 1500 ::windows::commenteditor::notify_
72  }
73 
74  proc updateMarkersCol_ {varname args} {
75  variable w_
76  if {![winfo exists $w_.mf]} { return}
77 
78  foreach b [winfo children $w_.mf.markers] {
79  $b configure -foreground $::markColor
80  }
81  }
82  trace add variable ::markColor write "::windows::commenteditor::updateMarkersCol_"
83 
84 }
85 
86 proc ::windows::commenteditor::createWin { {focus_if_exists 1} } {
87  variable w_
88  variable undoNAGs_
89  variable undoComment_
90 
91  if {! [::createWindow $w_ 530 220 "[tr {Comment editor}]"]} {
92  if { $focus_if_exists } {
93  focus $w_.cf.txtframe.text
94  } else {
95  focus .
96  destroy $w_
97  if {$undoComment_ == 0 || $undoNAGs_ == 0} {
98  after cancel ::windows::commenteditor::notify_
99  after 1 ::windows::commenteditor::notify_
100  }
101  }
102  return
103  }
104 
105  # NAGs frame:
106  ttk::frame $w_.nf
107  ttk::label $w_.nf.label -font font_Bold -text [tr AnnotationSymbols]
108  ttk::button $w_.nf.clear -text [tr Clear] -command "::windows::commenteditor::clearNAGs_"
109  ttk::entry $w_.nf.text
110  ttk::frame $w_.nf.b
111  set i 0
112  foreach {nag description} {
113  ! GoodMove
114  ? PoorMove
115  !! ExcellentMove
116  ?? Blunder
117  !? InterestingMove
118  ?! DubiousMove
119  +-- WhiteCrushing
120  --+ BlackCrushing
121  +- WhiteDecisiveAdvantage
122  -+ BlackDecisiveAdvantage
123  +/- WhiteClearAdvantage
124  -/+ BlackClearAdvantage
125  += WhiteSlightAdvantage
126  =+ BlackSlightAdvantage
127  = Equality
128  ~ Unclear
129  N Novelty
130  D Diagram
131  } {
132  ttk::button $w_.nf.b.b$i -text "$nag" -width 3 -command "::addNag $nag"
133  ::utils::tooltip::Set $w_.nf.b.b$i $description
134  grid $w_.nf.b.b$i -row [expr {$i % 2}] -column [expr {int($i / 2)}] -padx 2 -pady 2
135  incr i
136  }
137  grid columnconfig $w_.nf 0 -weight 1
138  grid $w_.nf.label $w_.nf.clear -sticky nsew
139  grid $w_.nf.text -sticky nsew -columnspan 2
140  grid $w_.nf.b -sticky nsew -columnspan 2
141 
142  # Comment frame:
143  ttk::frame $w_.cf
144  ttk::label $w_.cf.label -font font_Bold -text [tr Comment]
145  ttk::button $w_.cf.clear -text [tr Clear] -command "::windows::commenteditor::clearComment_"
146  ttk::frame $w_.cf.txtframe
147  autoscrollframe -bars y $w_.cf.txtframe text $w_.cf.txtframe.text \
148  -background white -wrap word -font font_Regular
149  grid rowconfig $w_.cf 1 -weight 1
150  grid columnconfig $w_.cf 0 -weight 1
151  grid $w_.cf.label $w_.cf.clear -sticky nsew
152  grid $w_.cf.txtframe -sticky nsew -columnspan 2
153 
154  ### Markers frame
155  ttk::frame $w_.mf
156  ttk::label $w_.mf.header -font font_Bold -text $::tr(InsertMark:)
157  set usage "Usage (on the main board):\n"
158  append usage "ctrl+click --> mark square\n"
159  append usage "ctrl+drag --> draw arrow"
160  ttk::label $w_.mf.usage -text "$usage"
161  ttk::frame $w_.mf.colors
162  set i 0
163  foreach color {
164  green
165  red
166  orange
167  yellow
168  blue
169  darkBlue
170  purple
171  white
172  black
173  gray
174  } {
175  radiobutton $w_.mf.colors.col_$color \
176  -indicatoron "false" \
177  -background "$color" -selectcolor "$color" \
178  -text " " -width 2 \
179  -variable "::markColor" -value "$color"
180  grid $w_.mf.colors.col_$color -row [expr {$i / 2}] -column [expr {int($i % 2)}]
181  incr i
182  }
183  ttk::frame $w_.mf.markers
184  set i 0
185  foreach {marker lbl} {
186  full █
187  circle ◯
188  disk ⬤
189  + +
190  - -
191  X X
192  ! !
193  ? ?
194  = =
195  A A
196  B B
197  C C
198  D D
199  E E
200  F F
201  0 0
202  1 1
203  2 2
204  3 3
205  4 4
206  5 5
207  6 6
208  7 7
209  8 8
210  9 9
211  } {
212  radiobutton $w_.mf.markers.mark_$marker \
213  -indicatoron "false" \
214  -foreground "$::markColor" -background "light gray" -selectcolor "dark gray" \
215  -text "$lbl" -width 2 \
216  -variable "::markType" -value "$marker"
217  grid $w_.mf.markers.mark_$marker -row [expr {$i % 5}] -column [expr {int($i / 5)}]
218  incr i
219  }
220  grid $w_.mf.header -columnspan 2 -sticky nsew -padx 8
221  grid $w_.mf.usage -columnspan 2 -sticky nsew -padx 8
222  grid $w_.mf.colors -row 2 -column 0 -sticky nsew -padx 8 -pady 8
223  grid $w_.mf.markers -row 2 -column 1 -sticky nsew -pady 8 -padx 8
224 
225  # Arrange frames:
226  grid $w_.cf -row 0 -column 0 -columnspan 2 -sticky nsew
227  grid $w_.mf -row 0 -rowspan 2 -column 2 -sticky nsew
228  grid $w_.nf -row 1 -column 0 -columnspan 2 -sticky nsew
229  grid rowconfig $w_ 0 -weight 1
230  grid columnconfig $w_ 0 -weight 1
231 
232  # Load current NAGs and comment
233  Refresh
234 
235  # Add bindings at the end, especially <Configure>
236  bind $w_ <F1> {helpWindow Comment}
237  bind $w_ <Destroy> "if {\[string equal $w_ %W\]} { set ::windows::commenteditor::isOpen 0 }"
238  bind $w_.nf.text <KeyRelease> "::windows::commenteditor::storeNAGs_"
239  bind $w_.cf.txtframe.text <KeyRelease> "::windows::commenteditor::storeComment_"
240 
241  set ::windows::commenteditor::isOpen 1
242  after idle focus $w_.cf.txtframe.text
243 }
244 
245 # Gets the comment and NAGs for the current position and updates the
246 # corresponding widgets.
247 # Disables NAGs widgets if at vstart (NAGs cannot be inserted before moves).
248 proc ::windows::commenteditor::Refresh {} {
249  variable w_
250  if {![winfo exists $w_]} { return}
251 
252  variable undoNAGs_ 1
253  variable undoComment_ 1
254 
255  set comment [sc_pos getComment]
256  $w_.cf.txtframe.text delete 1.0 end
257  $w_.cf.txtframe.text insert end $comment
258 
259  set nag [sc_pos getNags]
260  $w_.nf.text configure -state normal
261  $w_.nf.text delete 0 end
262  if {$nag != "0"} {
263  $w_.nf.text insert end $nag
264  }
265  # if at vstart, disable NAG codes
266  if {[sc_pos isAt vstart]} {
267  set state "disabled"
268  } else {
269  set state "normal"
270  }
271  $w_.nf.clear configure -state $state
272  $w_.nf.text configure -state $state
273  foreach c [winfo children $w_.nf.b] {
274  $c configure -state $state
275  }
276 }
277 
278 proc makeCommentWin {{toggle ""}} {
279  ::windows::commenteditor::createWin [string compare "$toggle" "toggle"]
280 }