Ajout de plusieurs demos et remaniement

1 files changed, 110 insertions, 109 deletions

diff --git a/demos/tkZincLogo.tcl b/demos/tkZincLogo.tcl
index 9806212..6db4031 100644
--- a/demos/tkZincLogo.tcl
+++ b/demos/tkZincLogo.tcl
@@ -1,16 +1,25 @@
+#
+# $Id$
 # this simple demo has been adapted by C. Mertz <mertz@cena.fr> from the original
 # work of JL. Vinot <vinot@cena.fr>
-# tcl version by Jean-Paul Imbert imbert@cena.fr
+# Ported to Tcl by P.Lecoanet
 
 if {![info exists zincDemo]} {
     error "This script should be run from the zinc-widget demo."
 }
 
-set w .tkZincLogo
+#
+# We need the zincLogo support
+package require zincLogo
+
+
+set w .zincLogo
 catch {destroy $w}
 toplevel $w
-wm title $w "Zinc Logo Demonstration"
-wm iconname $w Logo
+wm title $w "Zinc logo Demonstration"
+wm iconname $w zincLogo
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
 
 frame $w.buttons
 pack $w.buttons -side bottom -fill x -pady 2m
@@ -18,138 +27,130 @@ button $w.buttons.dismiss -text Dismiss -command "destroy $w"
 button $w.buttons.code -text "See Code" -command "showCode $w"
 pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
 
-set defaultfont "-adobe-helvetica-bold-r-normal-*-140-*-*-*-*-*-*"
-text $w.text -relief sunken -borderwidth 2 -height 7 
+
+
+###########################################
+# Text zone
+#######################
+####################
+
+text $w.text -relief sunken -borderwidth 2 -height 5
 pack $w.text -expand yes -fill both
 
-$w.text insert 0.0 {This tkZinc logo should used openGL for a correct rendering!
-    You can transform this logo with your mouse:
-    Drag-Button 1 for moving the logo 
-    Drag-Button 2 for zooming the logo 
-    Drag-Button 3 for rotating the logo 
-    Shift-Drag-Button 1 for modifying the logo transparency 
-    Shift-Drag-Button 2 for modifying the logo gradient.}
+$w.text insert end {This tkZinc logo should used openGL for a correct rendering!
+   You can transform this logo with your mouse:
+     Drag-Button 1 for moving the logo,
+     Drag-Button 2 for zooming the logo,
+     Drag-Button 3 for rotating the logo,
+     Shift-Drag-Button 1 for modifying the logo transparency,
+     Shift-Drag-Button 2 for modifying the logo gradient.}
 
 
-zinc $w.zinc -width 350 -height 250 -render 1 -font 10x20 -borderwidth 3 -relief sunken
+###########################################
+# Zinc
+##########################################
+zinc $w.zinc -width 350 -height 250 -render 1 -font 10x20 \
+    -borderwidth 3 -relief sunken
 pack $w.zinc
 
-set group [$w.zinc add group 1 ]
+set group [$w.zinc add group 1]
 
+set logo [zincLogo::create $w.zinc $group 800 40 70 0.6 0.6]
 
-set logo = $w.zinc LogoZinc -parent $group -position {40 70} -priority 800 -scale {.6 .6}
+#
+# Controls for the window transform.
+#
+bind $w.zinc <ButtonPress-1>  "press motion %x %y"
+bind $w.zinc <ButtonRelease-1>  release
+bind $w.zinc <ButtonPress-2>  "press zoom %x %y"
+bind $w.zinc <ButtonRelease-2>  release
 
+#
+# Controls for alpha and gradient
+#
+bind $w.zinc <Shift-ButtonPress-1> "press modifyAlpha %x %y"
+bind $w.zinc <Shift-ButtonRelease-1> release
+bind $w.zinc <Shift-ButtonPress-2> "press modifyGradient %x %y"
+bind $w.zinc <Shift-ButtonRelease-2> release
 
 
-$w.zinc Tk::bind <ButtonPress-1> "press $w.zinc motion"
-$w.zinc Tk::bind <ButtonRelease-1> "release $w.zinc"
+set curX 0
+set curY 0
+set curAngle 0
 
-$w.zinc Tk::bind <ButtonPress-2> "press $w.zinc zoom"
-$w.zinc Tk::bind <ButtonRelease-2> "release $w.zinc"
+proc press {action x y} {
+    global w curAngle curX curY
 
-$w.zinc Tk::bind <ButtonPress-3> "press $w.zinc rotate"
-$w.zinc Tk::bind <ButtonRelease-3> "release $w.zinc"
+    set curX $x
+    set curY $y
+    set curAngle [expr atan2($y, $x)]
+    bind $w.zinc <Motion> "$action %x %y"
+}
 
+proc motion {x y} {
+    global w topGroup curX curY
 
-$w.zinc Tk::bind <Shift-ButtonPress-1> "press $w.zinc modifyAlpha"
-$w.zinc Tk::bind <Shift-ButtonRelease-1> "release $w.zinc"
+    foreach {x1 y1 x2 y2} [$w.zinc transform $topGroup \
+			       [list $x $y $curX $curY]] break
+    $w.zinc translate $topGroup [expr $x1 - $x2] [expr $y1 - $y2]
+    set curX $x
+    set curY $y
+}
 
