[PD-cvs] pd/src u_main.tk,1.1.1.4.2.7.4.63,1.1.1.4.2.7.4.64 u_object.tk,1.1.2.37,1.1.2.38
Mathieu Bouchard
matju at users.sourceforge.net
Fri May 7 07:55:52 CEST 2004
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13049
Modified Files:
Tag: impd_0_37
u_main.tk u_object.tk
Log Message:
bugfixes
Index: u_object.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/u_object.tk,v
retrieving revision 1.1.2.37
retrieving revision 1.1.2.38
diff -C2 -d -r1.1.2.37 -r1.1.2.38
*** u_object.tk 6 May 2004 07:12:27 -0000 1.1.2.37
--- u_object.tk 7 May 2004 05:55:50 -0000 1.1.2.38
***************
*** 392,395 ****
--- 392,396 ----
$canvas create polygon $points2 -tag ${self}BASE4
$canvas create text $xt $yt -anchor w -tags ${self}NUMBER
+ set _($self:clicking) 0
} {
$canvas coords ${self}BASE $points
***************
*** 409,415 ****
io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
label_draw $self $canvas
! set _($self:clickevent) numbox_clickevent
! set _($self:keyevent) numbox_keyevent
! set _($self:ungrabevent) numbox_ungrabevent
}
--- 410,418 ----
io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
label_draw $self $canvas
! set _($self:clickevent) numbox_click
! set _($self:keyevent) numbox_key
! set _($self:ungrabevent) numbox_ungrab
! set _($self:motionevent) numbox_motion
! set _($self:unclickevent) numbox_unclick
}
***************
*** 460,482 ****
proc numbox_erase {self canvas} {
! $canvas delete $self ${self}NUMBER ${self}BASE4
io_erase $self $canvas
label_erase $self $canvas
}
! proc numbox_clickevent {self canvas x y b f} {
! #set can [trimleft [trimright $canvas .c] .]
canvas_grab $canvas $self
$canvas itemconfigure ${self}BASE4 -fill #00ff00
}
! proc numbox_ungrabevent {self canvas} {
global _
- puts "numbox_ungrabevent $self $canvas"
set _($self:buf) ""
numbox_draw $self $canvas
}
! proc numbox_keyevent {self canvas key shift} {
global _ look
set c -1
--- 463,508 ----
proc numbox_erase {self canvas} {
! $canvas delete ${self}BASE ${self}NUMBER ${self}BASE4
io_erase $self $canvas
label_erase $self $canvas
}
! proc numbox_click {self canvas x y b f} {
! global _
canvas_grab $canvas $self
$canvas itemconfigure ${self}BASE4 -fill #00ff00
+ set _($self:mouse) [list $x $y]
+ set _($self:oval) $_($self:val)
+ set _($self:clicking) 1
+ set _($self:rate) [expr $f&1 ? 0.01 : 1.00]
}
! proc numbox_motion {self canvas x y mod} {
! global _
! set grabbed [expr ![string compare $self [canvas_grabber $canvas]]]
! if {!$grabbed} {return}
! foreach {ox oy} $_($self:mouse) {}
! set _($self:val) [expr $_($self:val)+$_($self:rate)*($y-$oy)]
! numbox_draw $self $canvas
! set _($self:mouse) [list $x $y]
! if {$_($self:clicking)} {pd "x$self float $_($self:val) ;"}
! }
!
! proc numbox_ungrab {self canvas} {
global _
set _($self:buf) ""
numbox_draw $self $canvas
}
! proc numbox_unclick {self canvas x y} {
! global _
! set _($self:clicking) 0
! if {$_($self:oval)!=$_($self:val)} {
! canvas_ungrab $canvas
! pd "x$self float $_($self:val) ;"
! }
! }
!
! proc numbox_key {self canvas key shift} {
global _ look
set c -1
***************
*** 489,492 ****
--- 515,519 ----
catch {set _($self:val) [expr $_($self:buf)]}
canvas_ungrab $canvas
+ pd "x$self float $_($self:val) ;"
} elseif {$key==8 || $key==127} {
# Backspace
***************
*** 597,600 ****
--- 624,628 ----
bluebox_erase $self $canvas
$canvas delete ${self}BUT
+ label_erase $self $canvas
}
***************
*** 645,648 ****
--- 673,677 ----
set _($self:motionevent) slider_motion
set _($self:unclickevent) slider_unclick
+ set _($self:ungrabevent) slider_ungrab
return
#EXPERIMENTAL: (notches)
***************
*** 692,695 ****
--- 721,725 ----
proc slider_erase {self canvas} {
bluebox_erase $self $canvas
+ label_erase $self $canvas
$canvas delete ${self}KNOB
}
***************
*** 697,702 ****
proc slider_click {self canvas x y b f} {
global _
set _($self:clicking) 1
! set _($self:last) [list $x $y]
}
--- 727,735 ----
proc slider_click {self canvas x y b f} {
global _
+ canvas_grab $canvas $self
+ set _($self:first) [list $x $y]
+ set _($self:ovalue) $_($self:value)
set _($self:clicking) 1
! set _($self:rate) [expr $f&1 ? 0.01 : 1.00]
}
***************
*** 704,720 ****
global _
set _($self:clicking) 0
}
proc slider_motion {self canvas x y mods} {
global _
! if {!$_($self:clicking)} {return}
! set dx [expr $x-[lindex $_($self:last) 0]]
! set dy [expr $y-[lindex $_($self:last) 1]]
set orient [slider_orient $self]
set span [expr $_($self:max)-$_($self:min)]
! set d [expr ($orient?-$dy:$dx)*$span/($orient?$_($self:h):$_($self:w))]
! set _($self:value) [expr $_($self:value)+$d]
pd "x$self float $_($self:value) ;"
! set _($self:last) [list $x $y]
}
--- 737,763 ----
global _
set _($self:clicking) 0
+ if {$_($self:value)!=$_($self:ovalue)} {
+ canvas_ungrab $canvas
+ pd "x$self float $_($self:val) ;"
+ }
}
proc slider_motion {self canvas x y mods} {
global _
! set grabbed [expr ![string compare $self [canvas_grabber $canvas]]]
! if {!$grabbed} {return}
! set dx [expr $x-[lindex $_($self:first) 0]]
! set dy [expr $y-[lindex $_($self:first) 1]]
set orient [slider_orient $self]
set span [expr $_($self:max)-$_($self:min)]
! set l [expr $orient?$_($self:h):$_($self:w)]
! set d [expr ($orient?-$dy:$dx)*$span/($l+0.0)]
! set _($self:value) [expr $_($self:ovalue)+$d*$_($self:rate)]
pd "x$self float $_($self:value) ;"
! }
!
! proc slider_ungrab {self canvas} {
! global _
! slider_draw $self $canvas
}
***************
*** 741,745 ****
proc label_select {self canvas} {}
! proc label_erase {self canvas} {}
proc bang_draw {self canvas} {
--- 784,790 ----
proc label_select {self canvas} {}
! proc label_erase {self canvas} {
! $canvas delete ${self}LABEL
! }
proc bang_draw {self canvas} {
***************
*** 950,954 ****
proc vu_erase {self canvas} {
bluebox_erase $self $canvas
! $canvas delete ${self}MASK
}
--- 995,1000 ----
proc vu_erase {self canvas} {
bluebox_erase $self $canvas
! label_erase $self $canvas
! $canvas delete ${self}SCALE ${self}RMS ${self}MASK
}
***************
*** 1009,1012 ****
--- 1055,1059 ----
proc cnv_erase {self canvas} {
+ label_erase $self $canvas
$canvas delete ${self}BASE ${self}LABEL
}
Index: u_main.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v
retrieving revision 1.1.1.4.2.7.4.63
retrieving revision 1.1.1.4.2.7.4.64
diff -C2 -d -r1.1.1.4.2.7.4.63 -r1.1.1.4.2.7.4.64
*** u_main.tk 6 May 2004 07:12:26 -0000 1.1.1.4.2.7.4.63
--- u_main.tk 7 May 2004 05:55:48 -0000 1.1.1.4.2.7.4.64
***************
*** 443,447 ****
}
! proc menu_close {name} {pd "$name menuclose ;"}
proc menu_undo {name} {
--- 443,447 ----
}
! proc menu_close {name} {pd "$name menuclose 0 ;"}
proc menu_undo {name} {
***************
*** 590,601 ****
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"
$self.stat.mode configure -text $_($self:mode)
$self.stat.action configure -text $_($self:action)
--- 590,604 ----
if {[info exists _($id:class)]} {set class $_($id:class)} {set class unknown}
$self.stat.what configure -text "$id \[$class\] ($tags)"
}
wire {
$self.stat.what configure -text "$id wire"
! }
! default {
! $self.stat.what configure -text "... $tags"
}
}
! if {[string length $_($self:grab)]} {
! $self.stat.what configure -text "grab: $_($self:grab)"
! }
$self.stat.mode configure -text $_($self:mode)
$self.stat.action configure -text $_($self:action)
***************
*** 855,858 ****
--- 858,868 ----
}
+ proc event {self sel args} {
+ global _
+ if {[info exists _($self:$sel)]} {
+ eval [linsert [concat [list $self] $args] 0 $_($self:$sel)]
+ }
+ }
+
proc pdtk_canvas_click {canvas x y b f} {
pdtk_canvas_click2 $canvas $x $y $b $f
***************
*** 871,881 ****
set run [expr !$edit || ($f&2)]
pd "$self click-on-object x$id $cx $cy $b $f;"
if {$f&8} {
puts "RIGHTCLICK OBJECT"
set rightclick_object $id
! } elseif {$run && [info exists _($id:clickevent)]} {
! eval [linsert [list $id $canvas $cx $cy $b $f] 0 $_($id:clickevent)]
! } elseif {!$run && [info exists _($id:clickeditevent)]} {
! eval [linsert [list $id $canvas $cx $cy $b $f] 0 $_($id:clickeditevent)]
}
#!@#$ "elseif" should go here ?
--- 881,892 ----
set run [expr !$edit || ($f&2)]
pd "$self click-on-object x$id $cx $cy $b $f;"
+ if {[string length $_($self:grab)]} {set gid $_($self:grab)}
if {$f&8} {
puts "RIGHTCLICK OBJECT"
set rightclick_object $id
! } else {
! if {$run} {
! event $id clickevent $canvas $cx $cy $b $f} {
! event $id clickeditevent $canvas $cx $cy $b $f}
}
#!@#$ "elseif" should go here ?
***************
*** 978,990 ****
}
}
foreach {type id} [identify_target $canvas $cx $cy -1 -1 "move "] {}
switch $type {
object {
! set run [expr !$edit]
! if {$run && [info exists _($id:motionevent)]} {
! eval [linsert [list $id $canvas $cx $cy $mods] 0 $_($id:motionevent)]
! } elseif {!$run && [info exists _($id:motioneditevent)]} {
! eval [linsert [list $id $canvas $cx $cy $mods] 0 $_($id:motioneditevent)]
! }
if {$edit && [llength [$canvas bbox ${id}BASE]]} {
# may highlight an inlet
--- 989,1006 ----
}
}
+ set run [expr !$edit]
+ if {[string length $_($self:grab)]} {
+ set id $_($self:grab)
+ if {$run} {
+ event $id motionevent $canvas $cx $cy $mods} {
+ event $id motioneditevent $canvas $cx $cy $mods}
+ return
+ }
foreach {type id} [identify_target $canvas $cx $cy -1 -1 "move "] {}
switch $type {
object {
! if {$run} {
! event $id motionevent $canvas $cx $cy $mods} {
! event $id motioneditevent $canvas $cx $cy $mods}
if {$edit && [llength [$canvas bbox ${id}BASE]]} {
# may highlight an inlet
***************
*** 1071,1085 ****
pd "$self gobj-activate x$_($self:selection);"
}
set edit 0; switch $_($self:mode) { edit { set edit 1 } }
foreach {type id} [identify_target $canvas $cx $cy -1 -1 "blah "] {}
switch $type {
object {
! set run [expr !$edit]
! if {$run && [info exists _($id:unclickevent)]} {
! eval [linsert [list $id $canvas $cx $cy] 0 $_($id:unclickevent)]
! } elseif {!$run && [info exists _($id:unclickeditevent)]} {
! eval [linsert [list $id $canvas $cx $cy] 0 $_($id:unclickeditevent)]
! }
}
}
--- 1087,1107 ----
pd "$self gobj-activate x$_($self:selection);"
}
+ set edit 0; switch $_($self:mode) { edit { set edit 1 } }
+ set run [expr !$edit]
+ if {[string length $_($self:grab)]} {
+ set id $_($self:grab)
+ if {$run} {
+ event $id unclickevent $canvas $cx $cy} {
+ event $id unclickeditevent $canvas $cx $cy}
+ }
set edit 0; switch $_($self:mode) { edit { set edit 1 } }
foreach {type id} [identify_target $canvas $cx $cy -1 -1 "blah "] {}
+
switch $type {
object {
! if {$run} {
! event $id unclickevent $canvas $cx $cy} {
! event $id unclickeditevent $canvas $cx $cy}
}
}
***************
*** 1760,1765 ****
proc canvas_grab {canvas obj} {
- puts "canvas_grab $canvas $obj"
global _
set self [canvastosym $canvas]
set _($self:grab) $obj
--- 1782,1787 ----
proc canvas_grab {canvas obj} {
global _
+ canvas_ungrab $canvas
set self [canvastosym $canvas]
set _($self:grab) $obj
***************
*** 1767,1778 ****
proc canvas_ungrab {canvas} {
- puts "canvas_ungrab $canvas"
global _
set self [canvastosym $canvas]
set obj $_($self:grab)
set _($self:grab) ""
! set ung $_($obj:ungrabevent)
! puts "ungrab = $ung"
! if {[string length $ung]>0} {$ung $obj $canvas}
}
--- 1789,1798 ----
proc canvas_ungrab {canvas} {
global _
set self [canvastosym $canvas]
set obj $_($self:grab)
+ if {![string length $obj]} {return}
set _($self:grab) ""
! event $obj ungrabevent $canvas
}
More information about the Pd-cvs
mailing list