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