[PD-cvs] pd/src pd_base.tk, 1.1.2.7, 1.1.2.8 pd_objects.tk, 1.1.2.10, 1.1.2.11
carmen rocco
ix9 at users.sourceforge.net
Wed Sep 14 10:37:19 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17176
Modified Files:
Tag: devel_0_39
pd_base.tk pd_objects.tk
Log Message:
mayhem and such
Index: pd_objects.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/pd_objects.tk,v
retrieving revision 1.1.2.10
retrieving revision 1.1.2.11
diff -C2 -d -r1.1.2.10 -r1.1.2.11
*** pd_objects.tk 13 Sep 2005 11:09:45 -0000 1.1.2.10
--- pd_objects.tk 14 Sep 2005 08:37:17 -0000 1.1.2.11
***************
*** 38,44 ****
--- 38,93 ----
}
}
+ canvas {
+ defaults {
+ color {222 222 222}
+ sc orange
+ sel {}
+ xa 0 xb 100 ya 0 yb 100 xao 0 xbo 100 yao 0 ybo 100
+ }
+ init {
+ canvas $_
+ place $_ -relwidth 1 -relheight 1
+ bind $_ <Configure> "::pd::redraw $_ all"
+ bind $_ <Enter> "focus $_"
+ bind $_ <Key> "::pd::key $_ %k 1"
+ bind $_ <KeyRelease> "::pd::key $_ %k 0"
+ bind $_ <Motion> "::pd::hover $_ %x %y"
+ bind $_ <4> "::pd::viewpoint $_ {action scroll units 1 axis x}"
+ bind $_ <5> "::pd::viewpoint $_ {action scroll units -1 axis x}"
+ bind $_ <Control-4> "::pd::viewpoint $_ {action zoom dir in axe x x %x y %y}"
+ bind $_ <Control-5> "::pd::viewpoint $_ {action zoom dir out axe x x %x y %y}"
+ bind $_ <Alt-4> "::pd::viewpoint $_ {action zoom dir in axe {x y} x %x y %y}"
+ bind $_ <Alt-5> "::pd::viewpoint $_ {action zoom dir out axe {x y} x %x y %y}"
+ bind $_ <Control-Shift-4> "::pd::viewpoint $_ {action zoom dir in axe y x %x y %y}"
+ bind $_ <Control-Shift-5> "::pd::viewpoint $_ {action zoom dir out axe y x %x y %y}"
+ bind $_ <Shift-4> "::pd::viewpoint $_ {action scroll units -1 axis y}"
+ bind $_ <Shift-5> "::pd::viewpoint $_ {action scroll units 1 axis y}"
+ foreach m {"Control-" "" "Shift-" "Double-"} {
+ foreach bn {1 2 3} {
+ set b [list [concat $bn first] [concat B${bn}-Motion motion] [concat ButtonRelease-$bn release]]
+ foreach ba {0 1 2} {
+ bind $_ <$m[lindex [lindex $b $ba] 0]> "::pd::click [list [string tolower [string trimright $m -1]]] $bn [lindex [lindex $b $ba] 1] $_ %x %y %X %Y"}}}
+ if {$::has_tkdnd == 1} {dnd bindtarget $_ text/plain <Drop> "::pd::drop $_ %D %x %y"}
+ }
+ redraw {
+ set bd [expr {[$_ cget -bd] * 2}]
+ $_ configure -bg $color -width [expr {[winfo width $_] + $bd}] -height [expr {[winfo height $_] + $bd}]
+ }
+ proc {
+ proc lc {_ args} {
+ variable ""
+ foreach arg $args {
+ upvar $arg var
+ set var [dict get $($_) canvas $arg]
+ }
+ return $args
+ }
+ }
+ }
gridlines {
defaults {
class gridlines
+ stipple gray50
+ xq 10 yq 10 xm 15 ym 15
}
redraw {
***************
*** 48,52 ****
array set tj {x center y left}
array set igx {y width x height}
! set range [expr abs($($_:${xy}b) - $($_:${xy}a))]
set nSlices [expr $range / $${xy}q]
if {$nSlices > [set ${xy}m]} {set factor [expr int($nSlices / ($${xy}m + 0.0) + 1)]} else {
--- 97,102 ----
array set tj {x center y left}
array set igx {y width x height}
! lc $_ xa xb ya yb
! set range [expr abs($${xy}b - $${xy}a)]
set nSlices [expr $range / $${xy}q]
if {$nSlices > [set ${xy}m]} {set factor [expr int($nSlices / ($${xy}m + 0.0) + 1)]} else {
***************
*** 54,58 ****
}
set increment [expr $${xy}q * $factor]
! for {set x [expr int($($_:${xy}a) / ($increment + 0.0) + 1)*($increment + 0.0)]} {[expr $($_:${xy}a) > $($_:${xy}b) ? $x >= $($_:${xy}b) : $x <= $($_:${xy}b)]} {set x [expr $($_:${xy}a) > $($_:${xy}b) ? $x - $increment : $x + $increment]} {
set og [tr $_ $xy t $x]
set invgeo [winfo $igx($xy) $_]
--- 104,108 ----
}
set increment [expr $${xy}q * $factor]
! for {set x [expr int($${xy}a / ($increment + 0.0) + 1)*($increment + 0.0)]} {[expr $${xy}a > $${xy}b ? $x >= $${xy}b : $x <= $${xy}b]} {set x [expr $${xy}a > $${xy}b ? $x - $increment : $x + $increment]} {
set og [tr $_ $xy t $x]
set invgeo [winfo $igx($xy) $_]
***************
*** 61,65 ****
x {set coords [concat $og 0 $og $invgeo]}}
$_ lower [$_ create text [lrange $coords 0 1] -font {{Bitstream Vera Sans} 8} -fill [rc] -anchor $ta($xy) -text [string range $x 0 7] -justify $tj($xy) -tags $atags]
! $_ lower [$_ create line $coords -fill $color -stipple gray50 -tags $atags]
}
}
--- 111,115 ----
x {set coords [concat $og 0 $og $invgeo]}}
$_ lower [$_ create text [lrange $coords 0 1] -font {{Bitstream Vera Sans} 8} -fill [rc] -anchor $ta($xy) -text [string range $x 0 7] -justify $tj($xy) -tags $atags]
! $_ lower [$_ create line $coords -fill $color -stipple $stipple -tags $atags]
}
}
***************
*** 77,81 ****
init {
$_ create rect 0 0 0 0 -tags [concat $tags box]
! new $_.$id ${t}$id {bg gray86 ln white sc orange samplerate 44100 xa 0 xb 100 ya 0 yb 100 qx 10 qy 10 mx 15 my 15}
$_ create window 0 0 -tags [concat $tags subwin] -window $_.$id -anchor nw
}
--- 127,131 ----
init {
$_ create rect 0 0 0 0 -tags [concat $tags box]
! new $_.$id {bg gray86 ln white sc orange samplerate 44100 xa 0 xb 100 ya 0 yb 100 qx 10 qy 10 mx 15 my 15}
$_ create window 0 0 -tags [concat $tags subwin] -window $_.$id -anchor nw
}
***************
*** 166,177 ****
defaults {x 3 y 3 ins 1 outs 1}
init {
! $_ create rect 0 0 0 0 -tags [concat $tags box]
$_ create oval 0 0 0 0 -tags [concat $tags button]
}
redraw {
! $_ itemconfigure $box -fill $color
$_ coords $box $x $y $xx $yy
$_ coords $button $x $y $xx $yy
}
}
--- 216,232 ----
defaults {x 3 y 3 ins 1 outs 1}
init {
! $_ create rect 0 0 0 0 -tags [concat $tags box] -width 0
$_ create oval 0 0 0 0 -tags [concat $tags button]
}
redraw {
! $_ itemconfigure $box -fill $color -width $selected -outline [color $rgb]
$_ coords $box $x $y $xx $yy
$_ coords $button $x $y $xx $yy
}
+ proc {
+ proc button:flash {} {
+
+ }
+ }
}
***************
*** 195,199 ****
$_ itemconfigure $txt -font [list {bitstream vera sans} [expr int($sy)]] -text $msg
lassign [$_ bbox $txt] x y xx yy
! set flare [expr $xx + ($xx - $x) / 10.]
$_ coords $box $x $y $flare $y $xx [expr $y + ($yy - $y)/2.] $flare $yy $x $yy
}
--- 250,254 ----
$_ itemconfigure $txt -font [list {bitstream vera sans} [expr int($sy)]] -text $msg
lassign [$_ bbox $txt] x y xx yy
! set flare [expr $xx + ($xx - $x) / 12.]
$_ coords $box $x $y $flare $y $xx [expr $y + ($yy - $y)/2.] $flare $yy $x $yy
}
Index: pd_base.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/pd_base.tk,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -C2 -d -r1.1.2.7 -r1.1.2.8
*** pd_base.tk 13 Sep 2005 11:09:45 -0000 1.1.2.7
--- pd_base.tk 14 Sep 2005 08:37:17 -0000 1.1.2.8
***************
*** 12,16 ****
}
! foreach pkg {snack tkdnd tkpath} {
if {[catch {package require $pkg}]} {set has_$pkg 0} {set has_$pkg 1}
}
--- 12,16 ----
}
! foreach pkg {Img snack tkdnd tkpath} {
if {[catch {package require $pkg}]} {set has_$pkg 0} {set has_$pkg 1}
}
***************
*** 32,35 ****
--- 32,56 ----
proc darken {rgb r} {set l {}; foreach c $rgb {lappend l [expr {$c - ($c * $r)}]}; return $l}
proc color {rgb} {return [format "\#%02x%02x%02x" [expr int([lindex $rgb 0])] [expr int([lindex $rgb 1])] [expr int([lindex $rgb 2])]]}
+ proc hsvToRgb {hue sat value} {
+ set v [format %.0f [expr {255.0*$value}]]
+ if {$sat == 0} {return "$v $v $v"} else {
+ set hue [expr {$hue*6.0}]
+ if {$hue >= 6.0} {set hue 0.0}
+ scan $hue. %d i
+ set f [expr {$hue-$i}]
+ set p [format %.0f [expr {255.0*$value*(1 - $sat)}]]
+ set q [format %.0f [expr {255.0*$value*(1 - ($sat*$f))}]]
+ set t [format %.0f [expr {255.0*$value*(1 - ($sat*(1 - $f)))}]]
+ switch $i {
+ 0 {return "$v $t $p"}
+ 1 {return "$q $v $p"}
+ 2 {return "$p $v $t"}
+ 3 {return "$p $q $v"}
+ 4 {return "$t $p $v"}
+ 5 {return "$v $p $q"}
+ default {error "i value $i is out of range"}}}}
+ # option add *borderWidth 0 widgetDefault
+ option add *borderWidth 0
+ option add *font {{bitstream vera sans} 10}
# if you can shorten this you kick ass
***************
*** 48,54 ****
switch $a {
first {
foreach xy {x y} {set ($_:c$xy) [set $xy];set ($_:f$xy) [set $xy]}
$_ create rect $($_:cx) $($_:cy) $($_:cx) $($_:cy) \
! -tags sel -fill "" -outline $($_:sc) -width 12}
release {$_ delete sel}
motion {
--- 69,76 ----
switch $a {
first {
+ lc $_ sc
foreach xy {x y} {set ($_:c$xy) [set $xy];set ($_:f$xy) [set $xy]}
$_ create rect $($_:cx) $($_:cy) $($_:cx) $($_:cy) \
! -tags sel -fill "" -outline $sc -width 12}
release {$_ delete sel}
motion {
***************
*** 93,100 ****
}
proc item_delete {_ {items ""}} {
variable ""
variable obj
! if {$items eq ""} {set items $($_:sel)}
foreach item $items {
foreach i [$_ find withtag i$item] {
--- 115,126 ----
}
+ proc getsel {_} {
+ variable ""
+ return [dict get $($_) canvas sel]
+ }
proc item_delete {_ {items ""}} {
variable ""
variable obj
! if {$items eq ""} {set items [getsel $_]}
foreach item $items {
foreach i [$_ find withtag i$item] {
***************
*** 105,109 ****
eval [dict get $obj $type destroy]}
dict unset ($_) $item
! set ($_:sel) {}
item_info $_ ""
send "delete $_:$item"
--- 131,135 ----
eval [dict get $obj $type destroy]}
dict unset ($_) $item
! dict set ($_) canvas sel {}
item_info $_ ""
send "delete $_:$item"
***************
*** 126,129 ****
--- 152,163 ----
}
+ proc up {_ id args} {
+ variable ""
+ foreach arg $args {
+ upvar $arg var
+ dict set ($_) $id $arg $var
+ }
+ }
+
proc update_one {_ item r k v redraw} {
update $_ $item $r [dict create $k $v] $redraw
***************
*** 153,157 ****
if {[expr $y > $yy]} {lassign "$y $yy" yy y}
set sx [expr $xx - $x]; set sy [expr $yy - $y]
! if {[lsearch $($_:sel) $id] >= 0} {set rgb {233 233 233};set color $($_:sc);set selected 1} else {
set rgb [dict get $($_) $id color];set color [color $rgb];set selected 0}
set atags [concat $class i$id $id]
--- 187,191 ----
if {[expr $y > $yy]} {lassign "$y $yy" yy y}
set sx [expr $xx - $x]; set sy [expr $yy - $y]
! if {[lsearch [getsel $_] $id] >= 0} {set rgb {233 233 233};set color [set [lc $_ sc]];set selected 1} else {
set rgb [dict get $($_) $id color];set color [color $rgb];set selected 0}
set atags [concat $class i$id $id]
***************
*** 162,175 ****
set $tag [$_ find withtag "$tags && $tag"]}}
eval [dict get $obj $type redraw]
! if {$class eq "item" && ($ins > 0 || $outs > 0)} {
! eval [dict get $obj io redraw]
! foreach i [dict keys $($_)] {
! if {[dict get $($_) $i class] eq "cable"} {
! if {[lindex [dict get $($_) $i from] 0] eq $id || [lindex [dict get $($_) $i to] 0] eq $id} {
! redraw $_ $i
! }
! }
! }
! }
}
}
--- 196,209 ----
set $tag [$_ find withtag "$tags && $tag"]}}
eval [dict get $obj $type redraw]
! if {$class eq "item" && ($ins > 0 || $outs > 0)} {
! eval [dict get $obj io redraw]
! # foreach i [dict keys $($_)] {
! # if {[dict get $($_) $i class] eq "cable"} {
! # if {[lindex [dict get $($_) $i from] 0] eq $id || [lindex [dict get $($_) $i to] 0] eq $id} {
! # redraw $_ $i
! # }
! # }
! # }
! }
}
}
***************
*** 178,182 ****
variable ""
variable obj
! foreach id $($_:sel) {
set type [dict get $($_) $id type]
if {[dict exists $obj $type defaults]} {
--- 212,216 ----
variable ""
variable obj
! foreach id [getsel $_] {
set type [dict get $($_) $id type]
if {[dict exists $obj $type defaults]} {
***************
*** 193,197 ****
set mx [tr $_ x d [expr {$x - $($_:cx)}]]
set my [tr $_ y d [expr {$y - $($_:cy)}]]
! foreach item $($_:sel) {item_pos $_ $item rel $mx $my $mx $my}
}
--- 227,231 ----
set mx [tr $_ x d [expr {$x - $($_:cx)}]]
set my [tr $_ y d [expr {$y - $($_:cy)}]]
! foreach item [getsel $_] {item_pos $_ $item rel $mx $my $mx $my}
}
***************
*** 234,238 ****
set c [lindex $clicked end]
resize_modes $_ $x $y $c
! if {[llength $($_:sel)] <= 1} {updatesel $_ $c}
inspect $_ $c
} else {
--- 268,272 ----
set c [lindex $clicked end]
resize_modes $_ $x $y $c
! if {[llength [getsel $_]] <= 1} {updatesel $_ $c}
inspect $_ $c
} else {
***************
*** 288,295 ****
proc togglesel {_ d} {
variable ""
! if {[lsearch $($_:sel) $d] < 0} {
! set ($_:sel) [concat $($_:sel) $d]
} else {
! set ($_:sel) [lsearch -inline -not -all $($_:sel) $d]
}
redraw $_ $d
--- 322,329 ----
proc togglesel {_ d} {
variable ""
! if {[lsearch [getsel $_] $d] < 0} {
! set ($_:sel) [concat [getsel $_] $d]
} else {
! set ($_:sel) [lsearch -inline -not -all [getsel $_] $d]
}
redraw $_ $d
***************
*** 298,303 ****
proc updatesel {_ ns} {
variable ""
! set os $($_:sel)
! set ($_:sel) $ns
redraw $_ [lsort -unique [concat $os $ns]]
item_info $_ $ns
--- 332,337 ----
proc updatesel {_ ns} {
variable ""
! set os [getsel $_]
! dict set ($_) canvas sel $ns
redraw $_ [lsort -unique [concat $os $ns]]
item_info $_ $ns
***************
*** 314,317 ****
--- 348,377 ----
}
+ proc colors {} {
+ variable ""
+ set p .colors
+ if {![winfo exists $p]} {
+ toplevel $p
+ # yes this should be generated algorithmically and will be when i get aroud to it, god willing
+ set picker {iVBORw0KGgoAAAANSUhEUgAAADIAAAEACAIAAAB+mLL0AAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QkNDBMQBB81AgAAELhJREFUeNqtnVty47wOhMGL/5nZ29n/ZkYiz0MsBQTQTciZFMulyE7SISEQpPAJ5X+//vwq5Xcpv0R+lfKrlF9S3mfWk+8z7w/I9VPfJ0VE/vyWP3+u9vz49/u4i5S1VXcm30TkJfIS6SJdHbTrtYnU67Vef666XyJdna0JifzMLesWZDR5ZV5TQbLIAX9XyzLKjLiKO+zdW0W9Hb5uP3C/ish/So1pXlMFNvPuLfPb/UHyPO8tPYJkEEWk9PW3k+PMW8a2Xq63qustYwN2EMNG3qpUVqcmH16PgcmT1nKy2g8GMXYQhepoT94Ke4ubfCEmX9xfMgfJ86KsKuMgYu9wm3w4Iua14bfCQbxNPuNOa3IQ2+4gPCngMkSTjxlK8X7LKPMiMmfCySe0emRbonurAF/QHrakrL2j7wkRPX0yM4hZ26q0n3p0jE7KqsmYfM9pKsjkvQ0ZQf5Vywp7y49gI+a17a0GBIXfEtvKmJdok/futOGu0jr8MZKVMfZqTB4NorGwUIpp4gzLdGfo5X80iHd75WT13Wwd9hk0+XAQSXs5WX1n8j4GrGiJUaPJ2BtWKOgVyQobCdfYILbdZWg0mVfBV8a2w77DB2TyFbuuUJmXhXxbo0HzxuRD22pg+JAsNBm0TDhv1ol5w3+5BbSXxceu5YNmHiCgK/Gr/Sci+JdUoK/wdaKPzb2aBgR9abp7KxNL7oPmgoNmYmGvSJyAYB8tCB4ENuYXdXAZGkFeVnLVVEjQXBIzD3GkxraeNhg0Z+bp5nzEKxrEcC1edot1FjTnewuNoyS2T0o0fPUnYWDGtsgO1PZbG0EUGjSjQQz91qPNxAp2OtlUXXcm781LPtputfZONpK2EQSyrfCPER3xxzoQVHeB/Mt5h5faNzPbaCXxlt12qzvXRaL4l7Mt0b89cRCfRybfProYzVeR4Cs8KaFtlSn1amXaM+82pM21DdXme0GW+iq7D/Qh4tsJ2kGXfObvlUgEP3kf97nTdNDlcItkFWw74et0x32IzFUT6rCDbspWcF0hN3AfzEhfH06Tl3LkIibJ+VNBe23X8fSDeO70kX0goXfYyJ236i6IHtr7cILOS5PfAUKyzMEAb8n11mLyX1Lmzuq3AZSRpT92C5rXmam2juo1cIvJT6Xp3LVjtx2L7goNpWZeUr7Oy3VSQpM/RVqitw4a7ZLQeF5NW5I+L+o49lvNaTq2W1JKVovm/7k2/9WIl781NafpiO5tGt9Yry7XsduXjrYK0m7Wy+2hvdfr9T64lRXsG0WZUVstqV3K/OQ4lLLb9vt0gpo61sN3YPeoB2JcIsaqZjq3WZSjD3prRL1VVzPfCpLLA93N2FPYVQWIgxFEzdzpBrK4dRv/Hn5y8VvDmdRWUAGyxvqXtKWf6vcMJU7Uj3TfScbquY2LMVXnh7QHv3/8XCeAobpNSLxVsIvyY2cUTPevhxHOwJpm6LfK1VXh3OI1hbKQVXk7rtFPwal6v8QE4+UFFZASM9wlwky+pN2BFjfcwAlY/HtBA/WWFoQ6LOwnP2QT+EwT89yXl+/yxeS9oJNq0uJG5MT9CNb1SkeD+Db5omSdShBa0HnrHgm3adoAvvd7EKuSVZQyiWw8FDQu20KddKxBzlgdr++w9yCaUTuj4UBjp2URezqUVTU3GdgIYqy/5cTWjex9AFnewHWA2cA4SiiLu4PpPNxwsgq2qq2gJWjW48id01TBnffAAtQ0tzjw/5J1pwNvNOkrtikpOsrTc0goSy96T7el4D3qYvISeYS5atJx8FCB6L0CEHqjJuytCTxqHyByMuN9a7rD86FWE1X9b+H2sNd00pixDzW3ozl4Kk23oKo0VWVbfG8YmZcR1/VEG9p4BT66RhtJ4R71mVYjprfI5WZcFNmMkOiu34HFTXcZTm9bU+1SeGXD9ZPPkNW99VfJ6ter2ahitmWuRKOmKE1jlz0sUT8dlyZyJY4wgrin6nvpXZUs/YFKd7Ak2jQ/co7URhDaxc91I2q6ZdOgt5REmflxtXM9DjtsIi9f1g3We+1W3JqObEDe6QZ/V2WkwyYwLzhVT7wDW/CiyNy10h12RvY+1ihymiXG41tY0Vs68efY9dbJg+ZZpBSRIpP+8ftjIu/j90/J+3gWEZHRZXQZ7d3mV6uugShqXjJ6FgmRNCFiUprN7Vu+WV3uW1F1Z8n58z/Phr2soacYkOQHCE/TXIfR9OG+h0EywAhHMXgmXhSn9zhN4bOT8lGaddRnfUN/lCcnicm3hLh4EPOECDpPsmE7SE5iJv9PIBFi8v1pfuc9iOT2Q/4DxOSRawB3aTrMzvjgQCg/tmVX1O5Fh1I+eBVKRG3RI2byGUIEnResqdN85poxeZT9uH0rafIp20KC8oRIjQiR1y53uLEpv++zynpCGcnib4mL0Vl9j3dYkKZOjzMmT2xL0CBmcsDJt5x56LkrcTH5ks7+Jine4nLznnJRgnqrJjQhTkQwbZe/Eq07Jd4BZZU1gGK8KJvYaIaHmOj0gxRPT4ggp/UMFCa9lUmFJbI+JttYBEHoIyNIdw8nRHJRPI4gUCIlgUS0rAb6KROjLibPvQOBaUyILJQ0ewJO4ql6S/q8HJMhO39L8JBqIogtP9YoEeWz+Dlfydn4QtxphhN5YbiAgyHbuJn5rS1ME/aZ5MDizWMEiJev2EG8EihGEsneLzFKYkIk9m5QjJZbrcCHZxB3+ggh03BBfplZiG09HcSOORF58uQGuiHVf8SPebig0odtkL0MGzR/4B0IQvbBA0r2QfMjiixEyJL7dYU+p+bB5EMA0wwhkt+htavqtiOrM5hPJq06ceajwIYgZNvkdNmdD0w+GQYShIyn72dS/OWHQTMiRArlLnLf/myJwcGVH3x1nApyJrCMv26X8t90V89RK8cO+/WyksY1w297RBaEwIMRh/Z0P7sUbYf1aAQ19mA0HTRA+cxNTSdxdnWrEeEhISHS8Kz2gZu3iXKot3yHHTiA8rL85DfopLgx+RPY/uESjDiNgUKI6f6HuoIrscmPh5CIj3lReDXUXfm5QlQeboF+6xGy4mWF4akhRPSxTrz4NnkvyEMip+NEakJWiIfMtcP8W4Hfag5fqY4WKXDJElwW0+kzudcGFRHttyaARDQbwgWJWihqduVOSpMo4dl02PszHQAPLQeJ+HltrJxIXdPlGpBllDGTz0Ai3h8aPKRiSKSEgr6Oe5oQqeyWd8yuDImBWDQNLL0VChoYEiFJ/foXhsnqsuZLQ3yl0xE8MYZImAyUBC+OxvCcyGLy012AJ3n8wC6HfuTy+ofKWnvQW+cuK0oiRoUQR6FhxahIaFuDavLmEqaphvpqLr8z9ltPU8In7jDTSTUCVwYaRLTE2CqbILccsXV1p2kaLx8iK2dCkODrrrjY0PBpKAE8kKVREaHDJw7IEMdnbQmRuMP6mu967iARATnFc40FCsAyECcyw94qjhNBkAhCMYysEMg4VtygkRRPbfKEE0G9NYCsEISqK/HLUjw7SHPNwFlGXMMg1IEhkTjF08jij7gI+0kzGbKjVkzriEbrDlwJXfnEnIjmH4U+ozSZbx2YPPICJqyrjl0JaQy9BD8Uu0ISm5cIIuOcDMCtCZGBaYyQExkOMYARRIYZqyvBMlYYvroFmQZDjlXcoCnNb5PnF11z6ztEi0iCWhlJ2wrBFY6vkFTKGgEZjWIPPqB921YFmE8F1ApJPK0AXCGQyEDrRP0oiy0kwtN0CbhCEAMbROhBLM4FGEgkREXMNpXupyMCV0JBw0cQw61uawSJhISITwE3O+YIMTgjisxugMs6BU13YAgRkjCvBd2oyOmAjE1E3ymRMp/jBZ4QCbtqZEy+5EiQDCrSFVLTV9KHcIDOQZTr6MJAimJAiojcPMgFg3yxIUXs8df1fFQ5qpxfrbzbcC1eihWZX2/1f8WGFPosfvJM6zCrudef3S41VNRrV0Ykl9/pZNXcswcrltUfYg/hDmwnBN3T86T8BBEXhuqd5AB8kDDwisbxYXKn6q08DFIozfmUPiruUVnfJv/osaScfeXP4q+7sjmLyf+wrkn9tLcKqvPwNYjlObXSsKyflFIQ01tl92DezElk8o+efl+8baFHFydPZp7Fn6pcoK9E8mzy7clGTX57JQZUKEkaqTs8xJyUKzOJMA9oQqy+t0qursn2LXlIAIaP+Ns4iGTdEC+rP8G1UKjSM8/QTTIjyfITGeyhl11CEqpr4g+4yfdE+YnF5MuOXem5V3lYGY0kLfb6UBM5+AwU3kQQ28xTwoa0CMV4YXvfooA9TEp/VLKjORRjW4isAlB477c+qCQS1hBpOVbYDmLy4dHk0fehrJ4u1lFJBPEx8EBktVxpk2cmTy7GF3gVcIW2J1N1EDQ3nHnacwngbVfXhCR/7afqmqhu8sLMA5mgUsXR0FT98YPJk0xqNmj+gGnbgit19y0LmjPlJ3hhDF9xZRvW1syCLFmsoyUqFzwtcZgKmh+VNkFVMTLo/763toVgSK68r1xQf9AkNPnMPN12lQsyJVFLIslw8VvtCSGC4IKnGz6V7EGU5zxNiJAlSwCT2KEQv5Whj3hvPX2+/Mbkk+W+Xrgqxs/3iONVdYYcQwjZB7ULhOw0J9dk2wjis0oPEgbNTwvvvXAE8c/qYjwqU5isuPIPqoh83d0o42pTijlztXpKWVtVrZz/sOTKJSuVl54EVz4rULP+bJdtqYfD3XpGEd1PyvnIUuqhp4AHLe7Ihb2Pih/JWuPkPYgjVw7miEI7U6H9aamoiR4lgEiakMYgGy7108JakdUDkx+RoBDFqA4uIPeuJqiGIvY59F1Gmh/LRJa8SttcnzEprsAJNPmRRla2snwaznSoSFXZHwoS6cEItmgQPSRScoRIdbnUNcopXm9ed+i0akSI8BCOl0+c+Kn47nyXR9VNeGkTUePV1KOAW1TdxJcRUTljXUgtGFPdpGBOxMjykIgnRLQ7NQVOlt4ylXM8HhIWXTFf56pJlzZpGDEoNt+tx8U6wnYkElQRAkVKm0RPre02XwlJJGoMTzPp42h9dnlx1YYE+S3CiRWc7SwkNxKblMbxBJn8lhMpuHqAPBTky4hMNFVXWt2ElzPwRVcEVzcpjg1RiYk9xtoI80CSi4XWgkLVTaIOBn4raeBCmQdS3aTy9C0SQZA178RlRDgIVVWhmUqS3UKTLyuQgazbZ6oLrbhSHAw7IezTvy8Hg2JkKhp4WZkyIqFVDR9BmAInvrpJwfWE7l/ad7BfxZCIK47Sv7P4x8qrnLiTJCptMunYabqnrVMwHESfWHrm4CxfRiTUpKMjQ4hMZPIjwatwNaSMiIFEzohdiR3EjJCaJDM2qayKIZG2oci6xUOIE/eZ6qaSiFADPylZYIPmuSZbI0IkrHEyVs5LsCZCiESlHjosbeI9gsdDmgNXw13rAxMig0w+BdfrEIyHNFeWQvD+3bmK47WPvoNmZNeC8ZDhjmW3obi1LTuIxC9k7tecFFzpbgTPZGATdlXBpU0KKJOr99ANHnImAKTFnRo8RKIyRxVDIkjW37WYSE+CWuhKJIQIv6skUSGYYzeIk5i8L23imYyxu58kyiMcuAhForpJ5OU9ITLWYJfcRjL3ro6IEDn39dH6stw2f2ZGKDu/h6TvE/kaIueucs4SNIvdjNvfzhIqy/M0B74GB4+3kne0yAfE3YHJ1IKJXPf/ARXN6/ssS+vjAAAAAElFTkSuQmCC}
+ image create photo colorpicker
+ colorpicker configure -data $picker
+ label $p.colors -bd 0
+ entry $p.rgb -bd 0 -width 10 -font {{bitstream vera sans} 8}
+ bind $p.colors <B1-Motion> {::pd::colors:pick %x %y}
+ bind $p.colors <1> {::pd::colors:pick %x %y}
+ grid $p.colors -sticky nsew
+ grid $p.rgb -stick nsew
+ $p.colors configure -image colorpicker
+ }}
+ proc colors:pick {x y} {
+ if {![expr $y <= 255 && $y >= 0 && $x >= 0 && $x <= 50]} {return}
+ set p .colors
+ set rgb [hsvToRgb [expr (255 - $y) / 255.] [expr $x <= 25 ? 1. : ($x - 50) / -25.] [expr $x <= 25 ? $x / 25. : 1.]]
+ $p.rgb delete 0 end
+ $p.rgb insert 0 $rgb
+ $p.rgb configure -bg [color $rgb]
+ }
+
proc inspector {_} {
variable ""
***************
*** 325,328 ****
--- 385,389 ----
if {![winfo exists $p]} {return}
variable ""
+ if {![dict exists $($_) $id]} {return}
set keys [dict keys [dict get $($_) $id]]
if {![info exists ($_:inspect)] || ($($_:inspect:type) ne [dict get $($_) $id type])} {
***************
*** 330,347 ****
set n 0
foreach k [concat id $keys] {
! text $p.$k -wrap none -width 8 -height 1 -bd 0 -font {{Bitstream Vera Sans} 11}
! $p.$k insert 1.0 $k
! $p.$k tag add justify 1.0 end
! $p.$k tag configure justify -justify right
$p.$k configure -state disabled
! text $p.${k}v -wrap none -width 16 -height 1 -bd 0 -bg gray94 -font {{Bitstream Vera Sans} 10}
! bind $p.${k}v <Any-KeyRelease> "::pd::item_mua $_ abs \[dict create $k \[$p.${k}v get 1.0 end\] \] 1"
grid $p.$k $p.${k}v -sticky nsew
grid columnconfigure $p 1 -weight 3
grid columnconfigure $p 0 -weight 1
grid rowconfigure $p $n -weight 1
- # grid rowconfigure .i$t .i$t.${k}v -weight 1
- # grid columnconfigure .i$t .i$t.${k}v -weight 3
- # grid columnconfigure .i$t .i$t.$k -weight 1
incr n
}
--- 391,407 ----
set n 0
foreach k [concat id $keys] {
! entry $p.$k -width 8 -bd 0 -font {{Bitstream Vera Sans} 11}
! $p.$k insert 0 $k
$p.$k configure -state disabled
! entry $p.${k}v -width 16 -bd 0 -bg gray94 -font {{Bitstream Vera Sans} 10}
! if {$n == 0} {set cmd "::pd::inspect $_ \[$p.${k}v get\]";set cmdT $cmd} {
! set cmd "::pd::item_mua $_ abs \[dict create $k \[$p.${k}v get\] \] 1 \[$p.idv get\]"
! set cmdT "::pd::item_mua $_ abs \[dict create $k \[$p.${k}v get\] \] 1"}
! bind $p.${k}v <Any-KeyRelease> $cmd
! bind $p.${k}v <Tab> $cmdT
grid $p.$k $p.${k}v -sticky nsew
grid columnconfigure $p 1 -weight 3
grid columnconfigure $p 0 -weight 1
grid rowconfigure $p $n -weight 1
incr n
}
***************
*** 349,357 ****
}
set ($_:inspect) $id
! $p.idv delete 1.0 end
! $p.idv insert 1.0 $id
foreach k $keys {
! $p.${k}v delete 1.0 end
! $p.${k}v insert 1.0 [dict get $($_) $id $k]}}
proc click {m button action _ x y X Y} {
--- 409,417 ----
}
set ($_:inspect) $id
! $p.idv delete 0 end
! $p.idv insert 0 $id
foreach k $keys {
! $p.${k}v delete 0 end
! $p.${k}v insert 0 [dict get $($_) $id $k]}}
proc click {m button action _ x y X Y} {
***************
*** 374,378 ****
} elseif {[$_ find withtag sel] ne ""} {
sel $_ release $x $y
! } elseif {[llength $($_:sel)] > 1 && [llength $clicked] > 0 && [lsearch $($_:sel) $clicked] == -1} {
updatesel $_ $clicked}}
2 {if {$clicked ne ""} {mode $_ item_scale} {mode $_ resize_canvas}}
--- 434,438 ----
} elseif {[$_ find withtag sel] ne ""} {
sel $_ release $x $y
! } elseif {[llength [getsel $_]] > 1 && [llength $clicked] > 0 && [lsearch [getsel $_] $clicked] == -1} {
updatesel $_ $clicked}}
2 {if {$clicked ne ""} {mode $_ item_scale} {mode $_ resize_canvas}}
***************
*** 414,417 ****
--- 474,478 ----
$m add command -label reload -command {source pd_base.tk}
+ $m add command -label "colors" -command "::pd::colors"
$m add command -label "console" -command {source /usr/local/bin/tkcon.tcl; tkcon show}
$m add command -label "inspector" -command "::pd::inspector $_"
***************
*** 427,467 ****
variable ""
array set dm {x width y height}
switch $inv {
! t {return [expr {($v - $($_:${d}a)) / ($($_:${d}b) - $($_:${d}a) + 0.0) * [winfo $dm($d) $_]}]}
! i {return [expr {($($_:${d}b) - $($_:${d}a)) * $v /([winfo $dm($d) $_] + 0.0) + $($_:${d}a)}]}
! d {return [expr {($($_:${d}b) - $($_:${d}a)) * $v /([winfo $dm($d) $_] + 0.0)}]}
! id {return [expr {$v / ($($_:${d}b) - $($_:${d}a) + 0.0) * [winfo $dm($d) $_]}]}}}
proc viewpoint {_ opts} {
variable ""
switch [dict get $opts action] {
fit {
lassign [$_ bbox item] xa ya xb yb
! set ($_:xa) [tr $_ x i $xa]
! set ($_:xb) [tr $_ x i $xb]
! set ($_:ya) [tr $_ y i $ya]
! set ($_:yb) [tr $_ y i $yb]
}
mirror_x {
! lassign "$($_:xb) $($_:xa)" ($_:xa) ($_:xb)
}
mirror_y {
! lassign "$($_:yb) $($_:ya)" ($_:ya) ($_:yb)
}
reset {
! set ($_:ya) $($_:yao);set ($_:yb) $($_:ybo);set ($_:xa) $($_:xao);set ($_:xb) $($_:xbo)
}
move {
foreach xy {x y} {
set mvt [tr $_ $xy d [expr {[dict get $opts $xy] - $($_:c$xy)}]]
! foreach ab {a b} {set ($_:${xy}$ab) [expr {$($_:${xy}$ab) - $mvt}]}}
}
zoom {
array set dir {in 0.5 out 1.5}
foreach xy [dict get $opts axe] {
! set radius [expr {($($_:${xy}b) - $($_:${xy}a)) / 2. * $dir([dict get $opts dir])}]
set center [tr $_ $xy i [dict get $opts $xy]]
! set ($_:${xy}a) [expr {$center - $radius}]
! set ($_:${xy}b) [expr {$center + $radius}]
}
}
--- 488,530 ----
variable ""
array set dm {x width y height}
+ lc $_ xa xb ya yb
switch $inv {
! t {return [expr ($v - $${d}a) / ($${d}b - $${d}a + 0.0) * [winfo $dm($d) $_]]}
! i {return [expr ($${d}b - $${d}a) * $v /([winfo $dm($d) $_] + 0.0) + $${d}a]}
! d {return [expr ($${d}b - $${d}a) * $v /([winfo $dm($d) $_] + 0.0)]}
! id {return [expr $v / ($${d}b - $${d}a + 0.0) * [winfo $dm($d) $_]]}}}
proc viewpoint {_ opts} {
variable ""
+ lc $_ xa xb ya yb xao yao xbo ybo
switch [dict get $opts action] {
fit {
lassign [$_ bbox item] xa ya xb yb
! foreach z {xa xb ya yb} {set $z [tr $_ [string range $z 0 0] i [set $z]]}
}
mirror_x {
! lassign "$xb $xa" xa xb
}
mirror_y {
! lassign "$yb $ya" ya yb
}
reset {
! lassign "$xao $xbo $yao $ybo" xa xb ya yb
! }
! square {
!
}
move {
foreach xy {x y} {
set mvt [tr $_ $xy d [expr {[dict get $opts $xy] - $($_:c$xy)}]]
! foreach ab {a b} {set ${xy}$ab [expr $${xy}$ab - $mvt]}}
}
zoom {
array set dir {in 0.5 out 1.5}
foreach xy [dict get $opts axe] {
! set radius [expr ($${xy}b - $${xy}a) / 2. * $dir([dict get $opts dir])]
set center [tr $_ $xy i [dict get $opts $xy]]
! set ${xy}a [expr {$center - $radius}]
! set ${xy}b [expr {$center + $radius}]
}
}
***************
*** 469,481 ****
foreach xy {x y} {
set mvt [tr $_ $xy d [expr {[dict get $opts $xy] - $($_:c$xy)}]]
! set ($_:${xy}a) [expr {$($_:${xy}a) - $mvt}]
! set ($_:${xy}b) [expr {$($_:${xy}b) + $mvt}]}
}
scroll {
set xy [dict get $opts axis]
! set mv [expr {($($_:${xy}b) - $($_:${xy}a)) / 4.0}]
! foreach ab {a b} {set ($_:${xy}$ab) [expr {[dict get $opts units] > 0 ? $($_:${xy}$ab) + $mv : $($_:${xy}$ab) - $mv }]}
}
}
redraw $_ all
}
--- 532,545 ----
foreach xy {x y} {
set mvt [tr $_ $xy d [expr {[dict get $opts $xy] - $($_:c$xy)}]]
! set ${xy}a [expr $${xy}a - $mvt]
! set ${xy}b [expr $${xy}b + $mvt]}
}
scroll {
set xy [dict get $opts axis]
! set mv [expr ($${xy}b - $${xy}a) / 4.0]
! foreach ab {a b} {set ${xy}$ab [expr [dict get $opts units] > 0 ? $${xy}$ab + $mv : $${xy}$ab - $mv ]}
}
}
+ up $_ canvas xa xb ya yb
redraw $_ all
}
***************
*** 492,496 ****
set ($_:c) [dict create]
set i 0
! foreach item $($_:sel) {
dict set ($_:c) $i [dict get $($_) $item]
incr i
--- 556,560 ----
set ($_:c) [dict create]
set i 0
! foreach item [getsel $_] {
dict set ($_:c) $i [dict get $($_) $item]
incr i
***************
*** 501,505 ****
set ($_:c) [dict create]
set i 0
! foreach item $($_:sel) {
dict set ($_:c) $i [dict get $($_) $item]
incr i
--- 565,569 ----
set ($_:c) [dict create]
set i 0
! foreach item [getsel $_] {
dict set ($_:c) $i [dict get $($_) $item]
incr i
***************
*** 522,528 ****
}
! proc item_mua {_ r u redraw} {
variable ""
! foreach item $($_:sel) {update $_ $item $r $u $redraw}
}
--- 586,593 ----
}
! proc item_mua {_ r u redraw {items -}} {
variable ""
! if {$items eq "-"} {set items [getsel $_]}
! foreach item $items {update $_ $item $r $u $redraw}
}
***************
*** 574,616 ****
variable ""
variable obj
! set opts [dict merge {bg gray86 ln white mode edit sc orange samplerate 44100 xa 0 xb 100 ya 0 yb 100 xq 10 yq 10 xm 15 ym 15} $opts]
! foreach xy {x y} {foreach ab {a b} {set ($_:${xy}${ab}o) [dict get $opts ${xy}${ab}]}}
! foreach a {sc ln mode xa xb ya yb xq yq xm ym samplerate} {set ($_:$a) [dict get $opts $a]}
if {[winfo exists $_] != 1} {
! canvas $_ -bg [dict get $opts bg]
! place $_ -relwidth 1 -relheight 1
! bind $_ <Configure> "::pd::redraw $_ all"
! bind $_ <Enter> "focus $_"
! bind $_ <Key> "::pd::key $_ %k 1"
! bind $_ <KeyRelease> "::pd::key $_ %k 0"
! bind $_ <Motion> "::pd::hover $_ %x %y"
! bind $_ <4> "::pd::viewpoint $_ {action scroll units 1 axis x}"
! bind $_ <5> "::pd::viewpoint $_ {action scroll units -1 axis x}"
! bind $_ <Control-4> "::pd::viewpoint $_ {action zoom dir in axe x x %x y %y}"
! bind $_ <Control-5> "::pd::viewpoint $_ {action zoom dir out axe x x %x y %y}"
! bind $_ <Alt-4> "::pd::viewpoint $_ {action zoom dir in axe {x y} x %x y %y}"
! bind $_ <Alt-5> "::pd::viewpoint $_ {action zoom dir out axe {x y} x %x y %y}"
! bind $_ <Control-Shift-4> "::pd::viewpoint $_ {action zoom dir in axe y x %x y %y}"
! bind $_ <Control-Shift-5> "::pd::viewpoint $_ {action zoom dir out axe y x %x y %y}"
! bind $_ <Shift-4> "::pd::viewpoint $_ {action scroll units -1 axis y}"
! bind $_ <Shift-5> "::pd::viewpoint $_ {action scroll units 1 axis y}"
! foreach m {"Control-" "" "Shift-" "Double-"} {
! foreach bn {1 2 3} {
! set b [list [concat $bn first] [concat B${bn}-Motion motion] [concat ButtonRelease-$bn release]]
! foreach ba {0 1 2} {
! bind $_ <$m[lindex [lindex $b $ba] 0]> "::pd::click [list [string tolower [string trimright $m -1]]] $bn [lindex [lindex $b $ba] 1] $_ %x %y %X %Y"}}}
! if {$::has_tkdnd == 1} {dnd bindtarget $_ text/plain <Drop> "::pd::drop $_ %D %x %y"}
! set bd [expr {[$_ cget -bd] * 2}]
! $_ configure -bg gray -width [expr {[winfo width $_] + $bd}] -height [expr {[winfo height $_] + $bd}]
! if {[info exists ($_)] != 1} {
! set ($_) {}
! set ($_:g) {}
! set i -1; set sel {}
! foreach a {i sel} {set ($_:$a) [set $a]}
! }
}
! foreach a {ln xa xb ya yb xq yq xm ym} {set $a [dict get $opts $a]}
! item_new $_ [dict create type gridlines id grid xa $xa xb $xb ya $ya yb $yb xq $xq yq $yq xm $xm ym $ym]
! item_draw $_ all
}
--- 639,648 ----
variable ""
variable obj
! if {[info exists ($_)] != 1} {set ($_) {}}
if {[winfo exists $_] != 1} {
! item_new $_ [dict create type canvas id canvas]
! item_new $_ [dict create type gridlines id grid]
}
! # item_draw $_ all
}
***************
*** 645,646 ****
--- 677,683 ----
}
+
+ if {$argv eq "1" && ![winfo exists .c]} {
+ toplevel .c -width 512 -height 512
+ ::pd::new .c.c {}
+ }
More information about the Pd-cvs
mailing list