*** empty log message ***

8 files changed, 257 insertions, 18 deletions

diff --git a/sandbox/controls.pl b/sandbox/controls.pl
new file mode 100644
index 0000000..fcddda5
--- /dev/null
+++ b/sandbox/controls.pl
@@ -0,0 +1,168 @@
+$tlbbox = $zinc->add('group', $top,
+		     -sensitive => 0, -visible => 0,
+		     -tags 'currentbbox');
+$zinc->add('rectangle', $tlbbox, [-3, -3, +3, +3]);
+$trbbox = $zinc->add('group', $top,
+		     -sensitive => 0, -visible => 0,
+		     -tags => 'currentbbox');
+$zinc->add('rectangle', $trbbox, [-3, -3, +3, +3]);
+$blbbox = $zinc->add('group', $top,
+		     -sensitive => 0, -visible => 0,
+		     -tags => 'currentbbox');
+$zinc->add('rectangle', $blbbox, [-3, -3, +3, +3]);
+$brbbox = $zinc->add('group', $top,
+		     -sensitive => 0, -visible => 0,
+		     -tags 'currentbbox');
+$zinc->add('rectangle', $brbbox, [-3, -3, +3, +3]);
+$zinc->add('rectangle', $top, [0, 0, 1, 1],
+	   -linecolor => 'red', -tags => 'lasso',
+	   -visible => 0, -sensitive => 0);
+
+#
+# Controls for the window transform.
+#
+proc press {lx ly action} {
+    global x y angle
+    set x $lx
+    set y $ly
+    set angle [expr atan2($y, $x)]
+    bind .r "<Motion>" "$action %x %y"
+}
+
+proc motion {lx ly} {
+    global x y
+    set it [.r find withtag controls]
+    if {$it != ""} {
+	set it [.r group [lindex $it 0]]
+    }
+    set res [.r transform $it "$lx $ly $x $y"]
+    set nx [lindex $res 0]
+    set ny [lindex $res 1]
+    set ox [lindex $res 2]
+    set oy [lindex $res 3]
+    .r translate controls [expr $nx - $ox] [expr $ny - $oy]
+    set x $lx
+    set y $ly
+}
+
+proc zoom {lx ly} {
+    global x y
+
+    if {$lx > $x} {
+	set maxx $lx
+    } else {
+	set maxx $x
+    }
+    if {$ly > $y} {
+	set maxy $ly
+    } else {
+	set maxy $y
+    }
+    set sx [expr 1.0 + double($lx - $x)/$maxx]
+    set sy [expr 1.0 + double($ly - $y)/$maxy]
+    set x $lx
+    set y $ly
+    .r scale controls $sx $sy
+}
+
+proc rotate {lx ly} {
+    global angle
+
+    set langle [expr atan2($ly, $lx)]
+    .r rotate controls [expr -($langle-$angle)]
+    set angle $langle
+}
+
+proc release {} {
+    bind .r "<Motion>" ""
+}
+
+proc start_lasso {lx ly} {
+    global top x y cx cy
+    set x $lx
+    set y $ly
+    set cx $lx
+    set cy $ly
+    set coords [.r transform $top "$x $y"]
+    set fx [lindex $coords 0]
+    set fy [lindex $coords 1]
+    .r coords lasso  "$fx $fy $fx $fy"
+    .r itemconfigure lasso -visible t
+    .r raise lasso
+    bind .r "<Motion>" "lasso %x %y"
+}
+
+proc lasso {lx ly} {
+    global top x y cx cy
+    set cx $lx
+    set cy $ly
+    set coords [.r transform $top "$x $y $lx $ly"]
+    set fx [lindex $coords 0]
+    set fy [lindex $coords 1]
+    set fcx [lindex $coords 2]
+    set fcy [lindex $coords 3]
+    .r coords lasso  "$fx $fy $fcx $fcy"
+}
+
+proc fin_lasso {} {
+    global x y cx cy
+    
+    bind .r "<Motion>" ""
+    .r itemconfigure lasso -visible f
+#    puts "x=$x, y=$y, cx=$cx, cy=$cy"
+    puts "enclosed='[.r find enclosed $x $y $cx $cy]', overlapping='[.r find overlapping $x $y $cx $cy]'"
+}
+
+proc getrect {x y} {
+    list [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3]
+}
+
+proc showbox {} {
+    global top tlbbox trbbox blbbox brbbox
+    
+    if { ! [.r hastag current currentbbox]} {
+	if {[catch {.r find withtag current} item] } {
+	    return
+	}
+	set coords [.r transform $top [.r bbox current]]
+	set xo [lindex $coords 0]
+	set yo [lindex $coords 1]
+	set xc [lindex $coords 2]
+	set yc [lindex $coords 3]
+
+	.r coords $tlbbox "$xo $yo"
+	.r coords $trbbox "$xc $yo"
+	.r coords $brbbox "$xc $yc"
+	.r coords $blbbox "$xo $yc"
+	.r itemconfigure currentbbox -visible t
+    }
+}
+
+proc hidebox {lx ly} {
+    set next [.r find closest $lx $ly]
+    if {[llength $next] > 1} {
+	set next [lindex $next 0]
+    }
+    if { $next == "" || ! [.r hastag $next currentbbox] ||\
+	    [.r hastag current currentbbox]} {
+	.r itemconfigure currentbbox -visible f
+    }
+}
+
+
+$zinc->bind('<ButtonPress-1>', "start_lasso %x %y");
+$zinc->bind('<ButtonRelease-1>', \&fin_lasso);
+$zinc->bind('<ButtonPress-2>', sub { $closest = $zinc->find('closest', %x %y);
+				     print "at point=$closest\n" });
+
+$zinc->bind('<ButtonPress-3>', "press %x %y motion");
+$zinc->bind('<ButtonRelease-3>', \&release);
+
+$zinc->bind('<Shift-ButtonPress-3>', "press %x %y zoom");
+$zinc->bind('<Shift-ButtonRelease-3>', \&release);
+
+$zinc->bind('<Control-ButtonPress-3>' "press %x %y rotate");
+$zinc->bind('<Control-ButtonRelease-3>', \&release);
+
+$zinc->bind('current', '<Enter>', \&showbox);
+$zinc->bind('current', '<Leave>', {hidebox %x %y});
diff --git a/sandbox/local.pl b/sandbox/local.pl
new file mode 100644
index 0000000..ccebad0
--- /dev/null
+++ b/sandbox/local.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl -w
+
+use Tk;
+use Tk::Zinc;
+
+$mw = MainWindow->new();
+$logo = $mw->Photo(-file => "logo.gif");
+$papier = $mw->Photo(-file => "texture-paper.xpm");
+#$penguin = $mw->Photo(-file => "xpenguin.png");
+
+$top = 1;
+$zinc = $mw->Zinc(-localrender => 1, -relief => 'sunken');
+$zinc->pack(-expand => 1, -fill => 'both');
+$zinc->configure(-width => 500, -height => 500);
+$gr1 = $zinc->add('group', $top);
+$clip = $zinc->add('rectangle', $gr1, [50, 50, 399, 399],
+		   -filled => 1, -fillcolor => 'pink', -linewidth => 0);
+$zinc->itemconfigure($gr1, -clip => $clip);
+$gr2 = $zinc->add('group', $gr1);
+$clip2 = $zinc->add('rectangle', $gr2, [200, 200, 450, 450],
+		    -filled => 1, -fillcolor => 'lavender', -linewidth => 0);
+#$zinc->itemconfigure($gr2, -clip => $clip2);
+$view = $zinc->add('group', $gr2, -tags => "controls");
+$zinc->lower($clip);
+$zinc->lower($clip2);
+
+$rect = $zinc->add('rectangle', $view, [100, 100, 200, 200],
+		   -linewidth => 4, -tile => $papier,
+		   -fillcolor => 'pink', -fillalpha => 128,
+		   -filled => 1);
+$fvwm = $zinc->add('icon', $view,
+		   -mask => '@fvwm.xbm', -position => [250, 120],
+		   -anchor => 'center', -color => 'black',
+		   -alpha => 255);
+$rect2 = $zinc->add('rectangle', $view, [150, 50, 300, 300],
+		    -linewidth => 0, -tile => $logo,
+		    -fillcolor => 'white', -fillalpha => 90,
+		    -filled => 1);
+$x = 100;
+$y = 100;
+for ($i = 0; $i < 1; $i++) {
+    $x = $x+3;
+    $y = $y+3;
+    $zinc->add('text', $view,
+	       -text => "BlaBla et tout et tout, bref...",
+	       -position => [$x, $y], -anchor => 'nw',
+	       -color => 'red', -alpha => 90);
+}
+#$peng = $zinc->add('icon', $view,
+#		   -image => $penguin, -position => [300, 300],
+#		   -anchor => 'center', -alpha => 128);
+$zinc->translate($rect, -150, -150);
+$zinc->rotate($rect, 35);
+$zinc->translate($rect, 150, 150);
+
+#source controls.tcl
+#
+MainLoop();
diff --git a/sandbox/local.tcl b/sandbox/local.tcl
index e6886ae..d42ba2a 100644
--- a/sandbox/local.tcl
+++ b/sandbox/local.tcl
@@ -1,4 +1,4 @@
-#!/usr/bin/wish -f
+#!/usr/bin/wish8.0 -f
 
 load tkzinc3.1.so
 package require Img
