Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9033
Modified Files: Tag: devel_0_39 pd.tk pd_objects.tk Log Message: +floating inspector
Index: pd.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/pd.tk,v retrieving revision 1.1.2.3 retrieving revision 1.1.2.4 diff -C2 -d -r1.1.2.3 -r1.1.2.4 *** pd.tk 4 Aug 2005 20:32:37 -0000 1.1.2.3 --- pd.tk 11 Aug 2005 14:30:58 -0000 1.1.2.4 *************** *** 104,112 **** 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 rect g $($t:cg) x 0 y 0 xx 0 yy 0 v 1]}}} --- 104,108 ---- 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]}}} *************** *** 117,142 **** 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 { ! set type [dict get $($t) $id type]
! #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 more pregen for convenience - set sx [expr {$xx - $x}] - set sy [expr {$yy - $y}] - foreach local [dict keys [dict get $obj $type defaults]] { - set $local [dict get $obj $type defaults $local]} if {[lsearch -integer $($t:sel) $id] >= 0} { set color $($t:sc) --- 113,128 ---- 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) *************** *** 174,201 **** 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} --- 160,179 ---- 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} item_info $p $t $($t:sel) }
! 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))]] foreach item $($t:sel) {item_ua $p $t $item rel [dict create $e $m] 1} *************** *** 203,206 **** --- 181,188 ---- }
+ proc item_scale {p t a x y} { + + + } proc cleansel {p t sel} { set clean {} *************** *** 218,223 **** 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 --- 200,207 ---- 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 *************** *** 288,295 **** }
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 { --- 272,301 ---- }
+ proc inspect {p t id} { + if {![winfo exists .i$t]} {return} + variable "" + set keys [dict keys [dict get $($t) $id]] + if {$($t:inspect) != $id} { + foreach c [winfo children .ic] {destroy $c} + foreach k $keys { + text .i$t.$k -wrap none -width 10 -height 1 -bd 0 + .i$t.$k insert 1.0 $k + .i$t.$k configure -state disabled + text .i$t.${k}v -wrap none -width 16 -height 1 -bd 1 + bind .i$t.${k}v <Any-KeyRelease> "::pd::item_ua $p $t $id abs [dict create $k [.i$t.${k}v get 1.0 end] ] 1" + grid .i$t.$k .i$t.${k}v + } + } + 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 { *************** *** 309,315 **** } 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 { --- 315,320 ---- } 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 { *************** *** 321,324 **** --- 326,330 ---- } } + if {$clicked ne ""} {inspect $p $t [lindex $clicked end]} foreach xy {x y} {set ($t:c$xy) [set $xy]} } *************** *** 350,357 **** $mv add command -label "zoom to fit" -command "::pd::viewpoint $p $t {action fit}" $mv add command -label "reset" -command "::pd::viewpoint $p $t {action reset}" - $mv add command -label "flip axes" -command "::pd::flipaxe $p $t" -
$m add command -label reload -command {source pd.tk}
} else { --- 356,363 ---- $mv add command -label "zoom to fit" -command "::pd::viewpoint $p $t {action fit}" $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 "toplevel .i$t"
} else { *************** *** 433,444 **** }
- proc flipaxe {p t} { - variable "" - set ($t:af) [expr $($t:af) == 1 ? 0 : 1] - lassign "$($t:xa) $($t:ya) $($t:xb) $($t:yb) $($t:qx) $($t:qy) $($t:mx) $($t:my)" ($t:ya) ($t:xa) ($t:yb) ($t:xb) ($t:qy) ($t:qx) ($t:my) ($t:mx - gridlines $p $t - redraw $p $t all - } - proc clip {p t action} { variable "" --- 439,442 ---- *************** *** 474,479 ****
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) } --- 472,478 ----
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) } *************** *** 548,555 **** 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" --- 547,555 ---- 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 inspect} {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 + toplevel .i$t bind $p <Configure> "::pd::gridlines $p $t; ::pd::redraw $p $t all" bind $p <Enter> "focus $p" *************** *** 579,588 **** 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 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 } --- 579,587 ---- 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 } *************** *** 616,620 ****
. 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}
} --- 615,619 ----
. 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 inspect -}
} *************** *** 622,626 **** catch { source /usr/local/bin/tkcon.tcl - tkcon show tk_setPalette white } --- 621,624 ----
Index: pd_objects.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/pd_objects.tk,v retrieving revision 1.1.2.3 retrieving revision 1.1.2.4 diff -C2 -d -r1.1.2.3 -r1.1.2.4 *** pd_objects.tk 4 Aug 2005 20:32:37 -0000 1.1.2.3 --- pd_objects.tk 11 Aug 2005 14:30:58 -0000 1.1.2.4 *************** *** 18,23 **** } redraw { ! if {$zero_x} {set zs_x [tr $p $t x id $zs_x]; set xx [expr $x + $zs_x]; set x [expr $x - $zs_x]} ! if {$zero_y} {set zs_y [tr $p $t y id $zs_y]; set yy [expr $y + $zs_y]; set y [expr $y - $zs_y]} $p coords $box $x $y $xx $yy
--- 18,23 ---- } redraw { ! if {[expr $zero_x == 1]} {set zs_x [tr $p $t x id $zs_x]; set xx [expr $x + $zs_x]; set x [expr $x - $zs_x]} ! if {[expr $zero_y == 1]} {set zs_y [tr $p $t y id $zs_y]; set yy [expr $y + $zs_y]; set y [expr $y - $zs_y]} $p coords $box $x $y $xx $yy
*************** *** 67,71 **** redraw { $p coords $box $x $y $xx $yy ! $p coords $loc $x $y [expr $x + $sx / 2.] [expr $y + $sy/2.] } } --- 67,72 ---- redraw { $p coords $box $x $y $xx $yy ! $p coords $loc $x $y [expr $x + ($xx - $x) / 12.] [expr $y + ($yy - $y)/12.] ! $p itemconfigure $box -outline $color } } *************** *** 95,105 **** 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 } } --- 96,106 ---- 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 -anchor nw -justify left } redraw { ! $p coords $txt $x $y ! $p itemconfigure $txt -font [list {bitstream vera sans} [expr int($sy)]] -text $msg lassign [$p bbox $txt] x y xx yy ! $p coords $box $x $y [expr $xx + $sx / 5.] $y $xx [expr $y + $sy/2.] [expr $xx + $sx / 5.] $yy $x $yy } } *************** *** 121,125 **** redraw { $p coords $box $x $y $xx $yy ! set orient [expr ($xx - $x) > ($yy - $y) ? "h" : "v"] switch $orient { v {set coords [concat $x [expr $y + ($yy - $y) * [dict get $($t) $id v]] [expr $xx - $x] 3]} --- 122,126 ---- redraw { $p coords $box $x $y $xx $yy ! if {[expr ($xx - $x) > ($yy - $y)]} {set orient h} {set orient v} switch $orient { v {set coords [concat $x [expr $y + ($yy - $y) * [dict get $($t) $id v]] [expr $xx - $x] 3]}