[PD-cvs] pd/src pd_base.tk, 1.1.2.4, 1.1.2.5 pd_objects.tk, 1.1.2.7, 1.1.2.8 - Pd-cvs

12 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28817
Modified Files:
      Tag: devel_0_39
    pd_base.tk pd_objects.tk 
Log Message:
eyah
Index: pd_objects.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/pd_objects.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_objects.tk	6 Sep 2005 22:58:52 -0000	1.1.2.7
--- pd_objects.tk	12 Sep 2005 13:34:46 -0000	1.1.2.8
***************
*** 33,40 ****
        } {set photo ""}
        $p itemconfigure $img -image $photo
! 	    $p itemconfigure $box -fill $gcolor -outline $color -width [expr $selected + 1]
    }
      }
- 
      subwin {
    tags {
--- 33,67 ----
        } {set photo ""}
        $p itemconfigure $img -image $photo
! 	    $p itemconfigure $box -fill $color -outline [color [lighten $rgb 0.3]] -width [expr $selected + 1]
! 	}
!     }
!     gridlines {
! 	defaults {
! 	    class gridlines
! 	}
! 	redraw {
! 	    foreach items $item {$p delete $items}
! 	    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 / $${xy}q]
! 		if {$nSlices > [set ${xy}m]} {set factor [expr int($nSlices / ($${xy}m + 0.0) + 1)]} else {
! 		    set factor [expr 1. / (int(1./($nSlices / ($${xy}m + 0.0) + 0.0)) + 0.0)]
! 		}
! 		set increment [expr $${xy}q * $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 $atags]
! 		    $p lower [$p create line $coords -fill $color -stipple gray50 -tags $atags]
! 		}
! 	    }
    }
      }
      subwin {
    tags {
***************
*** 42,45 ****
--- 69,73 ----
    }
    defaults {
+ 	    x 32 y 24
        ins 0
        outs 0
***************
*** 130,134 ****
    }
    defaults {
! 	    x 6.4 y 1.2
        ins 1
        outs 1
--- 158,162 ----
    }
    defaults {
! 	    x 2 y 2
        ins 1
        outs 1
***************
*** 141,145 ****
    redraw {
        $p coords $txt $x $y
! 	    $p itemconfigure $box -fill $color
        $p itemconfigure $txt -font [list {bitstream vera sans} [expr int($sy)]] -text $msg
        lassign [$p bbox $txt] x y xx yy
--- 169,173 ----
    redraw {
        $p coords $txt $x $y
! 	    $p itemconfigure $box -fill $color	  
        $p itemconfigure $txt -font [list {bitstream vera sans} [expr int($sy)]] -text $msg
        lassign [$p bbox $txt] x y xx yy
Index: pd_base.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/pd_base.tk,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -C2 -d -r1.1.2.4 -r1.1.2.5
*** pd_base.tk	11 Sep 2005 11:48:37 -0000	1.1.2.4
--- pd_base.tk	12 Sep 2005 13:34:46 -0000	1.1.2.5
***************
*** 5,15 ****
set todo {
!     io
!     cables
      scale selection
      gridlines -> objects
!     group attr
!     markers/snap/quant
!     regions / rects (combine?)
  }
--- 5,13 ----
set todo {
!     io/cables
      scale selection
      gridlines -> objects
!     $p and $t are probably redundant (combine)
!     port some complex widgets to test out feasability of this structure
  }
***************
*** 29,33 ****
# omg the colours!!
!     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}
--- 27,31 ----
# omg the colours!!
!     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}
***************
*** 58,90 ****
    	$p coords sel $($t:fx) $($t:fy) $x $y}}}
!     proc item_new {p t id d} {
    variable ""
- 	#object definition dictionary (in pd_objects.tk or ~/.pd/*.tk)
    variable obj
! 	#generate an ID if one wasn't provided
! 	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]
! 
! 	#figure out size/position
! 	set x [tr $p $t x i $($t:hx)]; set y [tr $p $t y i $($t:hy)]
! 	set sx 0; set sy 0
! 	if {[dict exists $obj $type defaults x]} {set sx [dict get $obj $type defaults x]}
! 	if {[dict exists $obj $type defaults y]} {set sy [dict get $obj $type defaults y]}
! 	# 1 global defaults 2 object defaults 3 instance defaults
! 	set defaults [dict create x $x xx [expr $x + $sx] y $y yy [expr $y + $sy] color {128 128 128}]
! 	if {[dict exists $obj $type defaults]} {set defaults [dict merge $defaults [dict get $obj $type defaults]]}
! 	if {$d ne ""} {set defaults [dict merge $defaults $d]}
!     	update $p $t $id abs $defaults 0
! 	
! 	#draw the item
    item_draw $p $t $id
