Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13626
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
more work on undo/redo; also rewrote the zoom spinbox code
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.317
retrieving revision 1.1.2.318
diff -C2 -d -r1.1.2.317 -r1.1.2.318
*** desire.tk 11 Aug 2006 14:38:55 -0000 1.1.2.317
--- desire.tk 11 Aug 2006 17:18:14 -0000 1.1.2.318
***************
*** 936,942 ****
set look(minobjwidth) 21
! set scale(canned) [list 50 100 150 200 250 300]
! set scale(list) $scale(canned)
! set scale(incr) 0.25
#-----------------------------------------------------------------------------------#
proc read_ddrc {} {
--- 936,941 ----
set look(minobjwidth) 21
! set scale(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
!
#-----------------------------------------------------------------------------------#
proc read_ddrc {} {
***************
*** 1766,1769 ****
--- 1765,1769 ----
# think of the children!!!
+ # should be only called from the server
def Canvas children= {children} {
set new [lwithout $children $@children]
***************
*** 1772,1782 ****
$x unsubscribe $self
#$@history can't ;# need a way to instantiate objects with a specific index.
! $@history add [list $self insert [lsearch $@children $x] [$x deconstruct]]
$x erase
}
foreach x $new {
if {[info exists _($x:_class)]} {
$x subscribe $self; $x changed; $x canvas= $self
- $@history add [list $self del [lsearch $children $x]]
} else {
lappend @unborn $x
--- 1772,1784 ----
$x unsubscribe $self
#$@history can't ;# need a way to instantiate objects with a specific index.
! # THIS IS NOT WHERE HISTORY ADD IS SUPPOSED TO BE!
! # it's supposed to be on the user end!
! #$@history add [list $self ins [lsearch $@children $x] [$x deconstruct]]
$x erase
}
foreach x $new {
+ ###$@history add [list $self del [lsearch $children $x]]
if {[info exists _($x:_class)]} {
$x subscribe $self; $x changed; $x canvas= $self
} else {
lappend @unborn $x
***************
*** 1787,1802 ****
}
! def Canvas add {i constructor} {
! set x [meuh]
! $obj subscribe $self; $x changed
! $obj canvas= $self
! $@history add [list $self del $i]
! }
!
! def Canvas del {i} {
! set i [lsearch $@children $obj]
! if {$i} {set @children [lreplace $@children $i $i]}
! $obj unsubscribe $self
! }
def Canvas wires= {wires2} {
--- 1789,1795 ----
}
! # for undo; calls the server
! def Canvas ins {i constructor} {eval [concat [list pd .$self object_insert $i] $constructor]}
! def Canvas del {i} {pd .$self object_delete ![lindex $@children $i]}
def Canvas wires= {wires2} {
***************
*** 1853,1890 ****
}
- def Canvas wires_new {whoout outno whoin inno} {
- # @wires_pair is a workaround for looking up the wire id with {0 1 1 0} format
- # i moved calling wire_new here instead of where it was (canvas wires=)
- # is because i don't need to figure out which of the wire2 is new
- # todo: need to put some things here to prevent from creating the same connection twice
-
- #puts "self === $self"
- #lappend @wires_pair [list $whoout $outno $whoin $inno]
- #lappend @wires_pair [eval [list wire_new $self $whoout $outno $whoin $inno]]
- }
-
def* Canvas wires {} {return $@wires}
def* Canvas delete_selection {} {
- global _
set c .$self.c
foreach obj $@selection {
! #pd .$self object_delete !$obj
puts "wire to erase: $_($obj:wires)"
foreach wire $_($obj:wires) {
! set find [lsearch $@wires_pair $wire]
if { $find != -1} {
! pd .$self disconnect [lindex $@wires_pair [expr $find - 1]]
! ## remove the selected wire from the @wires_pair...
! set @wires_pair [lreplace $@wires_pair $find $find]
! set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
}
-
$wire delete
! }
!
! #$obj erase
! pd .$self object_delete !$obj
!
}
# before obj is deleted, it will be selected, therefore
--- 1846,1868 ----
}
def* Canvas wires {} {return $@wires}
def* Canvas delete_selection {} {
set c .$self.c
foreach obj $@selection {
! #pd .$self object_delete !$obj
puts "wire to erase: $_($obj:wires)"
foreach wire $_($obj:wires) {
! set find [lsearch $@wires_pair $wire]
if { $find != -1} {
! pd .$self disconnect [lindex $@wires_pair [expr $find - 1]]
! ## remove the selected wire from the @wires_pair...
! set @wires_pair [lreplace $@wires_pair $find $find]
! set @wires_pair [lreplace $@wires_pair [expr $find - 1] [expr $find - 1]]
}
$wire delete
! }
! #$obj erase
! pd .$self object_delete !$obj
}
# before obj is deleted, it will be selected, therefore
***************
*** 1895,1905 ****
}
- #this is redundent
- def* Canvas delete_wire {obj1 outport obj2 inport} {
- global _
- }
-
-
-
proc distance {point1 point2} {
set off [l- $point1 $point2]
--- 1873,1876 ----
***************
*** 2305,2313 ****
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} $@shift_wires
! mset {to inlet} $@wire_to
! pd .$self connect [lsearch $@children $from] $outlet \
[lsearch $@children $to] $inlet
}
--- 2276,2284 ----
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} $@shift_wires
! mset {to inlet} $@wire_to
! pd .$self connect [lsearch $@children $from] $outlet \
[lsearch $@children $to] $inlet
}
***************
*** 2318,2322 ****
}
} else {
-
# clcik on object
# if no previous selection, edit the clicked object
--- 2289,2292 ----
***************
*** 2327,2333 ****
if {[lsearch $@selection $id] < 0} {lappend @selection $id}
$id selected?= 1; set @action edit
! }
!
!
}
}
--- 2297,2301 ----
if {[lsearch $@selection $id] < 0} {lappend @selection $id}
$id selected?= 1; set @action edit
! }
}
}
***************
*** 2702,2756 ****
def* Canvas incr_zoom {} {$self zoom "in"}
def* Canvas decr_zoom {} {$self zoom "out"}
- def* Canvas zoom {mode} {
- global font scale
- switch $mode {
- in {
- set @scale [expr $@scale + $scale(incr)]
- }
- out {
- if {$@scale > $scale(incr)} {set @scale [expr $@scale - $scale(incr)]}
- }
- }
- $self redraw
- set val [format %.0f [expr $@scale * 100]]
- set val ${val}%
- set scale(list) $val
- .$self.bbar.scale set $val
! }
! def* Canvas spin_zoom {spinbox val direction} {
global scale
! set val [string trimright $val %]
! switch $direction {
! up {
! for {set i 0} {$i < [llength $scale(canned)]} {incr i} {
! set value [lindex $scale(canned) $i]
! if {[expr $value - $val] > 0} {break}
! }
! set next [lindex $scale(canned) $i]
! if {[expr $i+1] <= [llength $scale(canned)]} {
! $spinbox set ${next}%
! set next_f [format %.6f $next]
! set @scale [expr $next_f/100]
! }
! }
! down {
! for {set i 0} {$i < [llength $scale(canned)]} {incr i} {
! set value [lindex $scale(canned) $i]
! if {[expr $value - $val] >= 0} {break}
! }
! set next [lindex $scale(canned) [expr $i-1]]
! if {[expr $i-1] >= 0} {$spinbox set ${next}%
! set next_f [format %.6f $next]
! set @scale [expr $next_f/100]
! }
! }
}
$self redraw
-
- }
- def* Canvas spin_zoom_key {spinbox string string} {
- return 1
}
#-----------------------------------------------------------------------------------#
set lastcanvasconfigured ""
--- 2670,2690 ----
def* Canvas incr_zoom {} {$self zoom "in"}
def* Canvas decr_zoom {} {$self zoom "out"}
! def* Canvas zoom {mode} {
global scale
! set spinbox .$self.bbar.scale
! set val [string trimright [$spinbox get] %]
! set i [lsearch $scale(canned) $val]
! set end [expr [llength $scale(canned)] - 1]
! switch -regexp $mode {
! in|up {if {$i<$end} {incr i +1}}
! out|down {if {$i>0} {incr i -1}}
}
+ set per [lindex $scale(canned) $i]
+ $spinbox set $per%
+ set @scale [expr $per/100.0]
$self redraw
}
+
#-----------------------------------------------------------------------------------#
set lastcanvasconfigured ""
***************
*** 2948,2961 ****
class_new Wire {View}
! def Wire init {canvas from outno to inno} {
super
! set @connects [list $from $outno $to $inno]
! #puts "------ children:$_($canvas:children)"
! #hack
set children $_($canvas:children)
set @obj1 [lindex $children $from]
set @obj2 [lindex $children $to]
! set @port1 $outno
! set @port2 $inno
set @canvas $canvas
#set _($@obj1:wires) $self
--- 2882,2893 ----
class_new Wire {View}
! def Wire init {canvas from outlet to inlet} {
super
! set @connects [list $from $outlet $to $inlet]
set children $_($canvas:children)
set @obj1 [lindex $children $from]
set @obj2 [lindex $children $to]
! set @port1 $outlet
! set @port2 $inlet
set @canvas $canvas
#set _($@obj1:wires) $self
***************
*** 4533,4538 ****
}
pack [entry $bb.name -font {courier 10} -width 10 -border 0] -side right
! #pack [spinbox $bb.scale -width 6 -command "$canvas spin_zoom %W %s %d" -validate key -vcmd "$canvas spin_zoom_key %W %s %S"] -side right
! pack [spinbox $bb.scale -width 6 -command "$canvas spin_zoom %W %s %d" -state readonly] -side right
$bb.scale set "100%"
$bb.name insert 0 .$@canvas
--- 4465,4469 ----
}
pack [entry $bb.name -font {courier 10} -width 10 -border 0] -side right
! pack [spinbox $bb.scale -width 6 -command "$canvas zoom %d" -state readonly] -side right
$bb.scale set "100%"
$bb.name insert 0 .$@canvas
