[PD-cvs] pd/src u_main.tk,1.1.1.4.2.7.4.37,1.1.1.4.2.7.4.38
Mathieu Bouchard
matju at users.sourceforge.net
Sat Apr 10 21:02:53 CEST 2004
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30432
Modified Files:
Tag: impd_0_37
u_main.tk
Log Message:
...
Index: u_main.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v
retrieving revision 1.1.1.4.2.7.4.37
retrieving revision 1.1.1.4.2.7.4.38
diff -C2 -d -r1.1.1.4.2.7.4.37 -r1.1.1.4.2.7.4.38
*** u_main.tk 8 Apr 2004 10:48:12 -0000 1.1.1.4.2.7.4.37
--- u_main.tk 10 Apr 2004 19:02:49 -0000 1.1.1.4.2.7.4.38
***************
*** 30,33 ****
--- 30,41 ----
proc l+ {al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a+$b]}; return $r}
+ proc lreverse {list} {
+ set r {}
+ for {set i [expr [llength $list]-1]} {$i>=0} {incr i -1} {
+ lappend r [lindex $list $i]
+ }
+ return $r
+ }
+
# there are two palettes of 30 colours used in Pd
# when placed in a 3*10 grid, the difference is that
***************
*** 141,145 ****
proc pdtk_pd_dio {red} {
! .controls.dio configure -background red -activebackground [if {$red==1} {list red} {list lightgrey}]
}
--- 149,154 ----
proc pdtk_pd_dio {red} {
! .controls.switches.dio configure -background red \
! -activebackground [if {$red==1} {list red} {list lightgrey}]
}
***************
*** 529,548 ****
}
proc stat_pos_update {self x y} {
set canvas $self.c
! set x [$canvas canvasx $x]
! set y [$canvas canvasy $y]
! $self.stat.pos configure -text "($x,$y)"
! set stack [$canvas find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]
! set tags [$canvas gettags [lindex $stack end]]
! if {[regexp {^([a-f0-9]{7})} $tags tag]} {
! global _
! if {[info exists _($tag:class)]} {set class $_($tag:class)} {set class unknown}
! $self.stat.what configure -text "$tag \[$class\] ($tags)"
! return
! }
! if {[regexp {^l([a-f0-9]{7})} $tags tag]} {
! $self.stat.what configure -text "$tag wire"
! return
}
$self.stat.what configure -text "... $tags"
--- 538,562 ----
}
+ #########
+
proc stat_pos_update {self x y} {
+ global _
set canvas $self.c
! set cx [$canvas canvasx $x]
! set cy [$canvas canvasy $y]
! $self.stat.pos configure -text "($cx,$cy)"
! set tags [$canvas gettags [lindex [$canvas find overlapping \
! [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]] end]]
! foreach {type id} [identify_target $canvas $cx $cy -1 -1 "click"] {}
! switch $type {
! object {
! if {[info exists _($id:class)]} {set class $_($id:class)} {set class unknown}
! $self.stat.what configure -text "$id \[$class\] ($tags)"
! return
! }
! wire {
! $self.stat.what configure -text "$id wire"
! return
! }
}
$self.stat.what configure -text "... $tags"
***************
*** 784,799 ****
proc identify_target {canvas cx cy b f label} {
! set stack [$canvas find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]
! set tags [$canvas gettags [lindex $stack end]]
#puts stderr "($label) $canvas $cx $cy $b $f : $tags "
! if {[regexp {^([a-f0-9]{7})} $tags tag]} {
! global _
! if {[info exists _($tag:class)]} {set class $_($tag:class)} {set class unknown}
! #puts stderr "(.....) $tag is a \[$class\] object"
! return [list "object" $tag]
}
! if {[regexp {^l([a-f0-9]{7})} $tags tag]} {
! #puts stderr "(.....) this is a wire"
! return [list "wire" $tag]
}
#puts stderr "(.....) nothing in particular"
--- 798,817 ----
proc identify_target {canvas cx cy b f label} {
! set stack [lreverse [$canvas find overlapping \
! [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]]
#puts stderr "($label) $canvas $cx $cy $b $f : $tags "
! foreach tag $stack {
! if {[regexp {^([a-f0-9]{7})} [$canvas gettags $tag] id]} {
! global _
! if {[info exists _($id:class)]} {set class $_($id:class)} {set class unknown}
! #puts stderr "(.....) $id is a \[$class\] object"
! return [list "object" $id]
! }
}
! foreach tag $stack {
! if {[regexp {^l([a-f0-9]{7})} [$canvas gettags $tag] id]} {
! #puts stderr "(.....) this is a wire"
! return [list "wire" $id]
! }
}
#puts stderr "(.....) nothing in particular"
***************
*** 806,819 ****
set cx [$canvas canvasx $x]
set cy [$canvas canvasy $y]
pd [canvastosym $canvas] mouse $cx $cy $b $f \;
! foreach {type tag} [identify_target $canvas $x $y $b $f "click"] {}
switch $type {
object {
! pd "$self click-on-object $tag $cx $cy $b $f;"
! if {$_($self:mode)=="edit" && [llength [$canvas bbox ${tag}BASE]]} {
! foreach {x1 y1 x2 y2} [$canvas bbox ${tag}BASE] {}
! if {abs($y2-1-$cy)<=3} {
! set out [expr int(($cx-$x1)*$_($tag:outlets)/($x2-$x1))]
! foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${tag}o${out}] {}
wire_draw lnew $canvas 1 $cx $cy $cx $cy
$canvas itemconfigure lnew -dash "4 4 4 4"
--- 824,841 ----
set cx [$canvas canvasx $x]
set cy [$canvas canvasy $y]
+ set edit 0; switch $_($self:mode) { edit { set edit 1 } }
pd [canvastosym $canvas] mouse $cx $cy $b $f \;
! foreach {type id} [identify_target $canvas $x $y $b $f "click"] {}
switch $type {
object {
! pd "$self click-on-object $id $cx $cy $b $f;"
! if {$edit && [llength [$canvas bbox ${id}BASE]]} {
! foreach {x1 y1 x2 y2} [$canvas bbox ${id}BASE] {}
! if {abs($y2-3-$cy)<=3} {
! set outs 0
! catch {set outs $_($id:outlets)}
! if {$outs==0} return
! set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
! foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${id}o${out}] {}
wire_draw lnew $canvas 1 $cx $cy $cx $cy
$canvas itemconfigure lnew -dash "4 4 4 4"
***************
*** 822,826 ****
}
wire {
! pd "[canvastosym $canvas] click-on-wire $tag $cx $cy $b $f;"
}
}
--- 844,848 ----
}
wire {
! pd "[canvastosym $canvas] click-on-wire $id $cx $cy $b $f;"
}
}
***************
*** 831,836 ****
--- 853,860 ----
proc pdtk_canvas_motion {canvas x y mods} {
global current_x current_y tooltip _ dehighlight look
+ set self [canvastosym $canvas]
set cx [$canvas canvasx $x]
set cy [$canvas canvasy $y]
+ set edit 0; switch $_($self:mode) { edit { set edit 1 } }
if {$tooltip(visible)} {
#puts "cx=$cx cy=$cy tooltip=($tooltip(mx),$tooltip(my),$tooltip(canvas),$tooltip(visible)"
***************
*** 844,862 ****
set current_y $cy
pd [canvastosym $canvas] motion $x $y $mods \;
! foreach {type tag} [identify_target $canvas $x $y -1 -1 "move "] {}
switch $type {
object {
! if {[llength [$canvas bbox ${tag}BASE]]} {
! foreach {x1 y1 x2 y2} [$canvas bbox ${tag}BASE] {}
! post "cx=$cx cy=$cy x1=$x1 y1=$y1 x2=$x2 y2=$y2"
! if {abs($y2-1-$cy)<=3} {
! set out [expr int(($cx-$x1)*$_($tag:outlets)/($x2-$x1))]
$canvas create rectangle \
! [l+ [$canvas coords ${tag}o${out}] {-4 -4 +4 +4}] \
! -outline $look(outletfg) -width 1 -tags ${tag}o${out}b
! set dehighlight "$canvas delete ${tag}o${out}b"
}
} {
! post "BASEless object?"
}
}
--- 868,889 ----
set current_y $cy
pd [canvastosym $canvas] motion $x $y $mods \;
! foreach {type id} [identify_target $canvas $x $y -1 -1 "move "] {}
switch $type {
object {
! if {$edit && [llength [$canvas bbox ${id}BASE]]} {
! foreach {x1 y1 x2 y2} [$canvas bbox ${id}BASE] {}
! #post "id=$id cx=$cx cy=$cy x1=$x1 y1=$y1 x2=$x2 y2=$y2"
! if {abs($y2-3-$cy)<=3} {
! set outs 0
! catch {set outs $_($id:outlets)}
! if {$outs==0} return
! set out [expr int(($cx-$x1)*$outs/($x2-$x1))]
$canvas create rectangle \
! [l+ [$canvas coords ${id}o${out}] {-4 -4 +4 +4}] \
! -outline $look(outletfg) -width 1 -tags ${id}o${out}b
! set dehighlight "$canvas delete ${id}o${out}b"
}
} {
! #post "BASEless object?"
}
}
***************
*** 876,880 ****
}
! proc pdtk_start_wire {canvas x y b f} {
# if (ob && (noutlet = obj_noutlets(ob)) && ypos >= y2-4) {} {return}
# width = x2-x1
--- 903,907 ----
}
! #proc pdtk_start_wire {canvas x y b f} {
# if (ob && (noutlet = obj_noutlets(ob)) && ypos >= y2-4) {} {return}
# width = x2-x1
***************
*** 891,895 ****
# } {canvas_setcursor(x, CURSOR_EDITMODE_CONNECT)}
# } {if (doit) goto nooutletafterall}
! }
set pdtk_canvas_mouseup(name) 0
--- 918,922 ----
# } {canvas_setcursor(x, CURSOR_EDITMODE_CONNECT)}
# } {if (doit) goto nooutletafterall}
! #}
set pdtk_canvas_mouseup(name) 0
***************
*** 2097,2107 ****
proc post_to_gui {x} {
global cmdline console_scrollback_count
! set oldpos [lindex [.log.2 get] 1]
! .log.1 insert end $x
! incr console_scrollback_count
! if {$console_scrollback_count >= $cmdline(console)} {
! .log.1 delete 1.0 2.0
}
- if {$oldpos > 0.9999} {.log.1 see end}
}
--- 2124,2138 ----
proc post_to_gui {x} {
global cmdline console_scrollback_count
! if {[catch {
! set oldpos [lindex [.log.2 get] 1]
! .log.1 insert end $x
! incr console_scrollback_count
! if {$console_scrollback_count >= $cmdline(console)} {
! .log.1 delete 1.0 2.0
! }
! if {$oldpos > 0.9999} {.log.1 see end}
! }]} {
! puts -nonewline stderr $x
}
}
***************
*** 2517,2523 ****
# woops, self is for future use
proc show_canvas_tooltip {self canvas x y text} {
set border 4
set x [expr $x+$border+4]
- hide_canvas_tooltip $canvas
$canvas create text $x $y -text $text -anchor w -tags tooltip_fg
foreach {x1 y1 x2 y2} [$canvas bbox tooltip_fg] {}
--- 2548,2556 ----
# woops, self is for future use
proc show_canvas_tooltip {self canvas x y text} {
+ global current_x current_y tooltip
+ if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
+ hide_canvas_tooltip $canvas
set border 4
set x [expr $x+$border+4]
$canvas create text $x $y -text $text -anchor w -tags tooltip_fg
foreach {x1 y1 x2 y2} [$canvas bbox tooltip_fg] {}
***************
*** 2529,2539 ****
-fill "#ffffcc" -outline "#000000" -tags tooltip_bg
$canvas lower tooltip_bg tooltip_fg
- global current_x current_y
- global tooltip
set tooltip(mx) $current_x
set tooltip(my) $current_y
set tooltip(canvas) $canvas
set tooltip(visible) 1
! set tooltop(text) $text
}
--- 2562,2570 ----
-fill "#ffffcc" -outline "#000000" -tags tooltip_bg
$canvas lower tooltip_bg tooltip_fg
set tooltip(mx) $current_x
set tooltip(my) $current_y
set tooltip(canvas) $canvas
set tooltip(visible) 1
! set tooltip(text) $text
}
More information about the Pd-cvs
mailing list