[PD-cvs] pd/src desire.tk,1.1.2.328,1.1.2.329
Mathieu Bouchard
matju at users.sourceforge.net
Mon Aug 14 03:03:51 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21247
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
new zoom code, and introducing action classes (first of which, FutureWire)
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.328
retrieving revision 1.1.2.329
diff -C2 -d -r1.1.2.328 -r1.1.2.329
*** desire.tk 13 Aug 2006 22:11:19 -0000 1.1.2.328
--- desire.tk 14 Aug 2006 01:03:48 -0000 1.1.2.329
***************
*** 65,69 ****
proc mset {vars list} {uplevel 1 "foreach {$vars} {$list} {}"}
! # add or substract one value to a list
proc l+ { al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a + $b]}; return $r}
proc l- { al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a - $b]}; return $r}
--- 65,69 ----
proc mset {vars list} {uplevel 1 "foreach {$vars} {$list} {}"}
! # add or substract two lists
proc l+ { al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a + $b]}; return $r}
proc l- { al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a - $b]}; return $r}
***************
*** 71,75 ****
# like l+ or l- but for any infix supported by expr
proc lzip {op al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a $op $b]}; return $r}
! proc lmap {op al } {set r {}; foreach a $al b $bl {lappend r [expr $a $op ]}; return $r}
# halve a list
--- 71,77 ----
# like l+ or l- but for any infix supported by expr
proc lzip {op al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a $op $b]}; return $r}
!
! # do an operation between all elements of a list and a second argument
! proc lmap {op al b } {set r {}; foreach a $al {lappend r [expr $a $op $b]}; return $r}
# halve a list
***************
*** 826,830 ****
def Menuable populate_menu {menu list} {
global key
! set menu $@menubar.$menu
foreach name $list {
if {$name == ""} {$menu add separator; continue}
--- 828,832 ----
def Menuable populate_menu {menu list} {
global key
! if {[string index $menu 0] != "."} {set menu $@menubar.$menu}
foreach name $list {
if {$name == ""} {$menu add separator; continue}
***************
*** 1013,1028 ****
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]
! }
! }
!
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]
}
--- 1015,1024 ----
set c .$@canvas.c
set ss $self$suffix
! set scale [$@canvas scale]
! set coords [lmap * $coords $scale]
set find [lsearch $args "-width"]
if {$find >= 0} {
! set new_width [format %.0f [expr [lindex $args [expr $find+1]] * $scale]]
set args [lreplace $args [expr $find + 1] [expr $find + 1] $new_width]
}
***************
*** 1031,1035 ****
set find [lsearch $args "-font"]
if {$find >= 0} {
! set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
set s [format $font(str2) $new_size]
set args [lreplace $args [expr $find + 1] [expr $find + 1] $s]
--- 1027,1031 ----
set find [lsearch $args "-font"]
if {$find >= 0} {
! set new_size [format %.0f [expr $font(size)*$scale]]
set s [format $font(str2) $new_size]
set args [lreplace $args [expr $find + 1] [expr $find + 1] $s]
***************
*** 1052,1063 ****
def* View draw {} {}
! def* View delete {} {$self erase; $self _delete; io_erase $self}
def* View erase {} {$self item_delete}
- def* View click {args} {}
- #def* View clickedit {args} {}
- def* View unclick {args} {}
- def* View unclickedit {args} {}
- def View motion {args} {}
- def View motionedit {args} {}
def View selected? {} {return $@selected?}
def View selected?= {x} {set @selected? $x; $self changed}
--- 1048,1054 ----
def* View draw {} {}
! def View delete {} {$self _delete}
! def* View _delete {} {$self erase; io_erase $self}
def* View erase {} {$self item_delete}
def View selected? {} {return $@selected?}
def View selected?= {x} {set @selected? $x; $self changed}
***************
*** 1243,1246 ****
--- 1234,1238 ----
$self new_menubar
$self new_binds
+ set @scale 1.0 ;# must be a float, not int
set @action none
set @selection {}
***************
*** 1280,1284 ****
set @keynav_next 0
set @shift_wires {}
- set @scale 1
}
--- 1272,1275 ----
***************
*** 1385,1390 ****
$self bind <KeyRelease> keyup %x %y %K %A 0
$self bind <Shift-KeyRelease> keyup %x %y %K %A 1
! $self bind <Motion> motion %x %y 0 %s
! $self bind <Alt-Motion> motion %x %y 4 %s
$self bind <Map> map
$self bind <Unmap> unmap
--- 1376,1381 ----
$self bind <KeyRelease> keyup %x %y %K %A 0
$self bind <Shift-KeyRelease> keyup %x %y %K %A 1
! $self bind <Motion> motion %x %y 0
! $self bind <Alt-Motion> motion %x %y 4
$self bind <Map> map
$self bind <Unmap> unmap
***************
*** 1532,1537 ****
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} {
--- 1523,1528 ----
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] [expr $y-1] [expr $onset+[look iowidth]] $y]
#will update this code when proc item deals with mult.tags
#if {[llength [$c gettags $self$which$i]] != 0} {
***************
*** 1648,1653 ****
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)]
--- 1639,1644 ----
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)]
***************
*** 1710,1714 ****
set propose $c.${self}propose
set @text [$t get 1.0 1.end]
- $self erase
after 1 "destroy $t"
#after 1 "destroy $propose"
--- 1701,1704 ----
***************
*** 1717,1720 ****
--- 1707,1711 ----
pd .$@canvas text_setto !$self $l
focus $c
+ $self erase ;# (why?)
}
***************
*** 1757,1780 ****
global canvas clipboard
set wires {}
- # look up for wire id
foreach x $wires2 {
! mset {outobj outport inobj inport} $x
! set obj1 [lindex $@children $outobj]
! set obj2 [lindex $@children $inobj]
! set find [lsearch $@wires_pair $x]
! if { $find == -1} {
! # new wire!!!
! if {[info exists _($obj1:valid)] & [info exists _($obj2:valid)]} {
! lappend @wires_pair [list $outobj $outport $inobj $inport]
! set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]]
! lappend @wires_pair $new_wire
! lappend wires $new_wire
! } else {
puts "$obj1 or $obj2 not born yet"
! set @unborn_wire [lappend @unborn_wire $x]}
! } else {
! # wire already exist
! lappend wires [lindex $@wires_pair [expr $find + 1]]
! }
}
set born [lwithout $wires $@wires]
--- 1748,1769 ----
global canvas clipboard
set wires {}
foreach x $wires2 {
! mset {outobj outport inobj inport} $x
! set obj1 [lindex $@children $outobj]
! set obj2 [lindex $@children $inobj]
! set find [lsearch $@wires_pair $x]
! if {$find == -1} {# new wire!!!
! if {[info exists _($obj1:valid)] & [info exists _($obj2:valid)]} {
! lappend @wires_pair [list $outobj $outport $inobj $inport]
! set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]]
! lappend @wires_pair $new_wire
! lappend wires $new_wire
! } else {
puts "$obj1 or $obj2 not born yet"
! set @unborn_wire [lappend @unborn_wire $x]
! }
! } else {# wire already exists
! lappend wires [lindex $@wires_pair [expr $find + 1]]
! }
}
set born [lwithout $wires $@wires]
***************
*** 1785,1803 ****
$x changed
$x canvas= $self
- if {$@duplicating} {
- lappend @selection_wire $x
- #puts "appending $x from duplication..........."
- $x selected?= 1
- if {[llength $@selection_wire] == $canvas(dup_wire_num)} {set @duplicating 0}
- }
- if {[info exists clipboard(copying)]} {
- if {$clipboard(copying)} {
- lappend @selection_wire $x; $x selected?= 1
- if {$i == $born_num} {
- set clipboard(copying) 0
- set clipboard(orig_cpcanvas) $self
- }
- }
- }
incr i
}
--- 1774,1777 ----
***************
*** 1849,1856 ****
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]
--- 1823,1828 ----
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]
***************
*** 1867,1876 ****
#!@#$ this method is too long
! def Canvas motion {x y mods state} {
global font canvas tooltip
set canvas(current) $self
set c .$self.c
! set x [$c canvasx $x]
! set y [$c canvasy $y]
if {$tooltip(visible)} {
if {[expr [distance $tooltip(curpos) [list $x $y]] > 10]} {
--- 1839,1848 ----
#!@#$ this method is too long
! def Canvas motion {x y mods} {
global font canvas tooltip
set canvas(current) $self
set c .$self.c
! set x [expr [$c canvasx $x]/$@scale]
! set y [expr [$c canvasy $y]/$@scale]
if {$tooltip(visible)} {
if {[expr [distance $tooltip(curpos) [list $x $y]] > 10]} {
***************
*** 1883,1897 ****
set oldpos $@curpos
set @curpos [list $x $y]
- if {[llength [$c gettags lnew]]} {
- mset {ox1 oy1 ox2 oy2} [lrange [$c coords lnew] end-3 end]
- mset {x1 y1} [lrange [$c coords lnew] 0 1]
- set l [$c coords lnew]
- #if {[llength $l]<4 || [distance [list $ox1 $oy1] [list $x $y]] < 30} {
- # set l [lrange $l 0 [expr [llength $l]-3]]
- #}
- #lappend l $x $y
- set l [list $x1 $y1 $x $y]
- $c coords lnew $l
- }
# detects if the focus is not on the canvas itself in run mode, ie. numbox
if {!$@editmode & [$self focus] != $self & [$self focus] != ""} {[$self focus] motion $x $y $mods}
--- 1855,1858 ----
***************
*** 1914,1917 ****
--- 1875,1881 ----
}
}
+ none {}
+ #default {error "unknown action '$@action'"}
+ default {$@action motion $x $y $mods}
}
mset {type id} [$self identify_target $x $y -1 -1 "move "]
***************
*** 1922,1930 ****
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]
--- 1886,1889 ----
***************
*** 1942,1947 ****
}
}
! wire {
! }
}
}
--- 1901,1905 ----
}
}
! wire {}
}
}
***************
*** 1949,1957 ****
#-----------------------------------------------------------------------------------#
def Canvas identify_target {x y b f label} {
- global _
set c .$self.c
set stack [lreverse [$c find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]]
foreach tag $stack {
! set tags [$c gettags $tag]
if {[regexp {^x([a-f0-9]{6,8})} $tags id]} {
if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
--- 1907,1916 ----
#-----------------------------------------------------------------------------------#
def Canvas identify_target {x y b f label} {
set c .$self.c
+ set x [expr $x*$@scale]
+ set y [expr $y*$@scale]
set stack [lreverse [$c find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]]]
foreach tag $stack {
! set tags [$c gettags $tag]
if {[regexp {^x([a-f0-9]{6,8})} $tags id]} {
if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
***************
*** 1999,2002 ****
--- 1958,1962 ----
def Canvas wire_from {} {return $@wire_from}
def Canvas wire_to {} {return $@wire_to}
+ def Canvas scale {} {return $@scale}
def StatusBar draw {x y} {
***************
*** 2004,2009 ****
set c .$@canvas.c
set f [$self widget]
! set x [$c canvasx $x]
! set y [$c canvasy $y]
set tags [$c gettags [lindex [$c find overlapping \
[expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] end]]
--- 1964,1970 ----
set c .$@canvas.c
set f [$self widget]
! set scale [$@canvas scale]
! set x [expr [$c canvasx $x]/$scale]
! set y [expr [$c canvasy $y]/$scale]
set tags [$c gettags [lindex [$c find overlapping \
[expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] end]]
***************
*** 2018,2022 ****
}
if {[string length [$@canvas focus]]} {set t "focus: [$@canvas focus]"}
! $f.1.pos configure -text "($x,$y)"
$f.1.what configure -text $t
$f.1.mode configure -text [if {[$@canvas editmode]} {list "Edit"} {list "Run "}]
--- 1979,1983 ----
}
if {[string length [$@canvas focus]]} {set t "focus: [$@canvas focus]"}
! $f.1.pos configure -text [format "(%d,%d)" [expr int($x)] [expr int($y)]]
$f.1.what configure -text $t
$f.1.mode configure -text [if {[$@canvas editmode]} {list "Edit"} {list "Run "}]
***************
*** 2139,2143 ****
--- 2100,2124 ----
}
+ class_new FutureWire {View}
+ def* FutureWire init {canvas x1 y1} {
+ super
+ set @x1 $x1
+ set @y1 $y1
+ set @canvas $canvas
+ $self motion $x1 $y1 0
+ }
+ def* FutureWire motion {x2 y2 mods} {set @x2 $x2; set @y2 $y2; $self draw}
+ def* FutureWire unclick {x2 y2 b f} {
+ $self motion $x2 $y2 $f
+ post "UNCLICK should happen now"
+ $self _delete
+ }
+ def FutureWire draw {} {
+ $self item WIRE line [list $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [look wiredash]
+ }
+ def* FutureWire _delete {} {super}
+
#!@#$ this method is too long
+ # this method receives (x,y) in descaled coords
def* Canvas clickedit {x y b f} {
set c .[$self canvas].c
***************
*** 2160,2167 ****
# 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]
--- 2141,2144 ----
***************
*** 2169,2179 ****
set out [expr int(($x-$x1)*$outs/($x2-$x1))]
mset {x1 y1 x2 y2} [$c bbox ${id}o${out}]
! $c create line [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] $x $y -dash {4 4 4 4} -tags lnew -fill [look wiredash]
set @wire_from [list $id $out]
#click on a outlet with shift
! if {$f == 1} {
! if {![llength $@shift_wires]} {set @shift_wires $@wire_from; puts "store::::: $@shift_wires"}
! }
! set @action wire
return
} else {
--- 2146,2153 ----
set out [expr int(($x-$x1)*$outs/($x2-$x1))]
mset {x1 y1 x2 y2} [$c bbox ${id}o${out}]
! set @action [FutureWire new $self [expr ($x1+$x2)/2] [expr ($y1+$y2)/2]]
set @wire_from [list $id $out]
#click on a outlet with shift
! if {$f == 1 && ![llength $@shift_wires]} {set @shift_wires $@wire_from}
return
} else {
***************
*** 2225,2229 ****
set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]]
$id delete
! pd .$self disconnect $wire
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $id] [lsearch $@wires_pair $id]]
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $wire] [lsearch $@wires_pair $wire]]
--- 2199,2203 ----
set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]]
$id delete
! $self disconnect $wire
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $id] [lsearch $@wires_pair $id]]
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $wire] [lsearch $@wires_pair $wire]]
***************
*** 2244,2248 ****
set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]]
$id delete
! pd .$self disconnect $wire
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $id] [lsearch $@wires_pair $id]]
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $wire] [lsearch $@wires_pair $wire]]
--- 2218,2222 ----
set wire [lindex $@wires_pair [expr [lsearch $@wires_pair $id]-1]]
$id delete
! $self disconnect $wire
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $id] [lsearch $@wires_pair $id]]
set @wires_pair [lreplace $@wires_pair [lsearch $@wires_pair $wire] [lsearch $@wires_pair $wire]]
***************
*** 2274,2279 ****
set c .$self.c
focus $c
! set x [$c canvasx $x]
! set y [$c canvasy $y]
set @click_at [list $x $y]
#if {$@editmode && !($f&2)} {$self clickedit $x $y $b $f; return}
--- 2248,2253 ----
set c .$self.c
focus $c
! set x [expr [$c canvasx $x]/$@scale]
! set y [expr [$c canvasy $y]/$@scale]
set @click_at [list $x $y]
#if {$@editmode && !($f&2)} {$self clickedit $x $y $b $f; return}
***************
*** 2302,2306 ****
set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
if {[llength $selected_elements]} {
- set element_tags {}
set ids {}
set wids {}
--- 2276,2279 ----
***************
*** 2311,2315 ****
if {[regexp {^([0-9a-f]{6,8})} [$c gettags $tag] id]} {lappend wids $id}
}
! set selected_objs [lsort -unique $ids]
set selected_wires [lsort -unique $wids]
--- 2284,2288 ----
if {[regexp {^([0-9a-f]{6,8})} [$c gettags $tag] id]} {lappend wids $id}
}
! set selected_objs [lsort -unique $ids]
set selected_wires [lsort -unique $wids]
***************
*** 2324,2330 ****
}
- puts "selected_objs:$selected_objs selection:$@selection selection_wire:$@selection_wire"
# hilite objects
- #foreach obj $@selection {$c itemconfigure ${obj}BASE -outline [look selectframe]}
foreach obj $@selection {$obj selected?= 1}
if {[llength $@selection] == 1} {
--- 2297,2301 ----
***************
*** 2340,2375 ****
}
wire {
! #mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
! # if making wire without shift key (delete the dash line)
! if {!$f} {$c delete lnew} else {
! $c delete lnew
! mset {from outlet} $@wire_from
! set orig $from
! mset {x1 y1 x2 y2} [$c bbox ${orig}o${outlet}]
! $c create line [expr ($x1+$x2)/2] [expr ($y1+$y2)/2] $x $y -dash {4 4 4 4} -tags lnew -fill [look wiredash]
! }
! 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 $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} {
! set in [expr int(($x-$x1)*$ins/($x2-$x1))]
! set @wire_to [list $id $in]
! post "wire_from=%s wire_to=%s" $@wire_from $@wire_to
! mset {from outlet} $@wire_from
! mset {to inlet} $@wire_to
! pd .$self connect [lsearch $@children $from] $outlet \
! [lsearch $@children $to] $inlet
}
! }
}
edit {
--- 2311,2333 ----
}
wire {
! #mset {type id} [$@canvas identify_target $x $y [expr $x-1] [expr $y-1] "unclick"]
! # if making wire without shift key (delete the dash line)
! set x1 $x
! set y1 $y
! mset {type id} [$@canvas identify_target $x $y -1 -1 "unclick"]
if {$id != ""} {
! mset {x1 y1 x2 y2} [$id bbox]
! set ins 0; set ins [$id ninlets]
! if {$y<$y1+6 && $ins} {
! set in [expr int(($x-$x1)*$ins/($x2-$x1))]
! set @wire_to [list $id $in]
! mset {from outlet} $@wire_from
! mset {to inlet} $@wire_to
! $self connect [list \
! [lsearch $@children $from] $outlet \
! [lsearch $@children $to] $inlet]
! }
}
! if {!$f} {$c delete lnew}
}
edit {
***************
*** 2379,2384 ****
set @obj_in_edit $id
$id edit
- $id draw
-
}
move {
--- 2337,2340 ----
***************
*** 2392,2397 ****
$@history add [list $self undomove $objs]
}
}
-
}
--- 2348,2355 ----
$@history add [list $self undomove $objs]
}
+ none {}
+ #default {error "unknown action '$@action'"}
+ default {$@action unclick $x $y $b $f}
}
}
***************
*** 2402,2407 ****
def* Canvas unclick {x y b f} {
set c .$self.c
! set x [$c canvasx $x]
! set y [$c canvasy $y]
if {$@editmode} {$self unclickedit $x $y $b $f} {$self unclickrun $x $y %b}
$self adjust_scrollbars
--- 2360,2365 ----
def* Canvas unclick {x y b f} {
set c .$self.c
! set x [expr [$c canvasx $x]/$@scale]
! set y [expr [$c canvasy $y]/$@scale]
if {$@editmode} {$self unclickedit $x $y $b $f} {$self unclickrun $x $y %b}
$self adjust_scrollbars
***************
*** 2575,2579 ****
set per [lindex $scale(canned) $i]
$spinbox set $per%
! set @scale [expr $per/100.0]
$self redraw
}
--- 2533,2537 ----
set per [lindex $scale(canned) $i]
$spinbox set $per%
! set @scale [expr $per/100.0] ;# @scale must be float, not int
$self redraw
}
***************
*** 2607,2614 ****
def Canvas key {x y key iso shift} {
set c .$self.c
! set x [$c canvasx $x]
! set y [$c canvasy $y]
! global OS
! set c .$self.c
$self hide_tooltip
if {[$self focus] != ""} {
--- 2565,2570 ----
def Canvas key {x y key iso shift} {
set c .$self.c
! set x [expr [$c canvasx $x]/$@scale]
! set y [expr [$c canvasy $y]/$@scale]
$self hide_tooltip
if {[$self focus] != ""} {
***************
*** 2616,2624 ****
}
#if {$iso != ""} {scan $iso %c key}
- if {$key == "BackSpace" || $key == "Delete" || $key == "KP_Delete"} {
- $self delete_selection
- }
if {$shift} {set motion 10} {set motion 1}
! switch $key {
Up {$self selection_move 0 -$motion}
Down {$self selection_move 0 +$motion}
--- 2572,2578 ----
}
#if {$iso != ""} {scan $iso %c key}
if {$shift} {set motion 10} {set motion 1}
! switch -regexp -- $key {
! BackSpace|Delete|KP_Delete {$self delete_selection}
Up {$self selection_move 0 -$motion}
Down {$self selection_move 0 +$motion}
***************
*** 2676,2681 ****
--- 2630,2637 ----
def Box update_size {} {}
+ # will be so that @wires are updated correctly without break encapsulation
def* Box connect_out {} {}
def* Box connect_in {} {}
+
def Box draw {} {
#set text "[$@canvas index $self]: "
***************
*** 2770,2775 ****
def Wire draw {} {
! set bbox1 [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]]
! set bbox2 [.$@canvas.c bbox [join [list "$@obj2" i "$@port2"] ""]]
if {[llength $bbox1] < 4} {puts stderr "wire_draw: crap ($@obj1 outlet)"; return}
if {[llength $bbox2] < 4} {puts stderr "wire_draw: crap ($@obj2 inlet)"; return}
--- 2726,2732 ----
def Wire draw {} {
! set scale [$@canvas scale]
! set bbox1 [lmap / [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]] $scale]
! set bbox2 [lmap / [.$@canvas.c bbox [join [list "$@obj2" i "$@port2"] ""]] $scale]
if {[llength $bbox1] < 4} {puts stderr "wire_draw: crap ($@obj1 outlet)"; return}
if {[llength $bbox2] < 4} {puts stderr "wire_draw: crap ($@obj2 inlet)"; return}
More information about the Pd-cvs
mailing list