pd/src desire.tk,1.1.2.308,1.1.2.309 - Pd-cvs

10 Aug 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8032
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
basic zooming works now, still need some tweaking.....
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.308
retrieving revision 1.1.2.309
diff -C2 -d -r1.1.2.308 -r1.1.2.309
*** desire.tk	9 Aug 2006 14:43:45 -0000	1.1.2.308
--- desire.tk	10 Aug 2006 01:38:24 -0000	1.1.2.309
***************
*** 187,191 ****
  # but really, we should look at "man 3tcl trace" instead.
! class new Variable {Observable Thing}
def Variable init   {value} {super; set @value $value; $self changed}
--- 187,191 ----
  # but really, we should look at "man 3tcl trace" instead.
! class_new Variable {Observable Thing}
def Variable init   {value} {super; set @value $value; $self changed}
***************
*** 826,829 ****
--- 826,830 ----
  #-----------------------------------------------------------------------------------#
  set font(size) 12
+ set font(str2) "-*-courier-medium--normal--%d-*"
  set font(str) [format -*-courier-medium--normal--%d-* $font(size)]
  set font(width)  [font measure $font(str) W]
***************
*** 924,932 ****
def* View item {suffix type coords args} {
    set c .$@canvas.c
    set ss $self$suffix
    if {![llength [$c gettags $ss]]} {
    	eval  [concat [list $c create $type $coords  -tags "$ss $self"] $args]
- 		#eval [concat [list $c create $type $coords  -tags $ss] $args]
    } {
    	eval [concat [list $c itemconfigure $ss] $args]
--- 925,956 ----
def* View item {suffix type coords args} {
+ 	global font
    set c .$@canvas.c
    set ss $self$suffix
+ 	
+ 	if {$suffix != "WIRE"} {
+ 	for {set i 0} {$i < [llength $coords]} {incr i} {
+ 		set val [expr [lindex $coords $i]*$_($@canvas:scale)]
+ 		set coords [lreplace $coords $i $i $val]
+ 	}
+ 	}
+ 	
+ 	
+ 	#if {$suffix != "WIRE"} {
+ 	set find [lsearch $args "-width"]
+ 	if {$find >= 0} {
+ 	set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $_($@canvas:scale)]]
+ 	set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
+ 	}
+ 	#}
+ 	
+ 	if {$type == "text"} {
+ 		set find [lsearch $args "-font"]
+ 		set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
+ 		set args [lreplace $args [expr $find + 1] [expr $find + 1] [format $font(str2) $new_size]]
+ 	}
+ 	
    if {![llength [$c gettags $ss]]} {
    	eval  [concat [list $c create $type $coords  -tags "$ss $self"] $args]
    } {
    	eval [concat [list $c itemconfigure $ss] $args]
***************
*** 964,967 ****
--- 988,994 ----
    set cy $@y1
    return [list $cx $cy]
+ 	puts "cx --> $cx || cy --> $cy"
+ 	#puts "[expr $cx * $_($@canvas:scale)] ||| [expr $cy * $_($@canvas:scale)]"
+ 	#return [list [expr $cx * $_($@canvas:scale)] [expr $cy * $_($@canvas:scale)]]
  }
***************
*** 1187,1190 ****
--- 1214,1218 ----
      set @keynav_next 0
      set @shift_wires {}
+     set @scale 1
  }
***************
*** 1433,1445 ****
      set c .$@canvas.c
      for {set i 0} {$i<$n} {incr i} {
!         set onset [expr $x1 + ($xs-[look iowidth]) * $i / $nplus]
!         set points [list [expr $onset] $y [expr $onset+[look iowidth]] [expr $y+1]]
! 	# will update this code when proc item deals with mult.tags
! 	if {[llength [$c gettags $self$which$i]] != 0} {
!             $c coords ${self}$which$i $points
!         } {
!             $c create rectangle $points -tags "$self$which $self$which$i $self" \
! 		-outline [switch $which { i {concat [look inletfg]} o {concat [look outletfg]}}]
!         }
      }
  }
--- 1461,1477 ----
      set c .$@canvas.c
      for {set i 0} {$i<$n} {incr i} {
!         set onset [expr $x1 + ($xs-([look iowidth]*$_($@canvas:scale))) * $i / $nplus]
!         set points [list [expr $onset] [expr $y-1] [expr $onset+([look iowidth]*$_($@canvas:scale))] [expr $y+(1*$_($@canvas:scale))]]
! 	#will update this code when proc item deals with mult.tags
! 	#if {[llength [$c gettags $self$which$i]] != 0} {
!         #    $c coords ${self}$which$i $points
!         #} {
!         #    $c create rectangle $points -tags "$self$which $self$which$i $self" \
! 	#	-outline [switch $which { i {concat [look inletfg]} o {concat [look outletfg]}}]
!         #}
! 	
! 	switch $which { i {set color [look inletfg]} o {set color [look outletfg]}}
! 	$self item $which$i rectangle $points -outline $color -fill $color -tags "$self$which $self$which$i $self"
! 	 
      }
  }
