diff options
Diffstat (limited to 'sandbox/testicon.tcl')
-rw-r--r-- | sandbox/testicon.tcl | 39 |
1 files changed, 37 insertions, 2 deletions
diff --git a/sandbox/testicon.tcl b/sandbox/testicon.tcl index 5c790e4..d9789ec 100644 --- a/sandbox/testicon.tcl +++ b/sandbox/testicon.tcl @@ -5,8 +5,10 @@ package require Img set top 1 -image create photo penguin -file /usr/X11R6/include/X11/pixmaps/xpenguin_color.xpm -set mask "/usr/X11R6/include/X11/bitmaps/fvwm.xbm" +image create photo penguin -file xpenguin.png +image create photo bouton -file bouton.xpm +image create photo boutond -file bouton-down.xpm +set mask "fvwm.xbm" set r [zinc .r -backcolor gray -relief sunken] pack .r -expand t -fill both @@ -52,6 +54,9 @@ set x2 500.0 set y2 -300.0 imageicon $x2 $y2 $view penguin center +.r add icon $view -image bouton -position "$x2 $y2" -anchor center +.r add icon $view -image boutond -position [list [expr $x2 + 50] $y2] -anchor center + # # Clip # @@ -62,4 +67,34 @@ set clip [.r add rectangle $view "50 -300 600 -10" -filled t \ .r lower $clip .r itemconfigure $view -clip $clip +.r addtag test withtype icon +.r bind test "<ButtonPress-1>" "testpress %x %y" +.r bind test "<ButtonRelease-1>" testrelease + +proc testpress {lx ly} { + global testx testy + set testx $lx + set testy $ly + .r bind test "<Motion>" "testmotion %x %y" +} + +proc testmotion {lx ly} { + global testx testy + set it [.r find withtag test] + if {$it != ""} { + set it [.r group [lindex $it 0]] + } + set res [.r transform $it "$lx $ly $testx $testy"] + set nx [lindex $res 0] + set ny [lindex $res 1] + set ox [lindex $res 2] + set oy [lindex $res 3] + .r translate current [expr $nx - $ox] [expr $ny - $oy] + set testx $lx + set testy $ly +} +proc testrelease {} { + .r bind test "<Motion>" "" +} + source controls.tcl |