-$w.zinc Tk::bind <Shift-ButtonPress-2> "press $w.zinc modifyGradient"
-$w.zinc Tk::bind <Shift-ButtonRelease-2> "release $w.zinc"
+proc zoom {x y} {
+    global w topGroup curX curY
 
+    if {$x > $curX} {
+	set maxX $x
+    } else {
+	set maxX $curX
+    }
+    if {$y > $curY} {
+	set maxY $y
+    } else {
+	set maxY $curY
+    }
+    if {($maxX == 0) || ($maxY == 0)} {
+	return;
+    }
+    set sx [expr 1.0 + (double($x - $curX) / $maxX)]
+    set sy [expr 1.0 + (double($y - $curY) / $maxY)]
+    $w.zinc scale $topGroup $sx $sx
 
-#
-# Controls for the window transform.
-#
-my $cur_x $cur_y $cur_angle
-proc press {zinc action} {
-    my $w.zinc $action = @_
-    set ev = $w.zinc XEvent 
-    $cur_x = $ev x
-    $cur_y = $ev y
-    $cur_angle = atan2 $cur_y $cur_x
-    $w.zinc Tk::bind <Motion> $action
+    set curX $x
+    set curY $y
 }
 
-proc modifyAlpha {zinc} {
-    my $w.zinc = @_
-    set ev = $w.zinc XEvent 
-    set lx = $ev x
-    set xrate = $lx / $w.zinc cget -width
-    
-    $xrate = 0 if $xrate < 0
-    $xrate = 1 if $xrate > 1
-    
-    set alpha = $xrate * 100
-    print "Alpha=$alpha\n"
-    $w.zinc itemconfigure $group -alpha $alpha
-}
+proc mouseRotate {x y} {
+    global w curAngle topGroup
 
-proc modifyGradient {zinc} {
-    my $w.zinc = @_
-    set ev = $w.zinc XEvent 
-    set ly = $ev y
-    set yrate = $ly / $w.zinc cget -height
-    
-    $yrate = 0 if $yrate < 0
-    $yrate = 1 if $yrate > 1
-    set gradientpercent = sprintf "%d" $yrate * 100
-    
-    $w.zinc itemconfigure "letters" -fillcolor "#ffffff:100 0 28|#66848c:100 $gradientpercent|#7192aa:100 100/270" 
+    set lAngle [expr atan2($y, $x)]
+    $w.zinc rotate $topGroup [expr -($lAngle - $curAngle)]
+    set curAngle  $lAngle
 }
 
+proc release {} {
+    global w
 
-proc motion {zinc} {
-    my $w.zinc = @_
-    set ev = $w.zinc XEvent 
-    set lx = $ev x
-    set ly = $ev y
-    my @res
-    
-    @res = $w.zinc transform $group "$lx $ly $cur_x $cur_y"
-    $w.zinc translate $group $res[0] - $res[2] $res[1] - $res[3]
-    $cur_x = $lx
-    $cur_y = $ly
+    bind $w.zinc <Motion> {}
 }
 
-proc zoom {zinc} {
-    my $w.zinc $self = @_
-    set ev = $w.zinc XEvent 
-    set lx = $ev x
-    set ly = $ev y
-    set maxx
-    set maxy
-    set sx
-    set sy
-    
-    if $lx > $cur_x {
-	$maxx = $lx
-    } else {
-	$maxx = $cur_x
-    }
-    if $ly > $cur_y {
-	$maxy = $ly
-    } else {
-	$maxy = $cur_y
-    }
-    return if $maxx == 0 || $maxy == 0
-    $sx = 1.0 + $lx - $cur_x/$maxx
-    $sy = 1.0 + $ly - $cur_y/$maxy
-    $cur_x = $lx
-    $cur_y = $ly
-    $w.zinc scale $group $sx $sy
-}
+proc modifyAlpha {x y} {
+    global w
 
-proc rotate {zinc x y} {
-    set ev = $zinc XEvent 
-    set lx = $ev x
-    set ly = $ev y
-    
-    $langle = atan2 $ly $lx
-    $w.zinc rotate $group - $langle - $cur_angle
-    $cur_angle = $langle
+    set xRate [expr double($x) / [$w.zinc cget -width]]
+    set xRate [expr ($xRate < 0) ? 0 : ($xRate > 1) ? 1 : $xRate]
+    set alpha [expr $xRate * 100]
+
+    $w.zinc itemconfigure $group -alpha $alpha
 }
 
-proc release {zinc} {
-    $zinc bind <Motion> "" 
+proc modifyGradient {x y} {
+    global w
+
+    set yRate [expr double($ly) / [$w.zinc cget -height]]
+    set yRate [expr ($yRate < 0) ? 0 : ($yRate > 1) ? 1 : $yRate]
+    set gradientPercent [expr int($yRate * 100)]
+    
+    $w.zinc itemconfigure letters -fillcolor => "=axial 270|#ffffff;100 0 28|#66848c;100 $gradientpercent|#7192aa;100 100"
 }