Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30431
Modified Files: Tag: devel_0_39 pd.tk pd_objects.tk Log Message: adding GOP and some other crap i forget
Index: pd.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/pd.tk,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -C2 -d -r1.1.2.1 -r1.1.2.2 *** pd.tk 1 Aug 2005 20:56:38 -0000 1.1.2.1 --- pd.tk 3 Aug 2005 03:56:51 -0000 1.1.2.2 *************** *** 1,5 **** #pd tk gui v2 ix
! foreach package {snack tkdnd tkpath} {package require $package} namespace eval ::pd { source pd_objects.tk --- 1,7 ---- #pd tk gui v2 ix
! if {[catch {package require snack}]} {set has_snack 0} {set has_snack 1} ! if {[catch {package require tkdnd}]} {set has_tkdnd 0} {set has_tkdnd 1} ! namespace eval ::pd { source pd_objects.tk *************** *** 23,32 **** 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 { --- 25,33 ---- 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 polygon $_($t:cx) $_($t:cy) $_($t:cx) $_($t:cy) \ ! -tags sel -fill "" -outline $_($t:sc) -width 12} release {$p delete sel} motion { *************** *** 34,41 **** 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} { --- 35,39 ---- 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)} ! $p coords sel $xa $ya $xb $ya $xb $yb $xa $yb $xa $ya}}}
proc item_new {p t id d} { *************** *** 53,57 **** 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]} { --- 51,55 ---- 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 color {128 128 128} v 1] 0
if {[dict exists $obj $type defaults]} { *************** *** 113,117 **** } } ! 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]} --- 111,115 ---- } } ! 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]} *************** *** 141,145 **** if {$yy < $y} {lassign "$y $yy" yy y}
! #some more values for convenience set sx [expr {$xx - $x}] set sy [expr {$yy - $y}] --- 139,143 ---- if {$yy < $y} {lassign "$y $yy" yy y}
! #some more pregen for convenience set sx [expr {$xx - $x}] set sy [expr {$yy - $y}] *************** *** 147,157 **** 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] } --- 145,159 ---- 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] 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] } *************** *** 229,232 **** --- 231,235 ---- set bbox [$p bbox [$p find withtag "i$id && box"]] if {$bbox eq ""} {set bbox {0 0 0 0}} + puts "$x $y rbx $bbox" lassign $bbox bx by bxx byy set dx [expr {abs($bx - $x)}] *************** *** 323,350 **** 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 { --- 326,365 ---- 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 "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 { # $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 { *************** *** 419,442 **** 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 } --- 434,439 ---- 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 } *************** *** 480,529 **** }
! 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;} } }
--- 477,513 ---- }
! 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 _ ! foreach item $_($t:sel) { ! item_ua $p $t $item abs [dict create g $group] 1 } }
! 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 }
*************** *** 533,536 **** --- 517,521 ---- 1 { switch $k { + 9 {mode_flip $p $t} 22 {item_delete $p $t} 38 {clip $p $t selecta} *************** *** 560,568 **** 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" --- 545,553 ---- variable _ 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" *************** *** 588,593 **** $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) {} --- 573,576 ---- *************** *** 596,605 **** 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 }
--- 579,586 ---- foreach a {af i sel} {set _($t:$a) [set $a]} group_new $p $t default ! } } gridlines $p $t item_draw $p $t all }
*************** *** 621,632 **** 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}
! } \ No newline at end of file --- 602,619 ---- 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}
! } ! ! catch { ! source /usr/local/bin/tkcon.tcl ! tkcon show ! tk_setPalette white ! }
Index: pd_objects.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/pd_objects.tk,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -C2 -d -r1.1.2.1 -r1.1.2.2 *** pd_objects.tk 1 Aug 2005 20:56:39 -0000 1.1.2.1 --- pd_objects.tk 3 Aug 2005 03:56:51 -0000 1.1.2.2 *************** *** 2,15 **** 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 } } --- 2,77 ---- set obj {
! rect { tags { ! box ! } ! defaults { ! ins 0 ! outs 0 } draw { ! $p create rect 0 0 0 0 -tags [concat $tags box] } redraw { ! $p coords $box $x $y $xx $yy ! $p itemconfigure $box -fill $gcolor -outline $color -width [expr $selected + 1] ! } ! } ! ! subwin { ! tags { ! box subwin ! } ! defaults { ! ins 0 ! outs 0 ! } ! draw { ! $p create rect 0 0 0 0 -tags [concat $tags box] ! new $p.$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} ! $p create window 0 0 -tags [concat $tags subwin] -window $p.$id -anchor nw ! } ! redraw { ! $p coords $box [expr $x - 10] $y $xx $yy ! $p coords $subwin $x $y ! set w [expr $xx - $x] ! set h [expr $yy - $y] ! if {[expr abs($w - [$p.$id cget -width]) >= 1 || abs($h - [$p.$id cget -height]) >= 1]} { ! $p.$id configure -width $w -height $h ! } ! $p itemconfigure $box -fill $color ! } ! } ! ! ! ! xy { ! tags { ! box loc ! } ! defaults { ! ins 0 ! outs 0 ! } ! draw { ! $p create rect 0 0 0 0 -tags [concat $tags box] -fill gray90 ! $p create rect 0 0 0 0 -tags [concat $tags loc] -fill red ! } ! redraw { ! $p coords $box $x $y $xx $yy ! $p coords $loc $x $y [expr $x + $sx / 2.] [expr $y + $sy/2.] ! } ! } ! ! label_cable { ! defaults {width 8} ! draw { ! $p create line 0 0 0 0 -tags $tags -fill green -arrow last -width 8 ! } ! redraw { ! $p coords $item $x $y $xx $yy ! } ! control { ! puts "mouseie" } } *************** *** 19,25 **** 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 { --- 81,92 ---- box txt } + defaults { + ins 1 + outs 1 + msg msg + } 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 { *************** *** 36,52 **** } 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 } --- 103,121 ---- } defaults { min 1 max 69 + ins 0 + outs 0 } draw { ! $p create rect 0 0 0 0 -tags [concat $tags box] -fill $color ! $p create rect 0 0 0 0 -tags [concat $tags pos] -fill green -width 0 } 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]} ! h {set coords [concat [expr $x + ($xx - $x) * [dict get $_($t) $id v]] $y 3 [expr $yy - $y]]}} $p coords $pos $coords } *************** *** 57,60 **** --- 126,133 ---- tl tlr tf tfr r w } + defaults { + ins 0 + outs 0 + } draw { snack:::sound s$id