First version of these new demos ported from Perl

1 files changed, 297 insertions, 0 deletions

diff --git a/demos/magicLens.tcl b/demos/magicLens.tcl
new file mode 100644
index 0000000..a095248
--- /dev/null
+++ b/demos/magicLens.tcl
@@ -0,0 +1,297 @@
+#-----------------------------------------------------------------------------------
+#
+#      MagicLens.pl
+#
+#      This small demo is based on Zinc::Graphics.pm for creating
+#      the graphic items.
+#      The magnifyer effect is obtained with the help of clipping,
+#      and some glass effect is based on color transparency through
+#      a triangles item bordering the magnifier
+#
+#      Authors: Jean-Luc Vinot <vinot@cena.fr>
+#		Patrick Lecoanet (Translation to Tcl).
+#
+# $Id: 
+#-----------------------------------------------------------------------------------
+
+if {![info exists zincDemo]} {
+    error "This script should be run from the zinc-widget demo."
+}
+
+package require zincGraphics
+
+set font9b 7x13bold
+set font8 7x13
+
+set basicColors {
+    {Jaune \#fff52a \#f1f1f1 \#6a6611}
+    {"Jaune\nOrangé" \#ffc017 \#cfcfcf \#6b510a}
+    {Orangé \#ff7500 \#a5a5a5 \#622d00}
+    {Rouge \#ff2501 \#8b8b8b \#620e00}
+    {Magenta \#ec145d \#828282 \#600826}
+    {"Violet\nRouge" \#a41496 \#636363 \#020940}
+    {"Violet\nBleu" \#6a25b6 \#555555 \#2a0f48}
+    {Bleu \#324bde \#646464 \#101846}
+    {Cyan \#0a74f0 \#818181 \#064a9a}
+    {"Bleu\nVert" \#009bb4 \#969696 \#006474}
+    {Vert \#0fa706 \#979797 \#096604}
+    {"Jaune\nVert" \#9dd625 \#c9c9c9 \#496311}
+}
+
+set circleCoords {
+    {0 -30} {-16.569 -30 c} {-30 -16.569 c} {-30 0}
+    {-30 16.569 c} {-16.569 30 c} {0 30}
+    {16.569 30 c} {30 16.569 c} {30 0}
+    {30 -16.569 c} {16.569 -30 c} {0 -30}
+}
+
+
+# MagicLens
+set lensItems {
+    back {
+	-itemtype arc
+	-coords {{-100 -100} {100 100}}
+	-params {
+	    -priority 10
+	    -closed 1
+	    -filled 1
+	    -visible 0
+	    -tags lensback
+	}
+    }
+    light {
+	-itemtype pathline
+	-metacoords {
+	    -type polygone
+	    -coords {0 0}
+	    -numsides 36
+	    -radius 100
+	    -startangle 240
+	}
+	-linewidth 10
+	-shifting right
+	-closed 1
+	-graduate {
+	    -type double
+	    -colors {
+		{ \#ffffff;0 \#6666cc;0 \#ffffff;0 }
+		{ \#ffffff;100 \#333399;50 \#ffffff;100 }
+	    }
+	}
+	-params {
+	    -priority 50
+	}
+    }
+    bord {
+	-itemtype hippodrome
+	-coords {{-100 -100} {100 100}}
+	-params {
+	    -priority 100
+	    -closed 1
+	    -filled 0
+	    -linewidth 2
+	    -linecolor \#222266;80
+	}
+    }
+}
+				
+
+proc SetBindings {} {
+    global zinc w
+
+    $zinc bind lens <1> {LensStart %x %y}
+    $zinc bind lens <B1-Motion> {LensMove %x %y}
+    $zinc bind lens <ButtonRelease> {LensStop %x %y}
+
+    focus $w
+
+  # Up, Down, Right, Left : Translate
+    bind $w <Up> {LensTranslate up}
+    bind $w <Down> {LensTranslate down}
+    bind $w <Left> {LensTranslate left}
+    bind $w <Right> {LensTranslate right}
+}
+
+
+#-----------------------------------------------------------------------------------
+# Lens Start Move Callback
+#-----------------------------------------------------------------------------------
+proc LensStart {x y} {
+    global dx dy
+
+    set dx [expr 0 - $x]
+    set dy [expr 0 - $y]
+
+}
+
+
+#-----------------------------------------------------------------------------------
+# Lens Move Callback.
+#-----------------------------------------------------------------------------------
+proc LensMove {x y} {
+    global dx dy zoom zinc infoView
+    
+    $zinc translate current [expr $x + $dx] [expr $y + $dy]
+    $zinc translate lenszone [expr $x + $dx] [expr $y + $dy]
+    set dx [expr 0 - $x]
+    set dy [expr 0 - $y]
+
+    foreach {lx ly} [$zinc coords lens 0 0] break
+    $zinc coords $infoView [list [expr $lx * (1 - $zoom)] \
+				[expr $ly * (1 - $zoom)]]
+}
+
+
+#-----------------------------------------------------------------------------------
+# Lens Release Callback (End of a Move)
+#-----------------------------------------------------------------------------------
+proc LensStop {x y} {
+  LensMove $x $y
+}
+
+proc LensTranslate {way} {
+    global zoom zinc infoView
+    
+    set dx 0
+    set dy 0
+    switch -- $way {
+	left {set dx -10}
+	up {set dy -10}
+	right {set dx 10}
+	down {set dy 10}
+    }
+    
+    $zinc translate lens $dx $dy
+    $zinc translate lenszone $dx $dy
+    foreach {lx ly} [$zinc coords lens 0 0] break
+    $zinc coords $infoView [list [expr $lx * (1 - $zoom)] \
+				[expr $ly * (1 - $zoom)]]
+}
+
+
+set w .testGraphics
+catch {destroy $w}
+toplevel $w
+wm title $w "Color Magic Lens Demonstration"
+wm geometry $w "1000x900+0+0"
+wm iconname $w magicLens
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+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
+
+# Create a Zinc instance
+set zinc [zinc $w.z -render 1 -width 1000 -height 900 -borderwidth 0 \
+	      -lightangle 140 -backcolor \#cccccc]
+pack $w.z -fill both -expand yes
+
+set imagePath [file join $zinc_library demos images]
+set texture [image create photo -file [file join $imagePath paper-grey1.gif]]
+set lensTexture [image create photo -file [file join $imagePath paper-grey.gif]]
+$zinc configure -tile $texture
+
+# Create the views
+set normView [$zinc add group 1 -priority 100]
+set lensView [$zinc add group 1 -priority 200]
+set infoView [$zinc add group $lensView]
+
+set zoom 1.20
+$zinc scale $infoView $zoom $zoom
+
+$zinc add rectangle $infoView {{0 0} {1000 900}} \
+    -filled 1 -fillcolor \#000000 -tile $lensTexture -linewidth 0
+
+set x 60
+for {set i 0} {$i < 12} {incr i} {
+
+  # Add a group in each view
+    set cGroup [$zinc add group $normView]
+    $zinc coords $cGroup [list $x 60]
+    set lGroup [$zinc add group $infoView]
+    $zinc coords $lGroup [list $x 60]
+
+    # Color Description : name, Saturated saturée, Unsaturated ZnColor, Shadow ZnColor
+    foreach {colorName saturColor greyColor shadColor} [lindex $basicColors $i] break
+
+    # Sample of saturated color + relief
+    set refGrad "=radial -12 -20|#ffffff 0|$saturColor 40|$shadColor 100"
+    set refItem [$zinc add curve $cGroup $circleCoords \
+		     -filled 1 -fillcolor $refGrad -linewidth 2 -priority 100]
+
+    # Clone into infoView group
+    set clone [$zinc clone $refItem]
+    $zinc chggroup $clone $lGroup
+
+    # Color label in infoView
+    $zinc add text $lGroup -priority 200 -position {0 0} \
+	-text $colorName -anchor center -alignment center -font $font9b -spacing 2
+
+    # Color gradient toward a gray with same light
+    set barGrad "=axial 270|$saturColor|$greyColor"
+
+    # Create the color samples (Multi contours curve)
+    set gradBar [$zinc add curve $cGroup {} -closed 1 -filled 1 -fillcolor $barGrad \
+		     -linewidth 2 -priority 20 -fillrule nonzero]
+
+    # Create main gradient colors (saturation 100% -> 0%) and trim alpha
+    # channel off.
+    set znColors [list]
+    foreach color [zincGraphics::CreateGraduate 11 [list $saturColor $greyColor]] {
+	lappend znColors [lindex [split $color ";"] 0]
+    }
+
+    # Create intermediate steps between colors (saturation -> desaturation)
+    for {set c 0} {$c < 11} {incr c} {
+	# Color of the current step
+	set color [lindex $znColors $c]
+
+	# Create a zinc item for the color
+	set sample [$zinc clone $refItem -fillcolor $color]
+	$zinc translate $sample 0 [expr 65*($c+1)]
+
+	# Add its shape to the multi-contours curve
+	$zinc contour $gradBar add 1 $sample
+
+	# Move the item to the info group
+	$zinc chggroup $sample $lGroup
+
+	# Text of label (% saturation + ZnColor)
+	set txtColor "[expr ((10 - $c)*10)]%\n$color"
+	set t [$zinc add text $lGroup -priority 200 -position {0 0} \
+		   -text $txtColor -anchor center -alignment center -font $font8 -spacing 2 \
+		   -composescale 0]
+	$zinc translate $t 0 [expr ($c + 1)* 65]
+    }
+
+    incr x 80
+}
+
+# Create the lens itself
+set lensGroup [$zinc add group 1 -priority 300 -atomic 1 -tags lens]
+$zinc coords $lensGroup {300 110}
+set dx 0
+set dy 0
+LensMove 0 0
+
+# Graphical items defining the lens
+foreach {name style} $lensItems {
+    zincGraphics::BuildZincItem $zinc $lensGroup $style {} $name
+}
+
+# Add a clipping shape to lensView
+set lensZone [$zinc clone lensback -tags lenszone]
+$zinc chggroup $lensZone $lensView true
+$zinc itemconfigure $lensView -clip $lensZone
+
+set consigne [$zinc add text 1 -position {0 0} -font $font8 -alignment left \
+			  -color \#ffffff -spacing 2 \
+			  -text "<Up>, <Down>, <Left> and <Right> keys or <Mouse Drag>
+Move the Magic Color Lens behind the color gradiants
+to see the ZnColor value of Hue/saturation"]
+$zinc translate $consigne 30 840
+
+set cClone [$zinc clone $consigne -font $font9b]
+$zinc chggroup $cClone $infoView
+
+SetBindings