!     }
proc item_draw {p t is} {
--- 56,75 ----
    	$p coords sel $($t:fx) $($t:fy) $x $y}}}
!     proc item_new {p t a} {
    variable ""
    variable obj
+ 	foreach local [dict keys $a] {set $local [dict get $a $local]}
+ 	if {[dict exists $obj $type defaults]} {set da [dict get $obj $type defaults]} {set da {}}
+     	if {$id eq "-"} {
+ 	    if {[dict keys $($t)] eq ""} {set id 0} else {set id -1
+ 		while true {if {[lsearch [dict keys $($t)] [incr id]] == -1} {break}}}}
! 	if {![info exists x]} {set x 13; set y 31}
! 	if {[dict exists $da x]} {set sx [dict get $da x]} {set sx 0}
! 	if {[dict exists $da y]} {set sy [dict get $da y]} {set sy 0}
!     	update $p $t $id abs [dict merge [dict merge [dict merge {class item color {128 128 128}} $da] [dict remove $a id]] [dict create x $x xx [expr $x + $sx] y $y yy [expr $y + $sy]]] 0
    item_draw $p $t $id
! 	return $id}
proc item_draw {p t is} {
***************
*** 94,103 ****
    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 init]
        redraw $p $t $id
    }
--- 79,89 ----
    foreach id $is {
        set type [dict get $($t) $id type]
! 	    if {[dict exists $obj $type init]} {
! 		foreach local [dict keys [dict get $($t) $id]] {
! 		    set $local [dict get $($t) $id $local]}
! 		set tags [list $class i$id $id]
! 		set rgb $color; set color [color $rgb]
! 		eval [dict get $obj $type init]
! 	    }
        redraw $p $t $id
    }
***************
*** 118,122 ****
        set ($t:sel) {}
        item_info $p $t ""
! 	    send "delete $item"
    }
      }
--- 104,108 ----
        set ($t:sel) {}
        item_info $p $t ""
! 	    send "delete $p:$item"
    }
      }
***************
*** 132,136 ****
    	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}
--- 118,122 ----
    	rel {dict set ($t) $item $a [expr {[dict get $($t) $item $a] + [dict get $u $a]}]}
        }
! 	    send [concat update $p:$item $a [dict get $($t) $item $a]]
    }
    if {$redraw == 1} {redraw $p $t $item}
***************
*** 147,151 ****
    	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]}
--- 133,137 ----
    	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 {set ($t:ci) [item_new $p $t [dict create type rect id - 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]}
***************
*** 165,178 ****
        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]} {
--- 151,164 ----
        if {[expr $y > $yy]} {lassign "$y $yy" yy y}
        set sx [expr $xx - $x]; set sy [expr $yy - $y]
! 	    if {[lsearch $($t:sel) $id] >= 0} {
! 		set rgb {233 233 233}
    	set color $($t:sc)
    	set selected 1
        } else {
! 		set rgb [dict get $($t) $id color]
! 		set color [color $rgb]
    	set selected 0}
! 	    set atags [concat $class i$id $id]
! 	    set tags [concat $class && i$id && $id]
        set item [$p find withtag $tags]
        if {[dict exists $obj $type tags]} {
***************
*** 228,232 ****
    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
      }
--- 214,218 ----
    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 -unique $clean]
    return $clean
      }
***************
*** 234,238 ****
      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
--- 220,223 ----
***************
*** 296,303 ****
      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