@@ -12,7 +12,15 @@ image create photo penguin -file xpenguin.png
 set r [zinc .r -relief sunken -localrender 1]
 pack .r -expand t -fill both
 .r configure -width 500 -height 500
-set view [.r add group $top -tags "controls"]
+set gr1 [.r add group $top]
+set clip [.r add rectangle $gr1 "50 50 399 399" -filled 1 -fillcolor pink -linewidth 0]
+#.r itemconfigure $gr1 -clip $clip
+set gr2 [.r add group $gr1]
+set clip2 [.r add rectangle $gr2 "200 200 450 450" -filled 1 -fillcolor lavender -linewidth 0]
+#.r itemconfigure $gr2 -clip $clip2
+set view [.r add group $gr2 -tags "controls"]
+.r lower $clip
+.r lower $clip2
 
 set rect [.r add rectangle $view "100 100 200 200" -linewidth 4 \
 	-tile papier -fillcolor pink -fillalpha 128 -filled 1]
diff --git a/sandbox/testarc.tcl b/sandbox/testarc.tcl
index 23e961a..876bc97 100644
--- a/sandbox/testarc.tcl
+++ b/sandbox/testarc.tcl
@@ -1,4 +1,4 @@
-#!/usr/bin/wish -f
+#!/usr/bin/wish8.0 -f
 
 load tkzinc3.1.so
 package require Img
