Scid  4.6.5
ptracker.tcl
Go to the documentation of this file.
1 
2 ####################
3 # Piece tracker window
4 
5 namespace eval ::ptrack {}
6 
7 set ::ptrack::psize 35
8 set ::ptrack::select d1
9 set ::ptrack::moves(start) 1
10 set ::ptrack::moves(end) 20
11 set ::ptrack::mode "-games"
12 set ::ptrack::color blue
13 set ::ptrack::colors [list black red yellow cyan blue xblack xred xyellow xcyan xblue]
14 
15 trace variable ::ptrack::moves(start) w {::utils::validate::Integer 999 0}
16 trace variable ::ptrack::moves(end) w {::utils::validate::Integer 999 0}
17 
18 # ::ptrack::sq
19 # Given a square number (0=a1 to 63=h8), returns the square name.
20 #
21 proc ::ptrack::sq {n} {
22  set sq [lindex [list a b c d e f g h] [expr {$n % 8}]]
23  append sq [expr {int($n/8) + 1}]
24  return $sq
25 }
26 
27 # ::ptrack::unselect
28 # Unselects all pieces in the Piece Tracker window.
29 #
30 proc ::ptrack::unselect {} {
31  set w .ptracker
32  set ::ptrack::select {}
33  foreach i {a1 c1 e1 g1 b2 d2 f2 h2 a7 c7 e7 g7 b8 d8 f8 h8} {
34  $w.bd.p$i configure -background $::dark
35  }
36  foreach i {b1 d1 f1 h1 a2 c2 e2 g2 b7 d7 f7 h7 a8 c8 e8 g8} {
37  $w.bd.p$i configure -background $::lite
38  }
39 }
40 
41 # ::ptrack::select
42 # Selects all the listed pieces the Piece Tracker window.
43 #
44 proc ::ptrack::select {plist} {
46  foreach p $plist {
47  lappend ::ptrack::select $p
48  .ptracker.bd.p$p configure -background $::highcolor
49  }
50 }
51 
52 # ::ptrack::status
53 # Sets the Piece Tracker window status bar.
54 #
55 proc ::ptrack::status {{text ""}} {
56  set t .ptracker.status
57  if {$text == ""} {
58  $t configure -text "$::tr(Filter): [::windows::gamelist::filterText]"
59  } else {
60  $t configure -text $text
61  }
62 }
63 
64 # ::ptrack::recolor
65 # Changes the color scheme for track values.
66 #
67 proc ::ptrack::recolor {color} {
68  set ::ptrack::color $color
69  .ptracker.t.color.b configure -image ptrack_$::ptrack::color
70  ::ptrack::refresh color
71 }
72 
73 # ::ptrack::color
74 # Given a real value between 0.0 and 100.0, returns
75 # the corresponding Piece Tracker color value.
76 #
77 proc ::ptrack::color {pct {col ""}} {
78  if {$col == ""} {
79  set col $::ptrack::color
80  }
81  set x $pct
82  if {$x > 100.0} { set x 100.0}
83  if {$x < 0.01} { set x 0.01}
84  set y [expr {255 - round($x * 0.5 + 10 * log($x))}]
85  set yb [expr {255 - round($x * 2.0 + 10 * log($x))}]
86  if {$y > 255} { set y 255}
87  if {$yb > 255} { set yb 255}
88  if {$yb < 0} { set yb 0}
89  if {$y < 0} { set y 0}
90  if {$pct > 0.0 && $y == 0} { set y 1}
91  if {$pct > 0.0 && $yb == 0} { set yb 1}
92  set xy [expr {255 - $y}]
93  set xyb [expr {255 - $yb}]
94  switch $col {
95  black { set color [format "\#%02X%02X%02X" $yb $yb $yb]}
96  red { set color [format "\#%02X%02X%02X" $y $yb $yb]}
97  yellow { set color [format "\#%02X%02X%02X" $y $y $yb]}
98  cyan { set color [format "\#%02X%02X%02X" $yb $y $y]}
99  blue { set color [format "\#%02X%02X%02X" $yb $yb $y]}
100  xblack { set color [format "\#%02X%02X%02X" $xyb $xyb $xyb]}
101  xred { set color [format "\#%02X%02X%02X" $xyb $xy $xy]}
102  xyellow { set color [format "\#%02X%02X%02X" $xyb $xyb $xy]}
103  xcyan { set color [format "\#%02X%02X%02X" $xy $xyb $xyb]}
104  xblue { set color [format "\#%02X%02X%02X" $xy $xy $xyb]}
105  }
106  return $color
107 }
108 
109 # ::ptrack::make
110 # Creates the Piece Tracker window
111 #
112 proc ::ptrack::make {} {
113  set w .ptracker
114  if {[winfo exists $w]} { return}
115 
116  toplevel $w
117  wm title $w "Scid: [tr ToolsTracker]"
118  setWinLocation $w
119  bind $w <Escape> "destroy $w"
120  bind $w <F1> {helpWindow PTracker}
121  image create photo ptrack -width $::ptrack::psize -height $::ptrack::psize
122  label $w.status -width 1 -anchor w -relief sunken -font font_Small
123  pack $w.status -side bottom -fill x
124 
125  canvas $w.progress -height 20 -width 400 -bg white -relief solid -border 1
126  $w.progress create rectangle 0 0 0 0 -fill blue -outline blue -tags bar
127  $w.progress create text 395 10 -anchor e -font font_Regular -tags time \
128  -fill black -text "0:00 / 0:00"
129  pack $w.progress -side bottom -pady 2
130 
131  frame $w.bd
132  pack $w.bd -side left -padx 2 -pady 4
133 
134  frame $w.t
135  pack $w.t -side right -fill y -expand yes
136  pack [frame $w.gap -width 5] -side left
137 
138  frame $w.t.color
139  frame $w.t.mode
140  frame $w.t.moves
141  frame $w.t.buttons
142  pack $w.t.buttons -side bottom -fill x
143  pack $w.t.moves -side bottom
144  pack $w.t.mode -side bottom
145  pack $w.t.color -side bottom
146 
147  set ::ptrack::shade {}
148  for {set i 0} {$i < 64} {incr i} {
149  label $w.bd.sq$i -image ptrack -background white -border 1 -relief raised
150  set rank [expr {$i / 8}]
151  set file [expr {$i % 8}]
152  grid $w.bd.sq$i -row [expr {7 - $rank}] -column [expr {$file + 1}]
153  lappend ::ptrack::shade 0.0
154  }
155 
156  foreach rank {1 2 3 4 5 6 7 8} {
157  label $w.bd.r$rank -text $rank -width 2
158  grid $w.bd.r$rank -column 0 -row [expr {8 - $rank}]
159  }
160 
161  foreach column {1 2 3 4 5 6 7 8} file {a b c d e f g h} {
162  label $w.bd.f$file -text $file
163  grid $w.bd.f$file -row 8 -column $column
164  }
165 
166  grid [frame $w.bd.gap1 -height 5] -row 9 -column 0
167 
168  foreach file {a b c d e f g h} c {1 2 3 4 5 6 7 8} p {r n b q k b n r} {
169  set sq ${file}8
170  set b $w.bd.p$sq
171  label $b -image b$p$::ptrack::psize -border 1 -relief raised
172  grid $b -row 10 -column $c
173  bind $b <1> "::ptrack::select $sq"
174  }
175  foreach file {a b c d e f g h} c {1 2 3 4 5 6 7 8} p {p p p p p p p p} {
176  set sq ${file}7
177  set b $w.bd.p$sq
178  label $b -image b$p$::ptrack::psize -border 1 -relief raised
179  grid $b -row 11 -column $c
180  bind $b <1> "::ptrack::select $sq"
181  bind $b <$::MB3> "::ptrack::select {a7 b7 c7 d7 e7 f7 g7 h7}"
182  }
183  grid [frame $w.bd.gap2 -height 5] -row 12 -column 0
184  foreach file {a b c d e f g h} c {1 2 3 4 5 6 7 8} p {p p p p p p p p} {
185  set sq ${file}2
186  set b $w.bd.p$sq
187  label $b -image w$p$::ptrack::psize -border 1 -relief raised
188  grid $b -row 13 -column $c
189  bind $b <ButtonPress-1> "::ptrack::select $sq"
190  bind $b <$::MB3> "::ptrack::select {a2 b2 c2 d2 e2 f2 g2 h2}"
191  }
192  foreach file {a b c d e f g h} c {1 2 3 4 5 6 7 8} p {r n b q k b n r} {
193  set sq ${file}1
194  set b $w.bd.p$sq
195  label $b -image w$p$::ptrack::psize -border 1 -relief raised
196  grid $b -row 14 -column $c
197  bind $b <Button-1> "::ptrack::select $sq"
198  }
199 
200  # Both-piece bindings:
201  foreach sq {d1 e1 d8 e8} {
202  bind $w.bd.p$sq <$::MB3> [list ::ptrack::select $sq]
203  }
204  foreach left {a b c} right {h g f} {
205  set cmd [list ::ptrack::select [list ${left}1 ${right}1]]
206  bind $w.bd.p${left}1 <ButtonPress-$::MB3> $cmd
207  bind $w.bd.p${right}1 <ButtonPress-$::MB3> $cmd
208  set cmd [list ::ptrack::select [list ${left}8 ${right}8]]
209  bind $w.bd.p${left}8 <ButtonPress-$::MB3> $cmd
210  bind $w.bd.p${right}8 <ButtonPress-$::MB3> $cmd
211  }
212 
213  # Status-bar help:
214  foreach sq {d1 e1 d8 e8} {
215  bind $w.bd.p$sq <Any-Enter> {
216  ::ptrack::status $::tr(TrackerSelectSingle)
217  }
218  bind $w.bd.p$sq <Any-Leave> ::ptrack::status
219  }
220 
221  foreach sq {a1 b1 c1 f1 g1 h1 a8 b8 c8 f8 g8 h8} {
222  bind $w.bd.p$sq <Any-Enter> {
223  ::ptrack::status $::tr(TrackerSelectPair)
224  }
225  bind $w.bd.p$sq <Any-Leave> ::ptrack::status
226  }
227  foreach sq {a2 b2 c2 d2 e2 f2 g2 h2 a7 b7 c7 d7 e7 f7 g7 h7} {
228  bind $w.bd.p$sq <Any-Enter> {
229  ::ptrack::status $::tr(TrackerSelectPawn)
230  }
231  bind $w.bd.p$sq <Any-Leave> ::ptrack::status
232  }
233  set plist $::ptrack::select
235  ::ptrack::select $plist
236 
237  set f $w.t.text
238  pack [frame $f] -side top -fill both -expand yes -padx 2 -pady 2
239  text $f.text -width 28 -height 1 -foreground black -background white \
240  -yscrollcommand "$f.ybar set" -relief sunken -takefocus 0 \
241  -wrap none -font font_Small
242  set xwidth [font measure [$f.text cget -font] "x"]
243  foreach {tab justify} {3 r 5 l 19 r 29 r} {
244  set tabwidth [expr {$xwidth * $tab}]
245  lappend tablist $tabwidth $justify
246  }
247  $f.text configure -tabs $tablist
248  scrollbar $f.ybar -takefocus 0 -command "$f.text yview"
249  pack $f.ybar -side right -fill y
250  pack $f.text -side left -fill y -expand yes
251 
252  set f $w.t.color
253 
254  menubutton $f.b -menu $f.b.menu -indicatoron 0 -relief raised
255  menu $f.b.menu
256  foreach col $::ptrack::colors {
257  image create photo ptrack_$col -width 101 -height 20
258  for {set i 0} {$i <= 100} {incr i} {
259  set color [::ptrack::color $i $col]
260  ptrack_$col put $color -to $i 0 [expr {$i+1}] 19
261  }
262  $f.b.menu add command -image ptrack_$col \
263  -command "::ptrack::recolor $col"
264  }
265  $f.b configure -image ptrack_$::ptrack::color
266  label $f.label -text $::tr(GlistColor:) -font font_Bold
267  pack $f.label $f.b -side left -pady 5
268 
269  set f $w.t.mode
270  label $f.mode -text $::tr(TrackerStat:) -font font_Bold
271  grid $f.mode -row 0 -column 0
272  radiobutton $f.games -text $::tr(TrackerGames) -anchor w \
273  -variable ::ptrack::mode -value "-games"
274  radiobutton $f.time -text $::tr(TrackerTime) -anchor w \
275  -variable ::ptrack::mode -value "-time"
276  grid $f.games -row 1 -column 0 -sticky we
277  grid $f.time -row 2 -column 0 -sticky we
278 
279  set f $w.t.moves
280  label $f.lfrom -text $::tr(TrackerMoves:) -font font_Bold
281  entry $f.from -width 3 -justify right -textvariable ::ptrack::moves(start)
282  label $f.lto -text "-"
283  entry $f.to -width 3 -justify right -textvariable ::ptrack::moves(end)
284  pack $f.lfrom $f.from $f.lto $f.to -side left -pady 5
285  bindFocusColors $f.from
286  bindFocusColors $f.to
287  bind $f.from <FocusIn> [list +::ptrack::status $::tr(TrackerMovesStart)]
288  bind $f.from <FocusOut> +::ptrack::status
289  bind $f.to <FocusIn> [list +::ptrack::status $::tr(TrackerMovesStop)]
290  bind $f.to <FocusOut> +::ptrack::status
291 
292  set f $w.t.buttons
293  button $f.stop -text $::tr(Stop) -command progressBarCancel -state disabled
294  button $f.update -text $::tr(Update) -command ::ptrack::refresh
295  button $f.close -text $::tr(Close) -command "destroy $w"
296  pack $f.close $f.update $f.stop -side right -padx 3 -pady 5
298  bind $w <Configure> "recordWinSize $w"
299  wm resizable $w 0 0
300  focus $w.t.buttons.update
301 }
302 
303 # ::ptrack::refresh
304 # Regenerates Piece Tracker statistics and updates the window
305 #
306 proc ::ptrack::refresh {{type "all"}} {
307  set w .ptracker
308  if {! [winfo exists $w]} { return}
309 
310  # Check if only the color needs refreshing:
311  if {$type == "color"} {
312  for {set i 0} {$i < 64} {incr i} {
313  set x [lindex $::ptrack::shade $i]
314  $w.bd.sq$i configure -background [::ptrack::color $x]
315  }
316  return
317  }
318 
319  $w.t.buttons.update configure -state disabled
320  $w.t.buttons.close configure -state disabled
321  $w.t.buttons.stop configure -state normal
322  catch {grab $w.t.buttons.stop}
323 
324  if {$::ptrack::moves(end) < $::ptrack::moves(start)} {
325  set ::ptrack::moves(end) $::ptrack::moves(start)
326  }
327 
328  set timeMode 0
329  if {$::ptrack::mode == "-time"} { set timeMode 1}
330 
331  progressBarSet $w.progress 401 21
332  set err [catch { eval sc_base piecetrack $::ptrack::mode \
333  $::ptrack::moves(start) $::ptrack::moves(end) \
334  $::ptrack::select} ::ptrack::data]
335 
336  catch {grab release $w.t.buttons.stop}
337  $w.t.buttons.stop configure -state disabled
338  $w.t.buttons.update configure -state normal
339  $w.t.buttons.close configure -state normal
340 
341  if {$err} {
342  return
343  }
344 
345  set dfilter [sc_filter count]
346  if {$timeMode} {
347  set nmoves [expr {$::ptrack::moves(end) + 1 - $::ptrack::moves(start)}]
348  set dfilter [expr {$dfilter * $nmoves}]
349  }
350  if {$dfilter == 0} { set dfilter 1} ;# to avoid divide-by-zero
351 
352  set max 1
353  for {set i 0} {$i < 64} {incr i} {
354  set freq [lindex $::ptrack::data $i]
355  if {$freq > $max} {set max $freq}
356  }
357 
358  set ::ptrack::shade {}
359  for {set i 0} {$i < 64} {incr i} {
360  set freq [lindex $::ptrack::data $i]
361  set x [expr {$freq * 100.0 / $max}]
362  set color [::ptrack::color $x]
363  lappend ::ptrack::shade $x
364  $w.bd.sq$i configure -background $color
365  }
366 
367  # Update text frame:
368  set text $w.t.text.text
369  $text delete 1.0 end
370  array set printed {}
371  for {set top 1} {$top <= 64} {incr top} {
372  set best -1
373  set idx -1
374  for {set i 0} {$i < 64} {incr i} {
375  set n [lindex $::ptrack::data $i]
376  if {$n > $best && ![info exists printed($i)]} {
377  set idx $i
378  set best $n
379  }
380  }
381 
382  set printed($idx) 1
383  set pct [expr {round(double($best) * 10000.0 / double($dfilter)) / 100.0}]
384  set line [format "\t%2d.\t%s\t%7s\t%6.2f %%" $top \
385  [::ptrack::sq $idx] [::utils::thousands $best] $pct]
386  $text insert end "$line\n"
387  set status " [::ptrack::sq $idx]: [::utils::thousands $best] ($pct%%) $top/64"
388  bind $w.bd.sq$idx <Any-Enter> [list ::ptrack::status $status]
389  bind $w.bd.sq$idx <Any-Leave> ::ptrack::status
390  }
391 }