blob: c43b8012fefad3cefc1b61f415f1147d7868f775 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
package require BLT
namespace import blt::
namespace eval ::ix {
variable _
proc random_int {} {
return [expr "int(floor(rand()*16))"]
}
proc random_clr {} {
return [format "\#%1X%1X%1X%1X%1X%1X" [random_int] [random_int] [random_int] [random_int] [random_int] [random_int]]
}
proc lg_add {path tg args} {
variable _
set e [lindex $args 1]
set l [llength $args]
for {set n 2} {$n < $l} {incr n} {
if {$l > 3} {set nm $e:[expr $n - 1]} else {set nm $e}
set _($path:$nm:e) [expr $n - 1]
set _($path:$nm:p) $e
set _($path:$e:n) [expr $l - 2]
lg_list $path $tg $nm [lindex $args 0] [lindex $args $n]
}
}
proc lg_dumper {path tg args} {
variable _
foreach e [$path element names] {
if {$_($path:$e:e) == 1} {
lg_dump $path $tg $e
}
}
}
proc lg_dump {path tg e} {
variable _
set p $_($path:$e:p)
set el $_($path:$e:e)
set n $_($path:$p:n)
for {set i 0} {$i < [$tg:x$e length]} {incr i} {
set out {}
lappend out [$tg:x$e index $i]
lappend out $p
if {$n > 1} {
for {set x 1} {$x <= $n} {incr x} {
lappend out [$tg:y$p:$x index $i]
}
} else {
lappend out [$tg:y$e index $i]
}
set out [join $out " "]
# puts $out
pd "$tg.rp _cb $out;"
}
}
proc lg_list {path tg e i1 i2} {
if {[$path element exists $e] != 1} {lg_nv $path $tg $e}
$tg:y$e append $i2
$tg:x$e append $i1
}
proc lg_zoom {path tg d x y} {
puts "$path $tg $d"
if {$d eq "in"} {set dn 4} {set dn 1}
set lx [$path axis limits x]
set dx [expr ([lindex $lx 1] - [lindex $lx 0]) / $dn]
set cx [$path axis invtransform x $x]
set cy [$path axis invtransform y $y]
set ly [$path axis limits y]
set dy [expr ([lindex $ly 1] - [lindex $ly 0]) / $dn]
$path axis configure x -min [expr $cx - $dx] -max [expr $cx + $dx]
$path axis configure y -min [expr $cy - $dy] -max [expr $cy + $dy]
}
proc lg_dr {path tg e x y} {
variable _
if {[$path element closest $x $y cl -halo 666 -interpolate 1 -along x $e] == 1} {
set new [$path axis invtransform y $y]
set n $tg:y$cl(name)
set io $_($path:clickd)
set ic $cl(index)
$n index $ic $new
if {$io != -1 && [expr abs($io - $ic)] > 1} {lg_smooth $io $ic $n}
set _($path:clickd) $ic
}
}
proc lg_smooth {io ic n} {
# puts "smoothing $n from $io to $ic"
set vo [$n index $io]
set vc [$n index $ic]
if {$ic > $io} {set is $io; set vs $vo} else {set is $ic; set vs $vc}
set ne [expr [$n length] - 1]
if {$ic != $ne && $io != $ne} {
for {set i 1} {$i < [expr abs($io - $ic)]} {incr i} {
set nv [expr $vs + (($vc - $vo) * $i / ($ic - $io))]
set ni [expr $is + $i]
$n index $ni $nv
}
}
}
proc lg_sl {path tg e x y} {
variable _
set t [$path invtransform $x $y]
if {$_($path:clickd) != -1} {
set dx [expr [lindex $t 0] - [lindex $_($path:clcord) 0]]
set dy [expr [lindex $t 1] - [lindex $_($path:clcord) 1]]
set p $_($path:$e:p)
set el $_($path:$e:e)
set n $_($path:$p:n)
if {$n > 1} {
for {set i 1} {$i <= $n} {incr i} {
set tx $tg:x$p:$i
set ty $tg:y$p:$i
$tx expr "$tx + $dx"
if {$el == $i} {$ty expr "$ty + $dy"}
}
} else {
$tg:x$e expr "$tg:x$e + $dx"
$tg:y$e expr "$tg:y$e + $dy"
}
}
set _($path:clcord) $t
set _($path:clickd) 1
}
proc lg_draw {path tg e x y} {
variable _
if {[$path element closest $x $y cl -halo 666 -interpolate 1 -along x $e] == 1} {
set t [$path invtransform $x $y]
set p $_($path:$e:p)
set el $_($path:$e:e)
set n $_($path:$p:n)
set io $_($path:clickd)
set ic $cl(index)
if {$n > 1} {
for {set i 1} {$i <= $n} {incr i} {
set tx $tg:x$p:$i
set ty $tg:y$p:$i
if {$el == $i} {set ny [lindex $t 1]} else {
if {[$ty length] == $ic} {set tc [expr $ic - 1]} else {set tc $ic}
set ny [$ty index $tc]
}
set nx [lindex $t 0]
$ty append $ny
$tx append $nx
$tx sort $ty
if {$i == 1} {
if {$ic < $io} {incr io}
incr ic
}
if {$io != -1 && [expr abs($io - $ic)] > 1} {lg_smooth $io $ic $ty}
}
} else {
$tg:y$e append [lindex $t 1]
$tg:x$e append [lindex $t 0]
$tg:x$e sort $tg:y$e
if {$ic < $io} {incr io}
incr ic
if {$io != -1 && [expr abs($io - $ic)] > 1} {lg_smooth $io $ic $tg:y$e}
}
set _($path:clickd) $ic
}
}
proc lg_trim {path tg e x y} {
variable _
if {[$path element closest $x $y cl -halo 666 -interpolate 1 -along x $e] == 1} {
# foreach name [array names cl] {puts "$name $cl($name)"}
if {[expr abs([$path axis transform x [$tg:x$e index $cl(index)]] - $x.0)] < 32} {
set p $_($path:$cl(name):p)
set n $_($path:$p:n)
if {$n > 1} {
for {set i 1} {$i <= $n} {incr i} {
$tg:y$p:$i delete $cl(index)
$tg:x$p:$i delete $cl(index)
}
} else {
$tg:y$cl(name) delete $cl(index)
$tg:x$cl(name) delete $cl(index)
}
}
}
}
proc lg_cl {path tg} {
foreach e [$path element names] {lg_dv $path $tg $e}
# pd "$tg.rp _cb symbol clear;"
}
proc lg_de {path tg e} {
variable _
set n $_($path:$e:n)
if {$n > 1} {
for {set i 1} {$i <= $n} {incr i} {
lg_dv $path $tg $e:$i
}
} else {
lg_dv $path $tg $e
}
}
proc lg_dv {path tg e} {
blt::vector destroy $tg:x$e
blt::vector destroy $tg:y$e
$path element delete $e
# pd "$tg.rp _cb delete $e;"
}
proc lg_nv {path tg e} {
variable _
blt::vector create $tg:x$e -variable ""
blt::vector create $tg:y$e -variable ""
set _($path:clickd) -1
$path element create $e -x $tg:x$e -y $tg:y$e -symbol "circle" -pixels 2 -linewidth 2 -color [random_clr] -hide 0
# puts "creating: $path $e -x $tg:x$e -y $tg:y$e -color [random_clr] -hide 0"
$path element bind $e <B1-Motion> "::ix::lg_dr $path $tg $e %x %y"
$path element bind $e <Shift-B1-Motion> "::ix::lg_sl $path $tg $e %x %y"
$path element bind $e <Control-B1-Motion> "::ix::lg_draw $path $tg $e %x %y"
$path element bind $e <Alt-B1-Motion> "::ix::lg_trim $path $tg $e %x %y"
# $path element bind $e <1> "::ix::lg_dr $path $tg $e %x %y"
$path element bind $e <ButtonRelease-1> "set ::ix::_($path:clickd) -1"
# $path element bind $e <Shift-ButtonRelease-1> "set ::ix::_($path:clickd) -1"
}
proc lg_new {path tg} {
bind $path <ButtonPress-3> {}
bind $path <Button-4> "::ix::lg_zoom $path $tg in %x %y"
bind $path <Button-5> "::ix::lg_zoom $path $tg out %x %y"
bind $path <Control-Button-4> "$path axis configure x -min {} -max {}; $path axis configure y -min {} -max {}"
bind $path <Control-Button-5> [bind $path <Control-Button-4>]
Blt_ZoomStack $path "2" "Control-2"
$path axis configure x -background [$path cget -bg]
$path axis configure y -background [$path cget -bg]
}
}
#> lg blt::graph
#. -bg yellow -halo 16
#. @clear ::ix::lg_cl .- .|
#. @delete ::ix::lg_de .- .| .#1
#. @list ::ix::lg_add .- .| .#args
#. @add ::ix::lg_add .- .| .#args
#. @dump ::ix::lg_dumper .- .| .#args
#. @cmd eval ".- .#args"
::ix::lg_new .- .|
puts "lg .- .|"
|
