pd/src u_main.tk,1.1.1.4.2.7.4.37,1.1.1.4.2.7.4.38 - Pd-cvs

10 Apr 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
  }