[PD-cvs] pd/src desire.tk,1.1.2.59,1.1.2.60
Mathieu Bouchard
matju at users.sourceforge.net
Thu Sep 15 21:21:06 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25097
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
... and stuff
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.59
retrieving revision 1.1.2.60
diff -C2 -d -r1.1.2.59 -r1.1.2.60
*** desire.tk 15 Sep 2005 11:23:15 -0000 1.1.2.59
--- desire.tk 15 Sep 2005 19:21:04 -0000 1.1.2.60
***************
*** 884,906 ****
class_new canvas
def* canvas init {width height geometry editable} {
! global pd_opendir pd_tearoff OS cmdline canvasmenu _
set name .x$self
- # focus should be set to either always a _ object or always a tk object. else we'll run into trouble. what do we do here? --matju
set _(focus) $self
toplevel $name -menu $name.m
wm geometry $name $geometry
canvas $name.c -width $width -height $height -background white \
! -yscrollcommand "$name.scrollvert set" \
! -xscrollcommand "$name.scrollhort set" \
-scrollregion [list 0 0 $width $height]
! scrollbar $name.scrollvert -command "$name.c yview"
! scrollbar $name.scrollhort -command "$name.c xview" -orient horizontal
! if {[string compare $cmdline(icons) ""]} {
! make_button_bar $name.bbar $name
! pack $name.bbar -side top -fill x -expand no
! }
! statusbar_new $self
! pack $name.scrollhort -side bottom -fill x
! pack $name.scrollvert -side right -fill y
pack $name.c -side left -expand 1 -fill both
wm minsize $name 1 1
--- 884,900 ----
class_new canvas
def* canvas init {width height geometry editable} {
! global pd_opendir pd_tearoff OS cmdline canvasmenu
set name .x$self
set _(focus) $self
toplevel $name -menu $name.m
wm geometry $name $geometry
canvas $name.c -width $width -height $height -background white \
! -yscrollcommand "$name.yscroll set" \
! -xscrollcommand "$name.xscroll set" \
-scrollregion [list 0 0 $width $height]
! pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
! pack [statusbar_new $self] -side bottom -fill x
! pack [scrollbar $name.xscroll -command "$name.c xview" -orient horizontal] -side bottom -fill x
! pack [scrollbar $name.yscroll -command "$name.c yview"] -side right -fill y
pack $name.c -side left -expand 1 -fill both
wm minsize $name 1 1
***************
*** 913,917 ****
{"Help" {popup_help [canvastosym %W]} ""}
}
-
wm protocol $name WM_DELETE_WINDOW "menu_close $name"
$self new_binds
--- 907,910 ----
***************
*** 988,994 ****
}
! def canvas scroll {axis diff} {
! .x$self.c [list $axis]view scroll $diff units
! }
def canvas new_menubar {editable} {
--- 981,985 ----
}
! def canvas scroll {axis diff} {.x$self.c [list $axis]view scroll $diff units}
def canvas new_menubar {editable} {
***************
*** 1082,1088 ****
# for quit/save/undo
switch -- $key {
! q {if {$shift} {menu_really_quit} {menu_quit}; return}
! s {if {$shift} {menu_saveas $topname} {menu_save $topname}; return}
! z {if {$shift} {menu_redo $topname} {menu_undo $topname}; return}
}
if {[info exists accels(ctrl+$key)]} {
--- 1073,1079 ----
# for quit/save/undo
switch -- $key {
! q {if {$shift} {menu_really_quit} {menu_quit}; return}
! s {if {$shift} {menu_saveas $top} {menu_save $top}; return}
! z {if {$shift} {menu_redo $top} {menu_undo $top}; return}
}
if {[info exists accels(ctrl+$key)]} {
***************
*** 1152,1159 ****
set y2 [expr $y1+$ys]
set xya [list $x1 $y1 $x2 $y2]
! set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
! set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
! set xyd [list [expr $x1+4] [expr $y1+4] [expr $x2+4] [expr $y2+4]]
! #shadow_draw $self $canvas $xya
item $self $canvas BASE rectangle $xya -fill $look(objectbg)
item $self $canvas BASE2 line $xyb -fill $look(objectframe2)
--- 1143,1149 ----
set y2 [expr $y1+$ys]
set xya [list $x1 $y1 $x2 $y2]
! 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]]
! #shadow_draw $self $canvas $xya
item $self $canvas BASE rectangle $xya -fill $look(objectbg)
item $self $canvas BASE2 line $xyb -fill $look(objectframe2)
***************
*** 1170,1177 ****
}
- #----------------------------------------------------------------------------------
#this just tells whether an object is part of the selection, that is, what usually
#make objects turn blue.
-
def canvas selected? {member} {
set i [lsearch $@selection $member]
--- 1160,1165 ----
***************
*** 1184,1191 ****
set nplus [expr $n==1 ? 1 : $n-1]
foreach {x1 y1} [$self xy $canvas] {}
- set xs $@xs
- set ys $@ys
- set x2 [expr $x1+$xs]
- set y2 [expr $y1+$ys]
set c .x$canvas.c
for {set i 0} {$i<$n} {incr i} {
--- 1172,1175 ----
***************
*** 1236,1241 ****
global look font
set @text $text
! objectbox_update_size $self
! objectbox_draw $self $canvas
set t .x$canvas.c.${self}text
text $t -height 1 -width [llength $@text] -relief flat \
--- 1220,1225 ----
global look font
set @text $text
! $self update_size
! $self draw $canvas
set t .x$canvas.c.${self}text
text $t -height 1 -width [llength $@text] -relief flat \
***************
*** 1514,1518 ****
pack $f.what -side left -padx 8 -fill x -expand yes
pack $f.mode_l $f.mode $f.action_l $f.action $f.sel_l $f.sel -side left
! pack $f -side bottom -fill x
}
--- 1498,1502 ----
pack $f.what -side left -padx 8 -fill x -expand yes
pack $f.mode_l $f.mode $f.action_l $f.action $f.sel_l $f.sel -side left
! return $f
}
***************
*** 1725,1729 ****
}
if {[llength [$c gettags selrect]] > 0} {
- #puts "___figure out what objects are in selrect!!!"
set coords [$c coords selrect]
set x1 [lindex $coords 0]
--- 1709,1712 ----
***************
*** 1731,1747 ****
set x2 $cx
set y2 $cy
!
! #puts "selrect area ::: $x1 $y1, $x2 $y2"
! # my selrect code begins --chun
! set selrect_id [$c find withtag selrect]
! #puts "selrect's id ::: $selrect_id"
set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
- #puts "elements in selrect --> $selected_elements"
set selrect_index [lsearch $selected_elements $selrect_id]
- #puts "selrect's index ::: $selrect_index"
- #removes selrect from the list of selected elements
set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
- #puts "elements in selrect --> $selected_elements"
-
if {[llength $selected_elements]} {
set element_tags {}
--- 1714,1721 ----
set x2 $cx
set y2 $cy
! set selrect_id [$c find withtag selrect]
set selected_elements [$c find overlapping $x1 $y1 $x2 $y2]
set selrect_index [lsearch $selected_elements $selrect_id]
set selected_elements [lreplace $selected_elements $selrect_index $selrect_index]
if {[llength $selected_elements]} {
set element_tags {}
***************
*** 1753,1777 ****
set wires {}
foreach tag $element_tags {
! if {[regexp {^([a-f0-9]{6,8})} $tag id]} {
! lappend ids $id
! }
# this would make things shorter
# if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]}
! #if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {
! #
! # lappend wires $wire_id
! #}
}
-
- #puts "ids in selrect --> $ids"
- #puts "wires in selrect --> $wires"
set selected_objs [lsort -unique $ids]
! #puts "selected_objs --> $selected_objs"
!
! foreach obj $selected_objs {
set i [lsearch $@selection $obj]
if {$i<0} {lappend @selection $obj}
}
-
#foreach wire $wires {
# set i [lsearch $@selection_wire $wire]
--- 1727,1740 ----
set wires {}
foreach tag $element_tags {
! if {[regexp {^([a-f0-9]{6,8})} $tag id]} {lappend ids $id}
# this would make things shorter
# if {[regexp {^l([a-f0-9]{6,8})} [$c gettags $tag] id]}
! #if {[regexp {^l([a-f0-9]{6,8})} $tag wire_id]} {lappend wires $wire_id}
}
set selected_objs [lsort -unique $ids]
! foreach obj $selected_objs {
set i [lsearch $@selection $obj]
if {$i<0} {lappend @selection $obj}
}
#foreach wire $wires {
# set i [lsearch $@selection_wire $wire]
***************
*** 1781,1787 ****
set @selection_wire $wires
- #----handles the wire----
- #set @inlets $ins
- #set @outlets $outs
foreach obj $@selection {
for {set x 0} {$x<$_($obj:inlets)} {incr x} {
--- 1744,1747 ----
***************
*** 1789,1795 ****
#puts "check -> $obj"
if {[info exists _($obj:i:$x)]} {
- #puts "wires at inlet $x to select --> $_($obj:i:$x)"
- #wire_update $_()
- #wire_update:: l80f8ea8 81168ae 1 81168af 0 0
foreach wire_id $_($obj:i:$x) {
#wire_update $wire_id $_($wire_id)
--- 1749,1752 ----
***************
*** 1802,1806 ****
for {set x 0} {$x<$_($obj:outlets)} {incr x} {
if {[info exists _($obj:o:$x)]} {
- #puts "wires at outlet $x to update --> $_($obj:o:$x)"
foreach wire_id $_($obj:o:$x) {
#wire_update $wire_id $_($wire_id)
--- 1759,1762 ----
***************
*** 1812,1828 ****
}
}
! #puts "@selection --> $@selection"
! #puts "@selection_wire --> $@selection_wire"
! foreach obj $@selection) {
! $c itemconfigure ${obj}BASE -outline $look(objectframe4)
! }
! foreach wire $@selection_wire {
! $c itemconfigure $wire -fill $look(wirefg2)
! }
set @select_by "selrect"
} {
! #foreach obj $@selection {
! #$c itemconfigure ${obj}BASE -outline $look(objectframe3)
! #}
#set @selection {}
}
--- 1768,1776 ----
}
}
! foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe4)}
! foreach wire $@selection_wire {$c itemconfigure $wire -fill $look(wirefg2)}
set @select_by "selrect"
} {
! #foreach obj $@selection {$c itemconfigure ${obj}BASE -outline $look(objectframe3)}
#set @selection {}
}
***************
*** 2889,2892 ****
--- 2837,2841 ----
#$self.name configure -state disabled
pack $self.name -side right
+ return $self
}
More information about the Pd-cvs
mailing list