@@ -8,8 +8,9 @@ set top 1
 image create photo logo -file logo.gif
 image create photo papier -file texture-paper.xpm
 image create photo penguin -file xpenguin.png
+image create photo papier -file texture-paper.xpm
 
-set r [zinc .r -backcolor gray -relief sunken]
+set r [zinc .r -backcolor gray -relief sunken -localrender 1]
 pack .r -expand t -fill both
 .r configure -width 800 -height 500
 #.r configure -drawbboxes t
@@ -19,7 +20,9 @@ set view [.r add group $top -tags "controls"]
 set view2  [.r add group $top]
 .r translate $view2 300 -200
 
-set arc [.r add arc $view "50 -10 200 -100" -filled t -closed t -pieslice t -fillcolor "white darkslateblue 17" -gradient "50" -linewidth 1]
+set arc [.r add arc $view "50 -10 200 -100" -filled t -closed t -pieslice f \
+	-fillcolor "white darkslateblue 17" -gradient "50" -linewidth 1 \
+	-startangle 0 -extent 120 -tile papier]
 #set arc [.r add arc $view "50 -10 200 -100" -filled t -closed t -pieslice t -fillcolor "#ff0000 #00ff00 17" -gradient "50" -linewidth 0]
 #.r add arc $view "60 -20 190 -90" -filled t -closed t -pieslice t -fillcolor "white darkslateblue 17" -gradient "50/180" -linewidth 1 -linecolor white
 #.r rotate $arc 10
@@ -28,10 +31,11 @@ set arc [.r add arc $view "50 -10 200 -100" -filled t -closed t -pieslice t -fil
 #.r translate $arc2 100 -100
 
 .r add icon $view2 -image penguin
-set cliparc [.r add arc $view2 "-100 100 100 -100" -filled t -fillcolor tan -visible t]
+set cliparc [.r add arc $view2 "-100 100 100 -100" -filled t \
+	-fillcolor tan -fillalpha 200]
 .r lower $cliparc
 #.r rotate $cliparc 20
 .r translate $cliparc 100 -40
-.r itemconfigure $view2 -clip $cliparc
+#.r itemconfigure $view2 -clip $cliparc
 
 source "controls.tcl"
diff --git a/sandbox/testicon.tcl b/sandbox/testicon.tcl
index 07a976e..81ad0bd 100644
--- a/sandbox/testicon.tcl
+++ b/sandbox/testicon.tcl
@@ -10,7 +10,7 @@ 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]
+set r [zinc .r -backcolor gray -relief sunken -localrender 0]
 pack .r -expand t -fill both
 .r configure -width 800 -height 500
 #.r configure -drawbboxes t
diff --git a/sandbox/testpoly.tcl b/sandbox/testpoly.tcl
index 2363a82..837b8b5 100644
--- a/sandbox/testpoly.tcl
+++ b/sandbox/testpoly.tcl
@@ -1,4 +1,4 @@
-#!/usr/bin/wish -f
+#!/usr/bin/wish8.0 -f
 
 load tkzinc3.1.so
 package require Img