***************
*** 1493,1497 ****
    set t .$@canvas.c.${self}text
    if {[info exists @isnew]} {set @isnew 0}
- 	# set propose .$@canvas.c.${self}propose ;# label completion
    set @edit 1
    set @tab_repeats 0 
--- 1525,1528 ----
***************
*** 1499,1512 ****
    set @selected? 1
    .$@canvas.c delete ${self}TEXT
- 	# set @oldtext $@text
    $self update_size
- 	# $self changed
- 	# text $propose -height 1 -width [expr [string length $@text]+1] -relief flat \
- 	#	-bg $look(objectbg) -borderwidth 0 -highlightthickness 0\
- 	#	-font $font(str) -fg red ;# label completion
    bind Text <Tab> "$self tab; continue"
    text $t -height 1 -width [expr [string length $@text]+1] -relief flat \
    	-bg [.$@canvas.c itemcget ${self}BASE -fill] -borderwidth 0 -highlightthickness 0\
! 		-font $font(str) -fg [look objectfg]
    bind $t <Key>            "$self key %W %x %y %K %A 0"
    bind $t <Control-Return> "$self key %W %x %y 10 %A 0"
--- 1530,1540 ----
    set @selected? 1
    .$@canvas.c delete ${self}TEXT
    $self update_size
    bind Text <Tab> "$self tab; continue"
+ 	set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
+ 	set font_str [format $font(str2) $new_size]
    text $t -height 1 -width [expr [string length $@text]+1] -relief flat \
    	-bg [.$@canvas.c itemcget ${self}BASE -fill] -borderwidth 0 -highlightthickness 0\
! 		-font $font_str -fg [look objectfg]
    bind $t <Key>            "$self key %W %x %y %K %A 0"
    bind $t <Control-Return> "$self key %W %x %y 10 %A 0"
***************
*** 1521,1526 ****
    #	-window $propose -anchor nw -tags "${self}propose $self" -height $font(height)
    #---------------------------------------
! 	.$@canvas.c create window [expr $cx+2] [expr $cy+2] \
! 		-window $t -anchor nw -tags "${self}text $self"
    #$self draw
    $t configure -pady 0 -padx 1
--- 1549,1558 ----
    #	-window $propose -anchor nw -tags "${self}propose $self" -height $font(height)
    #---------------------------------------
! 	#.$@canvas.c create window [expr $cx+2] [expr $cy+2] \
! 	#	-window $t -anchor nw -tags "${self}text $self"
! 	
! 	$self item text window [list [expr $cx+2] [expr $cy+2]] -window $t -anchor nw -tags "${self}text $self"
! 	
! 	
    #$self draw
    $t configure -pady 0 -padx 1
***************
*** 1572,1581 ****
    global font
    set textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! 	set topwidth    [expr (2* $@ninlets-1) * [look iowidth]]
! 	set bottomwidth [expr (2*$@noutlets-1) * [look iowidth]]
    set @xs [max [look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
    set @ys [expr $font(pady)+$font(height)]
  }
#-----------------------------------------------------------------------------------
--- 1604,1629 ----
    global font
    set textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! 	set topwidth    [expr (2* $@ninlets-1) * ([look iowidth]*$_($@canvas:scale))]
! 	set bottomwidth [expr (2*$@noutlets-1) * ([look iowidth]*$_($@canvas:scale))]
    set @xs [max [look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
    set @ys [expr $font(pady)+$font(height)]
  }
+ def TextBox update_size2 {} {
+ 	global font
+ 	set scale $_($@canvas:scale)
+ 	set font_width [expr $font(width) * $scale]
+ 	#set font_padx [expr $font(padx) * $scale]
+ 	#set font_pady [expr $font(pady) * $scale]
+ 	set font_padx $font(padx)
+ 	set font_pady $font(pady)
+ 	set font_height [expr $font(height) * $scale]
+ 	set textwidth [expr $font_padx+$font_width*([string length $@text]+$@edit)]
+ 	set topwidth    [expr (2* $@ninlets-1) * [expr [look iowidth]*$scale]]
+ 	set bottomwidth [expr (2*$@noutlets-1) * [expr [look iowidth]*$scale]]
+ 	set @xs [max [expr [look minobjwidth]*$scale] [max $bottomwidth [max $topwidth $textwidth]]]
+ 	set @ys [expr ($font_pady+$font_height)]
+ }
+ 
  #-----------------------------------------------------------------------------------
***************
*** 1605,1611 ****
    set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
    set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
! 	$self item BASE  rectangle $xya -fill [look objectbg]
! 	$self item BASE1 line      $xyb -fill [look objectframe1]
! 	$self item BASE2 line      $xyc -fill [look objectframe2]
  }
--- 1653,1659 ----
    set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
    set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
! 	$self item BASE  rectangle $xya -fill [look objectbg] -width 1
! 	$self item BASE1 line      $xyb -fill [look objectframe1] -width 1
! 	$self item BASE2 line      $xyc -fill [look objectframe2] -width 1
  }
