[PD-cvs] pd/src pd.tk,NONE,1.1.2.1 pd_objects.tk,NONE,1.1.2.1
carmen rocco
ix9 at users.sourceforge.net
Mon Aug 1 22:56:42 CEST 2005
- Previous message: [PD-cvs] externals/grh/GApop/pd GA_example1.pd, NONE, 1.1 help-GApop.pd, 1.1, 1.2
- Next message: [PD-cvs] pd/src SConscript, 1.1.4.14, 1.1.4.15 d_filter.c, 1.3.4.3.2.2, 1.3.4.3.2.3 d_osc.c, 1.2.4.1.2.1, 1.2.4.1.2.2 d_soundfile.c, 1.4.4.11.2.2, 1.4.4.11.2.3 g_template.c, 1.4.8.2, 1.4.8.3 g_text.c, 1.5.4.2.2.3, 1.5.4.2.2.4 g_traversal.c, 1.2.8.2, 1.2.8.3 s_file.c, 1.2.4.8.2.2, 1.2.4.8.2.3 s_inter.c, 1.5.4.10.2.5, 1.5.4.10.2.6 s_main.c, 1.7.4.17.2.4, 1.7.4.17.2.5 t_tkcmd.c, 1.2.4.1.2.2, 1.2.4.1.2.3 u_main.tk, 1.4.4.10.2.7, 1.4.4.10.2.8
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28061
Added Files:
Tag: devel_0_39
pd.tk pd_objects.tk
Log Message:
...
--- NEW FILE: pd.tk ---
#pd tk gui v2 ix
foreach package {snack tkdnd tkpath} {package require $package}
namespace eval ::pd {
source pd_objects.tk
proc rc {} {return [format "\#%06x" [expr "int(floor(rand() * 16777216))"]]}
proc rgb {} {return [list [expr "int(floor(rand() * 256))"] [expr "int(floor(rand() * 256))"] [expr "int(floor(rand() * 256))"]]}
proc lighten {rgb r} {set l {}; foreach c $rgb {lappend l [expr {(256 - $c) * $r + $c}]}; return $l}
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 random_txt {n} {
set i 0
set text ""
while {$i < $n} {
set int [expr "int(floor(rand()*62))"]
if {$int < 10} {incr int 48} elseif {$int < 36} {incr int 55} else {incr int 61}
set text "$text[format %c $int]"
incr i
}
return $text
}
proc sel {p t a x y} {
variable _
set _($t:sc) [rc]
switch $a {
first {
foreach xy {x y} {set _($t:c$xy) [set $xy];set _($t:f$xy) [set $xy]}
$p create path [::tkpath::coords rect $_($t:cx) $_($t:cy) 0 0 -rx 12 -ry 12] \
-tags sel -stroke $_($t:sc) -strokewidth 12 -strokeopacity 0.3}
release {$p delete sel}
motion {
updatesel $p $t [cleansel $p $t [$p find overlapping $_($t:fx) $_($t:fy) $x $y]]
if {$x >= $_($t:cx)} {set xa $_($t:fx);set xb $x} else {set xa $x;set xb $_($t:fx)}
if {$y >= $_($t:cy)} {set ya $_($t:fy);set yb $y} else {set ya $y;set yb $_($t:fy)}
set w [expr {abs($xb - $xa)}]
set h [expr {abs($yb - $ya)}]
$p coords sel [::tkpath::coords rect $xa $ya $w $h -rx 12 -ry 12]
$p itemconfigure sel -stroke $_($t:sc)}}}
proc item_new {p t id d} {
variable _
variable obj
if {$id eq "-"} {
if {[dict keys $_($t)] eq ""} {set id 0} else {
set id -1
while true {if {[lsearch -integer [dict keys $_($t)] [incr id]] == -1} {break}}
}
}
set _($t:ci) $id
set type [dict get $d type]
set x [tr $p $t x i $_($t:hx)]
set y [tr $p $t y i $_($t:hy)]
item_ua $p $t $id abs [dict create x $x xx $x y $y yy $y g 0 v 1] 0
if {[dict exists $obj $type defaults]} {
item_ua $p $t $id abs [dict get $obj [dict get $d type] defaults] 0
}
item_ua $p $t $id abs $d 0
item_draw $p $t $id
}
proc item_draw {p t is} {
variable _
variable obj
if {$is eq "all"} {set is [dict keys $_($t)]}
foreach id $is {
set tags [list item i$id $id]
set color [color [dict get $_($t:g) $_($t:cg) color]]
eval [dict get $obj [dict get $_($t) $id type] draw]
redraw $p $t $id
}
}
proc item_delete {p t} {
variable _
foreach item $_($t:sel) {
foreach i [$p find withtag i$item] {
$p delete $i
}
dict unset _($t) $item
set _($t:sel) {}
item_info $p $t ""
# puts "$p $t delete $item"
}
}
proc item_pos {p t item r x y xx yy} {
item_ua $p $t $item $r [dict create x $x y $y xx $xx yy $yy] 1}
proc item_ua {p t item r u redraw} {
variable _
foreach a [dict keys $u] {
switch $r {
abs {dict set _($t) $item $a [dict get $u $a]}
rel {dict set _($t) $item $a [expr {[dict get $_($t) $item $a] + [dict get $u $a]}]}
}
#puts [concat update $p $t $item $a [dict get $_($t) $item $a]]
}
if {$redraw == 1} {redraw $p $t $item}
}
proc pencil {p t a x y} {
variable _
switch $a {
motion {
if {$_($t:af) == 1} {
item_pos $p $t $_($t:ci) abs [tr $p $t y i $y] [tr $p $t x i $x] [tr $p $t y i $_($t:fy)] [tr $p $t x i $x]
} else {
item_pos $p $t $_($t:ci) abs [tr $p $t x i $x] [tr $p $t y i $y] [tr $p $t x i $_($t:fx)] [tr $p $t y i $y]
}
}
first {item_new $p $t - [dict create type note g $_($t:cg) x 0 y 0 xx 0 yy 0 v 1]}}}
proc resize_canvas {p t a x y} {viewpoint $p $t [dict create action resize x $x y $y]}
proc redraw {p t items} {
variable _
variable obj
if {$_($t:af) == 1} {
array set a {x y y x xx yy yy xx}
} else {
array set a {x x y y xx xx yy yy}
}
switch $items {
all {set items [dict keys $_($t)]}
default {}}
foreach id $items {
#convert to screen coordinates
set x [tr $p $t x t [dict get $_($t) $id $a(x)]]
set y [tr $p $t y t [dict get $_($t) $id $a(y)]]
set xx [tr $p $t x t [dict get $_($t) $id $a(xx)]]
set yy [tr $p $t y t [dict get $_($t) $id $a(yy)]]
#some widgets dont like negative/zero widths
if {$yy == $y} {set yy [expr $y + 10]}
if {$xx == $x} {set xx [expr $x + 10]}
if {$xx < $x} {lassign "$x $xx" xx x}
if {$yy < $y} {lassign "$y $yy" yy y}
#some more values for convenience
set sx [expr {$xx - $x}]
set sy [expr {$yy - $y}]
set ro [expr {int( [set s$a(y)] / 2.0 )}]
if {[lsearch -integer $_($t:sel) $id] >= 0} {
set color $_($t:sc)
} else {
set color [color [dict get $_($t:g) [dict get $_($t) $id g] color]]
}
set tags [concat item && i$id && $id]
foreach tag [dict get $obj [dict get $_($t) $id type] tags] {
set $tag [$p find withtag "$tags && $tag"]}
eval [dict get $obj [dict get $_($t) $id type] redraw]
}
}
proc item_v {p t a x y} {
variable _
foreach item $_($t:sel) {
item_ua $p $t $item rel [dict create v [expr {($x - $_($t:cx)) / 100.0}]] 1
}
item_info $p $t $_($t:sel)
}
proc move_canvas {p t a x y} {viewpoint $p $t [dict create action move x $x y $y]}
proc move_object {p t a x y} {
variable _
set mx [tr $p $t x d [expr {$x - $_($t:cx)}]]
set my [tr $p $t y d [expr {$y - $_($t:cy)}]]
if {$_($t:af) == 1} {
foreach item $_($t:sel) {item_pos $p $t $item rel $my $mx $my $mx}
} else {
foreach item $_($t:sel) {item_pos $p $t $item rel $mx $my $mx $my}
}
item_info $p $t $_($t:sel)
}
proc resize_left {p t a x y} {resize_object $p $t x $x $y}
proc resize_right {p t a x y} {resize_object $p $t xx $x $y}
proc resize_top {p t a x y} {resize_object $p $t y $x $y}
proc resize_bottom {p t a x y} {resize_object $p $t yy $x $y}
proc resize_tl {p t a x y} {resize_object $p $t x $x $y; resize_object $p $t y $x $y}
proc resize_tr {p t a x y} {resize_object $p $t x $x $y; resize_object $p $t yy $x $y}
proc resize_bl {p t a x y} {resize_object $p $t xx $x $y; resize_object $p $t y $x $y}
proc resize_br {p t a x y} {resize_object $p $t xx $x $y; resize_object $p $t yy $x $y}
proc resize_object {p t e x y} {
variable _
if {$_($t:af) == 1} {
array set ax {x y xx y y x yy x}
} else {
array set ax {x x xx x y y yy y}
}
set m [tr $p $t $ax($e) d [expr $$ax($e) - $_($t:c$ax($e))]]
foreach item $_($t:sel) {item_ua $p $t $item rel [dict create $e $m] 1}
item_info $p $t $_($t:sel)
}
proc cleansel {p t sel} {
set clean {}
foreach item $sel {if {[lindex [$p itemcget $item -tags] 0] eq "item"} {lappend clean [lindex [$p itemcget $item -tags] 2]}}
set clean [lsort -integer -unique $clean]
return $clean
}
proc hover {p t x y} {
variable _
foreach xy {x y} {set _($t:h$xy) [set $xy]}
if {[$p find withtag sel] ne ""} {
sel $p $t motion $x $y
} else {
set clicked [cleansel $p $t [$p find overlapping [expr $x - 2] [expr $y - 2] [expr $x + 2] [expr $y + 2]]]
if {$clicked ne ""} {
resize_modes $p $t $x $y [lindex $clicked end]
if {[llength $_($t:sel)] <= 1} {updatesel $p $t [lindex $clicked end]}
} else {
mode $p $t move_canvas
}
}
}
proc resize_modes {p t x y id} {
variable _
set d 3
set bbox [$p bbox [$p find withtag "i$id && box"]]
if {$bbox eq ""} {set bbox {0 0 0 0}}
lassign $bbox bx by bxx byy
set dx [expr {abs($bx - $x)}]
set dxx [expr {abs($bxx - $x)}]
set dy [expr {abs($by - $y)}]
set dyy [expr {abs($byy - $y)}]
if {$dx < $d && $dy < $d} {
mode $p $t resize_tl
} elseif {$dxx < $d && $dy < $d} {
mode $p $t resize_tr
} elseif {$dx < $d && $dyy < $d} {
mode $p $t resize_bl
} elseif {$dxx < $d && $dyy < $d} {
mode $p $t resize_br
} elseif {$dx < 5} {
mode $p $t resize_left
} elseif {$dxx < 5} {
mode $p $t resize_right
} elseif {$dy < 1} {
mode $p $t resize_top
} elseif {$dyy < 1} {
mode $p $t resize_bottom
} else {
mode $p $t move_object
}
}
proc item_info {p t clicked} {
variable _
set n 0;$p delete hover
foreach item $clicked {
set info ""
set data [dict get $_($t) $item]
foreach d $data {lappend info [string range $d 0 7]}
$p create text [list [expr [winfo width $p] - 8.0] [expr [winfo height $p] - 8.0 - 11 * $n.0]] -fill $_($t:sc) -justify right -anchor se -font {{bitstream vera sans mono} 10} -tags hover -text $info
incr n
}}
proc togglesel {p t d} {
variable _
if {[lsearch -integer $_($t:sel) $d] < 0} {
set _($t:sel) [concat $_($t:sel) $d]
} else {
set _($t:sel) [lsearch -inline -not -all -integer $_($t:sel) $d]
}
redraw $p $t $d
}
proc updatesel {p t ns} {
variable _
set os $_($t:sel)
set _($t:sel) $ns
redraw $p $t [lsort -unique -integer [concat $os $ns]]
item_info $p $t $ns
}
proc click {m button action p t x y X Y} {
variable _
set clicked [cleansel $p $t [$p find overlapping $x $y $x $y]]
set a [$p itemcget mode -text]
switch $action {
first {
foreach xy {x y} {set _($t:f$xy) [set $xy]}
switch $button {
1 {if {$m eq "control"} {
mode $p $t pencil; pencil $p $t $action $x $y
} elseif {$m eq "double" || $m eq "shift"} {
if {[llength $clicked] > 0} {
togglesel $p $t $clicked
} else {
sel $p $t first $x $y
mode $p $t sel
}
} elseif {[$p find withtag sel] ne ""} {
sel $p $t release $x $y
} elseif {[llength $_($t:sel)] > 1 && [llength $clicked] > 0 && [lsearch $_($t:sel) $clicked] == -1} {
updatesel $p $t $clicked}}
2 {mode $p $t resize_canvas}
3 {if {$clicked ne ""} {
mode $p $t item_v } else {rmenu $p $t $X $Y}}}}
motion {eval $a $p $t $action $x $y}
release {
switch $button {
1 {if {$a eq "draw" || ($a eq "sel" && [expr {abs($_($t:fx) - $x)}] >13)} {eval $a $p $t $action $x $y}}
2 {mode $p $t move_canvas}
3 {mode $p $t move_canvas}
}
}
}
foreach xy {x y} {set _($t:c$xy) [set $xy]}
}
proc rmenu {p t x y} {
variable _
variable obj
if {[winfo exists $p.rmenu] != 1} {
set m [menu $p.rmenu -tearoff no]
$m add command -label "zoom to fit" -command "::pd::viewpoint $p $t {action fit}"
$m add command -label "reset zoom" -command "::pd::viewpoint $p $t {action reset}"
$m add command -label "add group" -command "::pd::group_new $p $t -"
$m add command -label reload -command {source pd.tk}
$m add cascade -label "create" -menu [menu $p.rmenu.create -tearoff no]
foreach type [dict keys $obj] {
$p.rmenu.create add command -label $type -command "::pd::item_new $p $t - \{type $type\}"
}
$m add cascade -label "sel to group" -menu [menu $p.rmenu.seltogroup -tearoff no]
$m add command -label "flip axes" -command "::pd::flipaxe $p $t"
} else {
# $p.rmenu entryconfigure 0 -label $x
}
$p.rmenu.seltogroup delete 0 end
foreach group [dict keys $_($t:g)] {
$p.rmenu.seltogroup add command -label [dict get $_($t:g) $group name] -command "::pd::group_assign $p $t $group"
}
tk_popup $p.rmenu $x $y
}
proc tr {p t d inv v} {
variable _
array set dm {x width y height}
switch $inv {
t {return [expr {($v - $_($t:${d}a)) / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p]}]}
i {return [expr {($_($t:${d}b) - $_($t:${d}a)) * $v /([winfo $dm($d) $p] + 0.0) + $_($t:${d}a)}]}
d {return [expr {($_($t:${d}b) - $_($t:${d}a)) * $v /([winfo $dm($d) $p] + 0.0)}]}
id {return [expr {$v / ($_($t:${d}b) - $_($t:${d}a) + 0.0) * [winfo $dm($d) $p]}]}}}
proc viewpoint {p t opts} {
variable _
switch [dict get $opts action] {
fit {
set i 0
dict for {s xy} $_($t) {
dict with xy {
if {$i == 0} {
set xa $x
set xb $x
set ya $y
set yb $y
}
if {$x > $xb} {set xb $x}
if {$x < $xa} {set xa $x}
if {$y > $yb} {set yb $y}
if {$y < $ya} {set ya $y}
if {$xx > $xb} {set xb $xx}
if {$xx < $xa} {set xa $xx}
if {$yy > $yb} {set yb $yy}
if {$yy < $ya} {set ya $yy}
incr i
}
}
set _($t:xa) $xa
set _($t:xb) $xb
set _($t:ya) $ya
set _($t:yb) $yb
}
reset {
set _($t:ya) $_($t:yao);set _($t:yb) $_($t:ybo);set _($t:xa) $_($t:xao);set _($t:xb) $_($t:xbo)
}
move {
foreach xy {x y} {
set mvt [tr $p $t $xy d [expr {[dict get $opts $xy] - $_($t:c$xy)}]]
foreach ab {a b} {set _($t:${xy}$ab) [expr {$_($t:${xy}$ab) - $mvt}]}}
}
zoom {
array set dir {in 0.5 out 1.5}
foreach xy [dict get $opts axe] {
set radius [expr {($_($t:${xy}b) - $_($t:${xy}a)) / 2. * $dir([dict get $opts dir])}]
set center [tr $p $t $xy i [dict get $opts $xy]]
set _($t:${xy}a) [expr {$center - $radius}]
set _($t:${xy}b) [expr {$center + $radius}]
}
}
resize {
foreach xy {x y} {
set mvt [tr $p $t $xy d [expr {[dict get $opts $xy] - $_($t:c$xy)}]]
set _($t:${xy}a) [expr {$_($t:${xy}a) - $mvt}]
set _($t:${xy}b) [expr {$_($t:${xy}b) + $mvt}]}
}
scroll {
set xy [dict get $opts axis]
set mv [expr {($_($t:${xy}b) - $_($t:${xy}a)) / 4.0}]
foreach ab {a b} {set _($t:${xy}$ab) [expr {[dict get $opts units] > 0 ? $_($t:${xy}$ab) + $mv : $_($t:${xy}$ab) - $mv }]}
}
}
redraw $p $t all
gridlines $p $t
}
proc flipaxe {p t} {
variable _
set _($t:af) [expr $_($t:af) == 1 ? 0 : 1]
set ya $_($t:ya)
set xa $_($t:xa)
set xb $_($t:xb)
set yb $_($t:yb)
set qx $_($t:qx)
set qy $_($t:qy)
set mx $_($t:mx)
set my $_($t:my)
set _($t:ya) $xa
set _($t:xa) $ya
set _($t:yb) $xb
set _($t:xb) $yb
set _($t:qx) $qy
set _($t:qy) $qx
set _($t:mx) $my
set _($t:my) $mx
gridlines $p $t
redraw $p $t all
}
proc clip {p t action} {
variable _
switch $action {
selecta {
updatesel $p $t [dict keys $_($t)]
}
cut {
set _($t:c) [dict create]
set i 0
foreach item $_($t:sel) {
dict set _($t:c) $i [dict get $_($t) $item]
incr i
}
item_delete $p $t
}
copy {
set _($t:c) [dict create]
set i 0
foreach item $_($t:sel) {
dict set _($t:c) $i [dict get $_($t) $item]
incr i
}
}
paste {
set pasted {}
foreach item [dict keys $_($t:c)] {
item_new $p $t - [dict get $_($t:c) $item]
}
}
}
}
proc mode {p t m} {
array set cursor {pencil pencil move_canvas fleur move_object dotbox item_v box_spiral resize_canvas bogosity sel cross_reverse resize_left left_side resize_right right_side resize_top top_side resize_bottom bottom_side resize_tl top_left_corner resize_tr top_right_corner resize_bl bottom_left_corner resize_br bottom_right_corner}
$p itemconfigure mode -text $m
$p configure -cursor $cursor($m)
}
proc group_assign {p t group} {
variable _
foreach item $_($t:sel) {
item_ua $p $t $item abs [dict create g $group] 0
}
}
proc group_new {p t grp} {
variable _
set exists 0
dict for {key val} $_($t:g) {if {[dict get $val name] eq $grp} {set exists 1}}
if {$exists == 0} {
if {$grp eq "-"} {set grp [random_txt [expr "int(floor(rand() * 10 + 2))"]]}
set n -1
while true { if {[lsearch -integer [dict keys $_($t:g)] [incr n]] == -1} {break}}
dict set _($t:g) $n name $grp
dict set _($t:g) $n color [rgb]
set _($t:cg) $n
groups_view $p $t
group_active $p $t $n
}
}
proc groups_view {p t} {
variable _
$p delete [$p find withtag group]
foreach i [dict keys $_($t:g)] {
set id [$p create text [concat 68.0 [expr {38.0 + 11 * $i}]] -fill [color [dict get $_($t:g) $i color]] -justify right -anchor e -font {{bitstream vera sans mono} 10} -tags [concat group $i lb] -text [dict get $_($t:g) $i name]]
$p bind $id <Enter> "::pd::group_active $p $t $i"
$p bind $id <1> "::pd::group_assign $p $t $i"
set bx [$p bbox $id]
$p lower [$p create path [::tkpath::coords rect [lindex $bx 0] [lindex $bx 1] [expr [lindex $bx 2] - [lindex $bx 0]] [expr [lindex $bx 3] - [lindex $bx 1]] -rx 6 -ry 6] -tags [concat group $i bg] -strokewidth 1 -stroke white -fill white -fillopacity 0.5]
}
}
proc group_active {p t g} {
variable _
set _($t:cg) $g
foreach n [dict keys $_($t:g)] {
if {$g == $n} {set cb black; set cl white; set tl 1} {set cb white; set cl [color [dict get $_($t:g) $n color]]; set tl 0.5}
set idb [$p find withtag "group && $n && bg"]
$p itemconfigure $idb -fill $cb -fillopacity $tl -stroke $cl
set idl [$p find withtag "group && $n && lb"]
$p itemconfigure $idl -fill $cl;
if {$g == $n} {$p raise $idb;$p raise $idl;}
}
}
proc key {p t k b} {
puts $k
switch $b {
1 {
switch $k {
22 {item_delete $p $t}
38 {clip $p $t selecta}
53 {clip $p $t cut}
54 {clip $p $t copy}
55 {clip $p $t paste}
97 {viewpoint $p $t {action reset}}
98 {viewpoint $p $t {action scroll units -1 axis y}}
100 {viewpoint $p $t {action scroll units -1 axis x}}
102 {viewpoint $p $t {action scroll units 1 axis x}}
104 {viewpoint $p $t {action scroll units 1 axis y}}
107 {item_delete $p $t}
}
}
}
}
proc drop {p t dropped x y} {
foreach d [split $dropped "\n"] {
set x [tr $p $t x i $x]
set y [tr $p $t y i $y]
item_new $p $t - [dict create type sound g 1 v 1 x $x y $y xx $x yy $y filename [regsub -- {^file:[/]+} $d "/"]]
}
}
proc new {p t opts} {
variable _
foreach xy {x y} {foreach ab {a b} {set _($t:${xy}${ab}o) [dict get $opts ${xy}${ab}]}}
foreach a {sc ln xa xb ya yb qx qy mx my samplerate} {set _($t:$a) [dict get $opts $a]}
if {[winfo exists $p] != 1} {
canvas $p -bg [dict get $opts bg]
place $p -relwidth 1 -relheight 1
bind $p <Configure> "::pd::gridlines $p $t"
bind $p <Enter> "focus $p"
bind $p <Key> "::pd::key $p $t %k 1"
bind $p <KeyRelease> "::pd::key $p $t %k 0"
dnd bindtarget $p text/plain <Drop> "::pd::drop $p $t %D %x %y"
bind $p <Motion> "::pd::hover $p $t %x %y"
bind $p <4> "::pd::viewpoint $p $t {action scroll units 1 axis x}"
bind $p <5> "::pd::viewpoint $p $t {action scroll units -1 axis x}"
bind $p <Control-4> "::pd::viewpoint $p $t {action zoom dir in axe x x %x y %y}"
bind $p <Control-5> "::pd::viewpoint $p $t {action zoom dir out axe x x %x y %y}"
bind $p <Alt-4> "::pd::viewpoint $p $t {action zoom dir in axe {x y} x %x y %y}"
bind $p <Alt-5> "::pd::viewpoint $p $t {action zoom dir out axe {x y} x %x y %y}"
bind $p <Control-Shift-4> "::pd::viewpoint $p $t {action zoom dir in axe y x %x y %y}"
bind $p <Control-Shift-5> "::pd::viewpoint $p $t {action zoom dir out axe y x %x y %y}"
bind $p <Shift-4> "::pd::viewpoint $p $t {action scroll units -1 axis y}"
bind $p <Shift-5> "::pd::viewpoint $p $t {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 $p <$m[lindex [lindex $b $ba] 0]> "::pd::click [list [string tolower [string trimright $m -1]]] $bn [lindex [lindex $b $ba] 1] $p $t %x %y %X %Y"}}}
set bd [expr {[$p cget -bd] * 2}]
$p configure -bg gray -width [expr {[winfo width $p] + $bd}] -height [expr {[winfo height $p] + $bd}]
$p create text {20 20} -fill blue -justify left -anchor w -font {{bitstream vera sans} 18} -tags mode -text move_canvas
$p create path "M 0 0" -tags lX -stroke black -strokeopacity 0.5
$p create path "M 0 0" -tags lY -stroke black -strokeopacity 0.5
if {[info exists _($t)] != 1} {
set _($t) {}
set _($t:g) {}
set af 0; set i -1; set sel {}
foreach a {af i sel} {set _($t:$a) [set $a]}
group_new $p $t default
group_new $p $t wavs
}
}
gridlines $p $t
item_draw $p $t all
groups_view $p $t
}
proc gridlines {p t} {
variable _
foreach item [$p find withtag gridline] {$p delete $item}
foreach xy {x y} {
array set ta {x n y w}
array set tj {x center y left}
array set igx {y width x height}
set range [expr {abs($_($t:${xy}b) - $_($t:${xy}a))}]
set nSlices [expr {$range / $_($t:q$xy)}]
if {$nSlices > $_($t:m${xy})} {set factor [expr {int($nSlices / ($_($t:m${xy}) + 0.0) + 1)}]} else {
set factor [expr {1. / (int(1./($nSlices / ($_($t:m${xy}) + 0.0) + 0.0)) + 0.0)}]
}
set increment [expr {$_($t:q${xy}) * $factor}]
for {set x [expr {int($_($t:${xy}a) / ($increment + 0.0) + 1)*($increment + 0.0)}]} {[expr {$_($t:${xy}a) > $_($t:${xy}b) ? $x >= $_($t:${xy}b) : $x <= $_($t:${xy}b)}]} {set x [expr {$_($t:${xy}a) > $_($t:${xy}b) ? $x - $increment : $x + $increment}]} {
set og [tr $p $t $xy t $x]
set invgeo [winfo $igx($xy) $p]
switch $xy {
y {set coords [concat M 0 $og L $invgeo $og]}
x {set coords [concat M $og 0 L $og $invgeo]}}
$p lower [$p create text [lrange $coords 1 2] -font {{Bitstream Vera Sans} 8} -fill [rc] -anchor $ta($xy) -text [string range $x 0 7] -justify $tj($xy) -tags gridline]
$p lower [$p create path $coords -stroke $_($t:ln) -strokedasharray [expr {int(rand()*42 + 1)}] -tags gridline -strokewidth 1]
}}}
. configure -width 800 -height 800
new .c c {bg gray86 ln white sc orange samplerate 44100 xa 0 xb 100 ya 0 yb 100 qx 10 qy 10 mx 15 my 15}
}
--- NEW FILE: pd_objects.tk ---
variable obj
set obj {
note {
tags {
note
}
draw {
$p create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags $tags -fill $color -strokewidth 0 -fillopacity 0.8
}
redraw {
$p coords $note [::tkpath::coords rect $x $y $sx $sy -rx $ro -ry $ro]
$p itemconfigure $note -fillopacity [dict get $_($t) $id v] -fill $color
}
}
msg {
tags {
box txt
}
draw {
$p create polygon 0 0 0 0 -tags [concat $tags box] -fill $color
$p create text 0 0 -tags [concat $tags txt] -fill white -text "msg" -anchor w -justify left
}
redraw {
$p coords $txt $x [expr $y + $sy/2.]
$p itemconfigure $txt -font [list {bitstream vera sans} [expr int($sy)]]
lassign [$p bbox $txt] x y xx yy
$p coords $box $x $y [expr $xx + $sy / 5.] $y $xx [expr $y + $sy/2.] [expr $xx + $sy / 5.] $yy $x $yy
}
}
slider {
tags {
pos box
}
defaults {
orient h
min 1
max 69
}
draw {
$p create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags [concat $tags box] -fill blue
$p create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags [concat $tags pos] -fill green
}
redraw {
$p coords $box [::tkpath::coords rect $x $y $sx $sy -rx 3 -ry 3]
switch [dict get $_($t) $id orient] {
v {set coords [::tkpath::coords rect $x [expr $y + ($yy - $y) * [dict get $_($t) $id v]] [expr $xx - $x] 3 -rx 0 -ry 0]}
h {set coords [::tkpath::coords rect [expr $x + ($xx - $x) * [dict get $_($t) $id v]] $y 3 [expr $yy - $y] -rx 0 -ry 0]}}
$p coords $pos $coords
}
}
sound {
tags {
tl tlr tf tfr r w
}
draw {
snack:::sound s$id
set filename [dict get $_($t) $id filename]
s$id read $filename
$p create path [::tkpath::coords rect 0 0 0 0 -rx 3 -ry 3] -tags [concat $tags r] -strokewidth 0 -fill $color -fillopacity 0.08
$p create waveform 0 0 -tags [concat $tags w] -sound s$id -fill white
set length [expr [s$id length] / ($_($t:samplerate) + 0.0) * 1000]
mat_item_ua $p $t $id abs [dict create xx [expr [dict get $_($t) $id x] + $length]] 0
$p create text 0 0 -tags [concat $tags tl] -font {{bitstream vera sans} 8} -fill HotPink -anchor nw -justify left -text "[string range $length 0 10] s"
$p create rectangle 0 0 0 0 -tags [concat $tags tlr] -fill LightGreen -width 0
$p raise $tl
$p create text 0 0 -tags [concat $tags tf] -font {{bitstream vera sans} 8} -fill NavyBlue -anchor ne -justify right -text $filename
$p create rectangle 0 0 0 0 -tags [concat $tags tfr] -fill gray90 -width 0
$p raise $tf
}
redraw {
set ro 6
$p coords $r [::tkpath::coords rect $x $y $sx $sy -rx $ro -ry $ro]
$p itemconfigure $r -fillopacity [dict get $_($t) $id v] -fill $color
$p coords $w $x $y
$p itemconfigure $w -width $sx -height [expr int($sy)]
$p coords $tl [expr $x + 4] [expr $y + 4]
$p coords $tlr [$p bbox $tl]
$p coords $tf [expr $x + $sx] [expr $y + 4]
$p coords $tfr [$p bbox $tf]
}
}
}
- Previous message: [PD-cvs] externals/grh/GApop/pd GA_example1.pd, NONE, 1.1 help-GApop.pd, 1.1, 1.2
- Next message: [PD-cvs] pd/src SConscript, 1.1.4.14, 1.1.4.15 d_filter.c, 1.3.4.3.2.2, 1.3.4.3.2.3 d_osc.c, 1.2.4.1.2.1, 1.2.4.1.2.2 d_soundfile.c, 1.4.4.11.2.2, 1.4.4.11.2.3 g_template.c, 1.4.8.2, 1.4.8.3 g_text.c, 1.5.4.2.2.3, 1.5.4.2.2.4 g_traversal.c, 1.2.8.2, 1.2.8.3 s_file.c, 1.2.4.8.2.2, 1.2.4.8.2.3 s_inter.c, 1.5.4.10.2.5, 1.5.4.10.2.6 s_main.c, 1.7.4.17.2.4, 1.7.4.17.2.5 t_tkcmd.c, 1.2.4.1.2.2, 1.2.4.1.2.3 u_main.tk, 1.4.4.10.2.7, 1.4.4.10.2.8
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the Pd-cvs
mailing list