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 }