@@ -33,7 +33,7 @@ set show {\
 image create photo logo -file /usr/share/toccata/images/logo.gif
 #image create photo papier -file /usr/share/toccata/images/dgtexture-dragstrip.xpm
 
-set r [zinc .r -backcolor gray -relief sunken]
+set r [zinc .r -backcolor gray -relief sunken -localrender 1]
 pack .r -expand t -fill both
 .r configure -width 1024 -height 800
 .r scale $top 1 -1
diff --git a/sandbox/testtext.tcl b/sandbox/testtext.tcl
index 818d8df..b0281f4 100644
--- a/sandbox/testtext.tcl
+++ b/sandbox/testtext.tcl
@@ -1,15 +1,16 @@
-#!/usr/bin/wish -f
+#!/usr/bin/wish8.0 -f
 
 load tkzinc3.1.so
 package require Img
 
-set top 1
 set mask "/usr/X11R6/include/X11/bitmaps/fvwm.xbm"
 
-set r [zinc .r -backcolor gray -relief sunken -insertbackground red -insertwidth 10]
+set r [zinc .r -backcolor gray -relief sunken \
+	-insertbackground red -insertwidth 10 -localrender 0]
 pack .r -expand t -fill both
 .r configure -width 800 -height 500
 # .r configure -drawbboxes t
+set top [.r add group 1]
 .r addtag controls withtag $top
 
 .r add rectangle $top "-50 0 +50 1" -composescale 0
@@ -68,19 +69,19 @@ set x [expr $x + 200.0]
 
 set x 150
 set y 300
-.r add text $top -text "Ce texte tient sur plusieurs lignes.\nLes alignements :\n- à gauche\n-à droite\n-au centre\nsont également mis en évidence.\n" -position "$x $y" -anchor center
+.r add text $top -text "Ce texte tient sur plusieurs lignes.\nLes alignements :\n- à gauche\n- à droite\n- au centre\nsont également mis en évidence.\n" -position "$x $y" -anchor center
 .r add rectangle $top [list [expr $x - 3.0] [expr $y - 3.0] \
 	[expr $x + 3.0] [expr $y + 3.0]] -filled 1 -fillcolor red
 
 set x 400
 set y 300
-set anim [.r add text $top -text "Ce texte tient sur plusieurs lignes.\nLes alignements :\n- à gauche\n-à droite\n-au centre\nsont également mis en évidence.\nLe texte central montre l'utilisation\nd'un espacement des lignes programmable." -position "$x $y" -anchor center -alignment center -spacing -5 -font {times 14 bold italic}]
+set anim [.r add text $top -text "Ce texte tient sur plusieurs lignes.\nLes alignements :\n- à gauche\n- à droite\n- au centre\nsont également mis en évidence.\nLe texte central montre l'utilisation\nd'un espacement des lignes programmable." -position "$x $y" -anchor center -alignment center -spacing -5 -font {times 14 bold italic}]
 .r add rectangle $top [list [expr $x - 3.0] [expr $y - 3.0] \
 	[expr $x + 3.0] [expr $y + 3.0]] -filled 1 -fillcolor red
 
 set x 650
 set y 300
-.r add text $top -text "Ce texte tient sur plusieurs lignes.\nLes alignements :\n- à gauche\n-à droite\n-au centre\nsont également mis en évidence.\n" -position "$x $y" -anchor center -alignment right
+.r add text $top -text "Ce texte tient sur plusieurs lignes.\nLes alignements :\n- à gauche\n- à droite\n- au centre\nsont également mis en évidence.\n" -position "$x $y" -anchor center -alignment right
 .r add rectangle $top [list [expr $x - 3.0] [expr $y - 3.0] \
 	[expr $x + 3.0] [expr $y + 3.0]] -filled 1 -fillcolor red
 
diff --git a/sandbox/zinc.tcl b/sandbox/zinc.tcl
index b47a702..74a76f0 100644
--- a/sandbox/zinc.tcl
+++ b/sandbox/zinc.tcl
@@ -1,4 +1,4 @@
-#!/usr/bin/wish -f
+#!/usr/bin/wish8.0 -f
 
 load tkzinc3.1.so
 #package require Img
@@ -222,7 +222,7 @@ set topclip [.r add rectangle $top "-400 -400 400 400" \
 #
 proc borders {onoff} {
     set part [.r currentpart]
-    puts "$part"
+    puts "part $part $onoff"
     set contour noborder
     if { $onoff == "on" } {
 	set contour "contour oblique"