--- 281,288 ----
      proc togglesel {p t d} {
    variable ""
! 	if {[lsearch $($t:sel) $d] < 0} {
        set ($t:sel) [concat $($t:sel) $d]
    } else {
! 	    set ($t:sel) [lsearch -inline -not -all $($t:sel) $d]
    }
    redraw $p $t $d
***************
*** 308,312 ****
    set os $($t:sel)
    set ($t:sel) $ns
! 	redraw $p $t  [lsort -unique -integer [concat $os $ns]]
    item_info $p $t $ns
      }
--- 293,297 ----
    set os $($t:sel)
    set ($t:sel) $ns
! 	redraw $p $t  [lsort -unique [concat $os $ns]]
    item_info $p $t $ns
      }
***************
*** 331,340 ****
        set n 0
        foreach k [concat id $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
--- 316,325 ----
        set n 0
        foreach k [concat id $keys] {
! 		text .i$t.$k -wrap none -width 8  -height 1 -bd 0  -font {{Bitstream Vera Sans} 11}
    	.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 -font  {{Bitstream Vera Sans} 10}
    	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
***************
*** 406,419 ****
    	$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]]
--- 391,397 ----
    	$me add command -label $a -command "::pd::clip $p $t $a"}
$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 {id - type $type x [tr $p $t x i $x] y [tr $p $t y i $y]}"}
$m add cascade -label "view" -menu [set mv [menu $m.view -tearoff no]]
***************
*** 489,493 ****
    }
    redraw $p $t all
- 	gridlines $p $t
      }
--- 467,470 ----
***************
*** 518,522 ****
    	set pasted {}
    	foreach item [dict keys $($t:c)] {
! 		    item_new $p $t - [dict get $($t:c) $item]
    	}
        }
--- 495,499 ----
    	set pasted {}
    	foreach item [dict keys $($t:c)] {
! 		    item_new $p $t [dict merge [dict get $($t:c) $item] {id -}]
    	}
        }
***************
*** 531,554 ****
      }
-    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 ""
--- 508,511 ----
***************
*** 565,570 ****
    set ($t:mode) $m(mode)
    $p configure -bg $m(bg)
! 	set ($t:ln) $m(ln)
! 	gridlines $p $t
      }
--- 522,528 ----
    set ($t:mode) $m(mode)
    $p configure -bg $m(bg)
! 
! 	update $p $t grid abs [dict create ln $m(ln)] 1
! 	redraw $p $t grid
      }
***************
*** 595,599 ****
        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 "/"]]
    }
      }
--- 553,557 ----
        set x [tr $p $t x i $x] 
        set y [tr $p $t y i $y] 
! 	    item_new $p $t [dict create type sound id - g 1 v 1 x $x y $y xx $x yy $y filename [regsub -- {^file:[/]+} $d "/"]]
    }
      }
***************
*** 602,612 ****
    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 qx 10 qy 10 mx 15 my 15} $opts]
    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"
--- 560,570 ----
    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 ($t:${xy}${ab}o) [dict get $opts ${xy}${ab}]}}
! 	foreach a {sc ln mode xa xb ya yb xq yq xm ym 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::redraw $p $t all"
        bind $p <Enter> "focus $p"
        bind $p <Key> "::pd::key $p $t %k 1"
***************
*** 636,674 ****
    	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]
! 	    }}}
! 
!  #    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]
--- 594,610 ----
    	set i -1; set sel {}
    	foreach a {i sel} {set ($t:$a) [set $a]}
        }
    }
! 	foreach a {ln xa xb ya yb xq yq xm ym} {set $a [dict get $opts $a]}
! 	item_new $p $t [dict create type gridlines id grid xa $xa xb $xb ya $ya yb $yb xq $xq yq $yq xm $xm ym $ym]
    item_draw $p $t all
      }
!     variable pd_send
!     set pd_send -1
!     proc connect {} {
! 	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]
***************
*** 685,693 ****
      }
      proc send {msg} {
! # 	variable pd_send
! # 	if {$pd_send ne -1} {
! # 	    puts $pd_send [concat $msg ;]
! # 	    flush $pd_send
! # 	}
      }
--- 621,630 ----
      }
      proc send {msg} {
! #	puts [concat s: $msg]
!  	variable pd_send
!  	if {$pd_send ne -1} {
!  	    puts $pd_send [concat $msg ;]
!  	    flush $pd_send
!  	}
      }