*** empty log message ***

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