***************
*** 1804,1811 ****
  def View move {dx dy} {
    mset {x y} [$self xy]
! 	set @x1 [expr $@x1+$dx]
! 	set @y1 [expr $@y1+$dy]
! 	mset {u v} [$self xy]
! 	.$@canvas.c move $self [expr $u-$x] [expr $v-$y]
    $self draw_wires
  }
--- 1852,1862 ----
  def View move {dx dy} {
    mset {x y} [$self xy]
! 	set dx2 [expr $dx / $_($@canvas:scale)]
! 	set dy2 [expr $dy / $_($@canvas:scale)]
! 	set @x1 [expr $@x1+$dx2]
! 	set @y1 [expr $@y1+$dy2]
! 	#mset {u v} [$self xy]
! 	#.$@canvas.c move $self [expr $u-$x] [expr $v-$y]
! 	.$@canvas.c move $self $dx $dy
    $self draw_wires
  }
***************
*** 1813,1823 ****
  def View draw_wires {} {foreach wire $@wires {$wire draw}}
- # kill this please
- def* Canvas undomove {objs} {
- 	foreach obj $objs {
- 		pd .$self object_moveto !$obj $_($obj:orig_x) $_($obj:orig_y)
- 	}
- }
- 
  def* View set_orig_xy {x y} {
    set @orig_x $x
--- 1864,1867 ----
***************
*** 1858,1862 ****
      switch $@action {
        move {
-         puts "selection:::: $@selection"
          mset {ox oy} $oldpos
          foreach obj $@selection {$obj move [expr $x-$ox] [expr $y-$oy]}
--- 1902,1905 ----
***************
*** 1886,1891 ****
    if {$@editmode && [llength [$id bbox]]} {
      mset {x1 y1 x2 y2} [$id bbox]
! 	  #post %s "y=$y y1=$y1 y2=$y2"
! 	  if {$y<$y1+2} {
    	set port [$id hilite_io i $x $y]
    	if {$port==""} return
--- 1929,1938 ----
    if {$@editmode && [llength [$id bbox]]} {
      mset {x1 y1 x2 y2} [$id bbox]
! 	  set x1 [expr $x1 * $@scale]
! 	  set y1 [expr $y1 * $@scale]
! 	  set x2 [expr $x2 * $@scale]
! 	  set y2 [expr $y2 * $@scale]
! 	  set var [expr 2*$@scale]
! 	  if {$y<[expr $y1+2]} {
    	set port [$id hilite_io i $x $y]
    	if {$port==""} return
***************
*** 1894,1898 ****
    	return
      }
! 	  if {$y>=$y2-2} {
    	set port [$id hilite_io o $x $y]
    	if {$port==""} return
--- 1941,1945 ----
    	return
      }
! 	  if {$y>=[expr $y2-2]} {
    	set port [$id hilite_io o $x $y]
    	if {$port==""} return
***************
*** 2211,2214 ****
--- 2258,2265 ----
         # handles the dash wire drawing
         mset {x1 y1 x2 y2} [$id bbox]
+ 	     set x1 [expr $x1 * $@scale]
+ 	     set y1 [expr $y1 * $@scale]
+ 	     set x2 [expr $x2 * $@scale]
+ 	     set y2 [expr $y2 * $@scale]
         set outs 0; set outs [$id noutlets]
         set ins 0; set ins [$id ninlets]
***************
*** 2375,2381 ****
        	# if making wire without shift key (delete the dash line)
          if {!$f} {$c delete lnew}
!        	mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
    if {$id != ""} {
         	mset {x1 y1 x2 y2} [$id bbox]
         	set ins 0; set ins [$id ninlets]
         	if {$y<$y1+6 && $ins} {
--- 2426,2442 ----
        	# if making wire without shift key (delete the dash line)
          if {!$f} {$c delete lnew}
! 	set x1 [expr $x/$_($@canvas:scale)]
! 	set y1 [expr $y/$_($@canvas:scale)]
! 	set x2 [expr $x1 - 1]
! 	set y2 [expr $y1 - 1]
!        	#mset {type id} [$@canvas identify_target $x1 $y1 $x2 $y2s "unclick"]
! 	mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
! 	puts "type:: $type ||| id:: $id"
    if {$id != ""} {
         	mset {x1 y1 x2 y2} [$id bbox]
+ 	set x1 [expr $x1 * $@scale]
+ 	set y1 [expr $y1 * $@scale]
+ 	set x2 [expr $x2 * $@scale]
+ 	set y2 [expr $y2 * $@scale]
         	set ins 0; set ins [$id ninlets]
         	if {$y<$y1+6 && $ins} {
***************
*** 2594,2621 ****
  def* Canvas decr_fontsize {} {$self zoom "out"}
  def* Canvas zoom {mode} {
- 
- 
- 	#puts "coords:::: $coords"
- 	#for {set i 0} {$i < [llength $coords]} {incr i} {
- 	#	set val [expr [lindex $coords $i]*2]
- 	#	puts "[lindex $coords $i] ::: $val"
- 	#	set coords [lreplace $coords $i $i $val]
- 	#}
- 	#puts "coords::::: $coords"
- 
    global font
    switch $mode {
    in {
! 		incr font(size) 4 
! 		set font(str) [format -*-courier-medium--normal--%d-* $font(size)]
! 		set font(width)  [font measure $font(str) W]
! 		set font(height) [font metrics $font(str) -linespace]
    	$self redraw
    }
    out {
! 		incr font(size) -4 
! 		set font(str) [format -*-courier-medium--normal--%d-* $font(size)]
! 		set font(width)  [font measure $font(str) W]
! 		set font(height) [font metrics $font(str) -linespace]
    	$self redraw
    }
--- 2655,2675 ----
  def* Canvas decr_fontsize {} {$self zoom "out"}
  def* Canvas zoom {mode} {
    global font
    switch $mode {
    in {
! 		set @scale [expr $@scale + 0.5]
! 		#foreach object $@children {
! 		#mset {x1 y1 x2 y2} [$object bbox]
! 		#pd .$self object_moveto !$object [expr $x1*$@scale] [expr $y1*$@scale]
! 		#}
    	$self redraw
    }
    out {
! 		
! 		set @scale [expr $@scale - 0.5]
! 		#foreach object $@children {
! 		#mset {x1 y1 x2 y2} [$object bbox]
! 		#pd .$self object_moveto !$object [expr $x1*$@scale] [expr $y1*$@scale]
! 		#}
    	$self redraw
    }
***************
*** 2739,2742 ****
--- 2793,2806 ----
    mset {x y} [$self xy]
    list $x $y [expr $x+$@xs] [expr $y+$@ys]
+ 	
+ 	#mset {x y} [$self xy]
+ 	#set xs [expr $@xs * $_($@canvas:scale)]
+ 	#set ys [expr $@ys * $_($@canvas:scale)]
+ 	#set x1 [expr $x * $_($@canvas:scale)]
+ 	#set y1 [expr $y * $_($@canvas:scale)]
+ 	#set x2 [expr $x1 + $xs]
+ 	#set y2 [expr $y1 + $ys]
+ 	#puts " x1==$x1 y1==$y1 x2==$x2 y2==$y2"
+ 	#list $x1 $y1 $x2 $y2
  }
***************
*** 2790,2793 ****
--- 2854,2859 ----
    set tag $self$type$n
    set area [.$@canvas.c bbox $self$type$n]
+ 	puts "tag -----------> $tag"
+ 	puts "area ----------> $area"
    set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
    set dist [expr abs($x - $center)]
***************
*** 3018,3021 ****
--- 3084,3088 ----
    if {$isnew} {$_class new_as $self}
    $self position= [lrange $mess 2 3]
+ 	$self canvas= $canvas(current)
    $self ninlets= $ninlets
    $self noutlets= $noutlets
***************
*** 3134,3138 ****
  }
! def* MessageBox draw_box {} {
    mset {x1 y1} [$self xy]
    set x2 [expr $x1+$@xs]
--- 3201,3205 ----
  }
! def MessageBox draw_box {} {
    mset {x1 y1} [$self xy]
    set x2 [expr $x1+$@xs]
***************
*** 3141,3145 ****
    	[expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
    if {[$self selected?]} {set frcol [look selectframe]} {set frcol [look objectframe3]}
! 	$self item BASE polygon $points -fill [look objectbg] -outline $frcol
  }
--- 3208,3212 ----
    	[expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
    if {[$self selected?]} {set frcol [look selectframe]} {set frcol [look objectframe3]}
! 	$self item BASE polygon $points -fill [look objectbg] -outline $frcol -width 1
  }