blob: 6d8f16d2d88499d87a67a73df55d4922f1b90933 (
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
|
namespace eval ::ix {
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]]
}
variable _
proc ngrid_new {path target w h bg ln div move spread radius max} {
variable _
if {[winfo exists $path.ngrid] != 1} {
canvas $path.ngrid -bg $bg -width $w -height $h
pack $path.ngrid -side left
bind $path.ngrid <1> "::ix::ngrid_click $path $target %x %y"
bind $path.ngrid <B1-Motion> [bind $path.ngrid <1>]
ngrid_gridlines $path $target $ln $div
set bd [expr {[$path cget -bd] * 2}]
$path configure -bg $bg -width [expr [winfo width $path.ngrid] + $bd] -height [expr [winfo height $path.ngrid] + $bd]
}
set _($target:recent) 0
set _($target:n) 0
set _($target:move) $move
set _($target:spread) $spread
set _($target:radius) $radius
set _($target:max) $max}
proc ngrid_find {which path target what udata} {
variable _
array set dm {x width y height}
for {set n 0 } {$n <= $_($target:n)} {incr n} {
foreach xy {x y} {
if {[$path.ngrid find withtag name_${xy}_$n] ne "" && [string match "$what*" [lindex $_($target:box$n:$xy) 0]]} {
set x [expr [lindex [$path.ngrid coords sqr_$n] 0] + $_($target:radius)]
set y [expr [lindex [$path.ngrid coords sqr_$n] 1] + $_($target:radius)]
set $xy [expr ($udata - [lindex $_($target:box$n:$xy) 1 ] + 0.0) / ([lindex $_($target:box$n:$xy) 2] - [lindex $_($target:box$n:$xy) 1 ] + 0.0) * [winfo $dm($xy) $path.ngrid]]
switch $which {
setpos {$path.ngrid coords sqr_$n [expr $x - $_($target:radius)] [expr $y - $_($target:radius)] [expr $x + $_($target:radius)] [expr $y + $_($target:radius)]}
pos {
set _($target:recent) $n
ngrid_click $path $target $x $y
}
remove {
$path.ngrid delete name_${xy}_$n
if {[$path.ngrid find withtag name_x_$n] eq "" && [$path.ngrid find withtag name_x_$n] eq ""} {
$path.ngrid delete sqr_$n; $path.ngrid delete hist_$n}}}}}}}
proc ngrid_vset {path target what where} {variable _; set _($target:$what) $where}
proc ngrid_add {path target name cur min max} {
variable _
if {$max == $min} {set max 1.0; set min 0.0}
array set justify {x left y right}
array set anchor {y e x w}
for {set n 0 } {$n <= $_($target:n)} {incr n} {foreach xy {x y} {
if {[$path.ngrid itemcget name_${xy}_$n -text] eq $name} {return}}}
for {set n 0 } {$n <= $_($target:n)} {incr n} {foreach xy {x y} {
if {[$path.ngrid find withtag name_x_$n] eq "" && [$path.ngrid find withtag name_y_$n] eq ""} {
set fill [set _($target:box$n:fill) [random_clr]]
$path.ngrid create oval 0 0 0 0 -tags sqr_$n -fill $fill -outline white -width 2
set rx [expr rand() * [winfo width $path.ngrid]]; set ry [expr rand() * [winfo height $path.ngrid]]
$path.ngrid create line $rx $ry $rx $ry -tags hist_$n -fill $fill
$path.ngrid bind sqr_$n <1> "set ::ix::_($target:recent) $n; ::ix::ngrid_click $path $target %x %y"
$path.ngrid bind sqr_$n <B1-Motion> [$path.ngrid bind sqr_$n <1>]
$path.ngrid bind sqr_$n <Enter> "::ix::ngrid_highlight $path $target $n grey96"
$path.ngrid bind sqr_$n <Leave> "::ix::ngrid_highlight $path $target $n -"
ngrid_move $path $target $n $rx $ry
incr _($target:n)
}
if {[$path.ngrid find withtag name_${xy}_$n] eq ""} {
set _($target:box$n:$xy) [list $name $min $max]
puts "adding $xy $n $name $min $max"
switch $xy {
x {
set tl [concat 0 [expr 5 + $n * 8.0]]
set qx [expr ($cur - $min) / ($max - $min + 0.0) * [winfo width $path.ngrid]]
set qy [expr [lindex [$path.ngrid coords sqr_$n] 1] + $_($target:radius)]}
y {
set tl [concat [winfo width $path.ngrid] [expr 5 + $n * 8.0]]
set qx [expr [lindex [$path.ngrid coords sqr_$n] 0] + $_($target:radius)]
set qy [expr ($cur - $min) / ($max - $min + 0.0) * [winfo height $path.ngrid]]}}
$path.ngrid create text $tl -tags name_${xy}_$n -fill $_($target:box$n:fill) -font {{Bitstream Vera Sans} 8} -text $name -anchor $anchor($xy) -justify $justify($xy)
$path.ngrid lower name_${xy}_$n
$path.ngrid bind name_${xy}_$n <Enter> "::ix::ngrid_highlight $path $target $n grey96"
$path.ngrid bind name_${xy}_$n <Leave> "::ix::ngrid_highlight $path $target $n -"
ngrid_move $path $target $n $qx $qy
return}}}}
proc ngrid_highlight {path target n color} {
variable _
foreach el [list name_y_$n name_x_$n sqr_$n] {
if {$color eq "-"} {set color $_($target:box$n:fill)}
$path.ngrid itemconfigure $el -fill $color
set _($target:recent) $n}}
proc ngrid_click {path target x y} {
variable _
switch $_($target:move) {
swarm {
for {set n 0} {$n <= $_($target:n)} {incr n} {
ngrid_move $path $target $n [expr rand() * $_($target:spread) - [expr $_($target:spread) / 2.0] + $x] [expr rand() * $_($target:spread) - [expr $_($target:spread) / 2.0] + $y]}}
trails {
for {set n 0} {$n <= $_($target:n)} {incr n} {
if {[expr rand() > 0.96] == 1} {
ngrid_move $path $target $n [expr rand() * $_($target:spread) - [expr $_($target:spread) / 2.0] + $x] [expr rand() * $_($target:spread) - [expr $_($target:spread) / 2.0] + $y]}}}
error {ngrid_move $path $target $_($target:recent) [expr rand() * $_($target:spread) - [expr $_($target:spread) / 2.0] + $x] [expr rand() * $_($target:spread) - [expr $_($target:spread) / 2.0] + $y]}
default {ngrid_move $path $target $_($target:recent) $x $y}}}
proc ngrid_move {path target n px py} {
variable _
$path.ngrid coords sqr_$n [expr $px - $_($target:radius)] [expr $py - $_($target:radius)] [expr $px + $_($target:radius)] [expr $py + $_($target:radius)]
set h [winfo height $path.ngrid]
set w [winfo width $path.ngrid]
foreach xy {x y} {
if {[$path.ngrid find withtag name_${xy}_$n] ne ""} {
set l $_($target:box$n:$xy)
set name [lindex $l 0]
set min [lindex $l 1]
set max [lindex $l 2]
if {[expr $min == 0] && [expr $max == 0]} {set max $_($target:max)}
pd "$target.rp _cb [pdtk_enquote $name] [expr ($max - $min) * [set p$xy] / $w.0 + $min] \;"}}}
proc ngrid_gridlines {path target ln lines} {
variable _
puts "gridlines $ln $lines"
set w $path.ngrid
$w delete gridlines
set gh [winfo height $w]
set gw [winfo width $w]
for {set x 1} {$x <= $lines} {incr x} {
if {$lines < 16 && $lines > 0} {
set oh [expr $gh.0 * $x.0 / $lines.0]
set ow [expr $gw.0 * $x.0 / $lines.0]
$w create line $ow 0 $ow $gh -fill $ln -tags gridlines
$w create line 0 $oh $gw $oh -fill $ln -tags gridlines}}}}
#> ngrid frame
#. -bd 3 #w 384 #h 144 #bg gray10 #ln gray35 #div 6 #n 3
#. #move normal #spread 96 #radius 9 #max 1
#. @list ::ix::ngrid_add .- .| {.#1} .#2 .#3 .#4
#. @add ::ix::ngrid_add .- .| {.#1} .#2 .#3 .#4
#. @pos ::ix::ngrid_find pos .- .| {.#1} .#2
#. @setpos ::ix::ngrid_find setpos .- .| {.#1} .#2
#. @delete ::ix::ngrid_find remove .- .| {.#1} 0
#. @clear ::ix::ngrid_clear .- .| all
#. @radius ::ix::ngrid_vset .- .| radius .#1
#. @spread ::ix::ngrid_vset .- .| spread .#1
#. @move ::ix::ngrid_vset .- .| move .#1
#. @max ::ix::ngrid_vset .- .| max .#1
puts "ngrid .- .|"
::ix::ngrid_new .- .| .#w .#h .#bg .#ln .#div .#move .#spread .#radius .#max
|
