[PD-cvs] pd/src pd_base.tk,NONE,1.1.2.1 pd.tk,1.1.2.6,NONE
carmen rocco
ix9 at users.sourceforge.net
Wed Aug 24 01:05:03 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23988
Added Files:
Tag: devel_0_39
pd_base.tk
Removed Files:
Tag: devel_0_39
pd.tk
Log Message:
all your base, belong to tim
--- pd.tk DELETED ---
--- NEW FILE: pd_base.tk ---
#pd tk gui v2 ix
foreach _ {snack tkdnd tkpath} {
if {[catch {package require $_}]} {set has_$_ 0} {set has_$_ 1}
}
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 ""
switch $a {
first {
foreach xy {x y} {set ($t:c$xy) [set $xy];set ($t:f$xy) [set $xy]}
$p create rect $($t:cx) $($t:cy) $($t:cx) $($t:cy) \
-tags sel -fill "" -outline $($t:sc) -width 12}
release {$p delete sel}
motion {
updatesel $p $t [cleansel $p $t [$p find overlapping $($t:fx) $($t:fy) $x $y]]
$p coords sel $($t:fx) $($t:fy) $x $y}}}
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)]
if {[dict exists $obj $type size]} {
set sx [dict get $obj $type size x]
set sy [dict get $obj $type size y]
} {set sx 0; set sy 0}
update $p $t $id abs [dict create x $x xx [expr $x + $sx] y $y yy [expr $y + $sy] color {128 128 128} v 1] 0
if {[dict exists $obj $type defaults]} {
update $p $t $id abs [dict get $obj $type defaults] 0
}
update $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 type [dict get $($t) $id type]
set tags [list item i$id $id]
set color [color [dict get $($t:g) $($t:cg) color]]
if {[dict exists $obj $type defaults]} {
foreach local [dict keys [dict get $obj $type defaults]] {
set $local [dict get $obj $type defaults $local]}}
eval [dict get $obj $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 ""
send "delete $item"
}
}
proc item_pos {p t item r x y xx yy} {
update $p $t $item $r [dict create x $x y $y xx $xx yy $yy] 1}
proc update {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]}]}
}
send [concat update $item $a [dict get $($t) $item $a]]
}
if {$redraw == 1} {redraw $p $t $item}
}
proc update_one {p t item r k v redraw} {
update $p $t $item $r [dict create $k $v] $redraw
}
proc pencil {p t a x y} {
variable ""
switch $a {
motion {
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 rect 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
switch $items {
all {set items [dict keys $($t)]}
default {}}
foreach id $items {
foreach local [dict keys [dict get $($t) $id]] {
set $local [dict get $($t) $id $local]}
set x [tr $p $t x t $x];set y [tr $p $t y t $y];set xx [tr $p $t x t $xx];set yy [tr $p $t y t $yy]
if {[expr $x > $xx]} {lassign "$x $xx" xx x}
if {[expr $y > $yy]} {lassign "$y $yy" yy y}
set sx [expr $xx - $x]; set sy [expr $yy - $y]
if {[lsearch -integer $($t:sel) $id] >= 0} {
set color $($t:sc)
set selected 1
} else {
set color [color [dict get $($t) $id color]]
set selected 0}
if {[dict exists $($t) $id g]} {
set gcolor [color [dict get $($t:g) [dict get $($t) $id g] color]]}
set tags [concat item && i$id && $id]
set item [$p find withtag $tags]
if {[dict exists $obj $type tags]} {
foreach tag [dict get $obj $type tags] {
set $tag [$p find withtag "$tags && $tag"]}}
eval [dict get $obj $type redraw]
redraw_io $p $t $id
}
}
proc redraw_io {p d id} {
}
proc item_v {p t a x y} {
variable ""
variable obj
foreach id $($t:sel) {
set type [dict get $($t) $id type]
if {[dict exists $obj $type defaults]} {
foreach local [dict keys [dict get $obj $type defaults]] {
set $local [dict get $obj $type defaults $local]}}
if {[dict exists $obj $type control Button-1]} {eval [dict get $obj $type control Button-1]}
}
}
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)}]]
foreach item $($t:sel) {item_pos $p $t $item rel $mx $my $mx $my}
}
proc resize_left {p t a x y} {item_resize $p $t x $x $y}
proc resize_right {p t a x y} {item_resize $p $t xx $x $y}
proc resize_top {p t a x y} {item_resize $p $t y $x $y}
proc resize_bottom {p t a x y} {item_resize $p $t yy $x $y}
proc resize_tl {p t a x y} {item_resize $p $t x $x $y; item_resize $p $t y $x $y}
proc resize_tr {p t a x y} {item_resize $p $t x $x $y; item_resize $p $t yy $x $y}
proc resize_bl {p t a x y} {item_resize $p $t xx $x $y; item_resize $p $t y $x $y}
proc resize_br {p t a x y} {item_resize $p $t xx $x $y; item_resize $p $t yy $x $y}
proc item_resize {p t e x y} {
variable ""
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))]]
item_mua $p $t rel [dict create $e $m] 1
}
proc item_scale {p t a x y} {
}
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 ""} {
set c [lindex $clicked end]
resize_modes $p $t $x $y $c
if {[llength $($t:sel)] <= 1} {updatesel $p $t $c}
inspect $p $t $c
} 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 ""
return
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 msg {} {
if {![winfo exists .msg]} {
toplevel .msg
grid [entry .msg.text]
bind .msg.text <KeyPress-Return> {::pd::send [.msg.text get]}}}
proc inspector {p t} {
variable ""
if {![winfo exists .i$t]} {toplevel .i$t
if {[info exists ($t:inspect)]} {unset ($t:inspect)}}}
proc inspect {p t id} {
if {![winfo exists .i$t]} {return}
variable ""
set keys [dict keys [dict get $($t) $id]]
if {![info exists ($t:inspect)] || ([info exists ($t:inspect)] && [dict get $($t) $($t:inspect) type] ne [dict get $($t) $id type])} {
foreach c [winfo children .ic] {destroy $c}
foreach k $keys {
text .i$t.$k -wrap none -width 8 -height 1 -bd 0
.i$t.$k insert 1.0 $k
.i$t.$k tag add justify 1.0 end
.i$t.$k tag configure justify -justify right
.i$t.$k configure -state disabled
text .i$t.${k}v -wrap none -width 16 -height 1 -bd 0 -bg gray94
bind .i$t.${k}v <Any-KeyRelease> "::pd::item_mua $p $t abs \[dict create $k \[.i$t.${k}v get 1.0 end\] \] 1"
grid .i$t.$k .i$t.${k}v -sticky nsew
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}}
set ($t:inspect) $id
foreach k $keys {
.i$t.${k}v delete 1.0 end
.i$t.${k}v insert 1.0 [dict get $($t) $id $k]}}
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 $($t:submode)
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 {if {$clicked ne ""} {mode $p $t item_scale} {mode $p $t resize_canvas}}
3 {if {$clicked ne ""} {mode $p $t item_v} {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}
}
}
}
if {$clicked ne ""} {inspect $p $t [lindex $clicked end]}
foreach xy {x y} {set ($t:c$xy) [set $xy]}
}
proc rmenu {p t x y} {
variable ""
variable obj
destroy $p.rmenu
if {[winfo exists $p.rmenu] != 1} {
set m [menu $p.rmenu -tearoff yes]
$m add cascade -label "edit" -menu [set me [menu $m.edit -tearoff no]]
foreach a {copy cut paste selecta} {
$me add command -label $a -command "::pd::clip $p $t $a"}
$m add cascade -label "group" -menu [set mg [menu $m.group -tearoff no]]
$mg add command -label "add" -command "::pd::group_new $p $t -"
$mg add cascade -label "sel" -menu [set mgs [menu $mg.selto -tearoff yes]]
foreach group [dict keys $($t:g)] {$mgs add command -label [dict get $($t:g) $group name] -command "::pd::group_assign $p $t $group"}
$m add cascade -label "object" -menu [set mo [menu $m.object -tearoff no]]
foreach type [dict keys $obj] {
$mo add command -label $type -command "::pd::item_new $p $t - \{type $type\}"}
$m add cascade -label "view" -menu [set mv [menu $m.view -tearoff no]]
$mv add command -label "zoom to fit" -command "::pd::viewpoint $p $t {action fit}"
$mv add command -label "flip x" -command "::pd::viewpoint $p $t {action mirror_x}"
$mv add command -label "flip y" -command "::pd::viewpoint $p $t {action mirror_y}"
$mv add command -label "reset" -command "::pd::viewpoint $p $t {action reset}"
$m add command -label reload -command {source pd.tk}
$m add command -label "console" -command {tkcon show}
$m add command -label "inspector" -command "::pd::inspector $p $t"
$m add command -label "msg" -command "::pd::msg"
} else {
# $p.rmenu entryconfigure 0 -label $x
}
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 {
lassign [$p bbox item] xa ya xb yb
set ($t:xa) [tr $p $t x i $xa]
set ($t:xb) [tr $p $t x i $xb]
set ($t:ya) [tr $p $t y i $ya]
set ($t:yb) [tr $p $t y i $yb]
}
mirror_x {
lassign "$($t:xb) $($t:xa)" ($t:xa) ($t:xb)
}
mirror_y {
lassign "$($t:yb) $($t:ya)" ($t:ya) ($t: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 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} {
variable ""
array set cursor {pencil pencil move_canvas fleur move_object dotbox item_v box_spiral resize_canvas bogosity sel cross_reverse item_scale sizing 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}
set ($t:submode) $m
$p configure -cursor $cursor($m)
}
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
}
}
proc group_assign {p t group} {
variable ""
item_mua $p $t abs [dict create g $group] 1
}
proc item_mua {p t r u redraw} {
variable ""
foreach item $($t:sel) {update $p $t $item $r $u $redraw}
}
proc mode_flip {p t} {
variable ""
if {$($t:mode) eq "edit"} {
array set m {bg white ln gray86 mode forward}
} else {
array set m {bg gray86 ln white mode edit}
}
set ($t:mode) $m(mode)
$p configure -bg $m(bg)
set ($t:ln) $m(ln)
gridlines $p $t
}
proc key {p t k b} {
# puts $k
switch $b {
1 {
switch $k {
9 {mode_flip $p $t}
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 ""
variable obj
foreach xy {x y} {foreach ab {a b} {set ($t:${xy}${ab}o) [dict get $opts ${xy}${ab}]}}
foreach a {sc ln mode 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; ::pd::redraw $p $t all"
bind $p <Enter> "focus $p"
bind $p <Key> "::pd::key $p $t %k 1"
bind $p <KeyRelease> "::pd::key $p $t %k 0"
if {$::has_tkdnd == 1} {
dnd bindtarget $p text/plain <Drop> "::pd::drop $p $t %D %x %y"
} else {
dict unset obj sound
}
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}]
if {[info exists ($t)] != 1} {
set ($t) {}
set ($t:g) {}
set i -1; set sel {}
foreach a {i sel} {set ($t:$a) [set $a]}
group_new $p $t default
}
}
gridlines $p $t
item_draw $p $t all
}
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 0 $og $invgeo $og]}
x {set coords [concat $og 0 $og $invgeo]}}
$p lower [$p 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 gridline]
$p lower [$p create line $coords -fill $($t:ln) -stipple gray50 -tags gridline]
}}}
. configure -width 800 -height 800
new .c c {bg gray86 ln white mode edit sc orange samplerate 44100 xa 0 xb 100 ya 0 yb 100 qx 10 qy 10 mx 15 my 15}
variable pd_send
if {[catch {set pd_send [socket localhost 4400]}]} {set pd_send -1} {puts "connected $pd_send"}
catch {
set pd_receive [socket -server ::pd::receive_conn 4401]
}
proc receive_conn {s addr port} {
fileevent $s readable [list ::pd::receive $s]
fconfigure $s -buffering line -blocking 0
puts "connection from $addr"
}
proc receive {s} {
set l [gets $s]
if {[eof $s]} {
close $s
} else {
if {[catch {eval $l}]} {puts "error in: $l"}
}
}
proc send {msg} {
variable pd_send
if {$pd_send ne -1} {
# puts "sending: $msg"
puts $pd_send [concat $msg \;]
flush $pd_send
}
}
}
catch {
source /usr/local/bin/tkcon.tcl
tk_setPalette white
}
More information about the Pd-cvs
mailing list