Updated to a more simple and hopefully tclish script.

Images are inlined.

1 files changed, 170 insertions, 291 deletions

diff --git a/demos/magicLens.tcl b/demos/magicLens.tcl
index 3a50e72..f9b8d00 100644
--- a/demos/magicLens.tcl
+++ b/demos/magicLens.tcl
@@ -1,306 +1,185 @@
 #-----------------------------------------------------------------------------------
+# MagicLens.tcl
 #
-#      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
+#  This small demo shows the use of groups, transformations, clipping
+#  gradients and multi-contour curves to produce a structured and non
+#  trivial small application
 #
 #      Authors: Jean-Luc Vinot <vinot@cena.fr>
-#		Patrick Lecoanet (Translation to Tcl).
+#		            Patrick Lecoanet (Translation to Tcl).
 #
-# $Id: 
 #-----------------------------------------------------------------------------------
 
 if {![info exists zincDemo]} {
-    error "This script should be run from the zinc-widget demo."
+  error "This script should be run from the zinc-widget demo."
 }
 
-package require zincGraphics
-
 namespace eval magicLens {
-    variable font9b 7x13bold
-    variable font8 7x13
-
-    variable 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}
-    }
-
-    variable 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
-    variable 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 {} {
-	variable zinc
-	variable w
-
-	$zinc bind lens <1> {::magicLens::LensStart %x %y}
-	$zinc bind lens <B1-Motion> {::magicLens::LensMove %x %y}
-	$zinc bind lens <ButtonRelease> {::magicLens::LensStop %x %y}
-
-	focus $w
-
-	# Up, Down, Right, Left : Translate
-	bind $w <Up> {::magicLens::LensTranslate up}
-	bind $w <Down> {::magicLens::LensTranslate down}
-	bind $w <Left> {::magicLens::LensTranslate left}
-	bind $w <Right> {::magicLens::LensTranslate right}
-    }
-
-
-    #-----------------------------------------------------------------------------------
-    # Lens Start Move Callback
-    #-----------------------------------------------------------------------------------
-    proc LensStart {x y} {
-	variable dx 
-	variable dy
-
-	set dx [expr 0 - $x]
-	set dy [expr 0 - $y]
-
-    }
-
-
-    #-----------------------------------------------------------------------------------
-    # Lens Move Callback.
-    #-----------------------------------------------------------------------------------
-    proc LensMove {x y} {
-	variable dx
-	variable dy
-	variable zoom
-	variable zinc
-	variable 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} {
-	variable zoom
-	variable zinc
-	variable 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)]]
+  image create photo paper -data {
+    R0lGODlhIAAgALMAAAAAAP///6ysrKKiogAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAACH5BAAAAAAALAAAAAAgACAAAwSzUIgxpKzzTmqprximgRxpdaQ3ot0YZm8Gfyp8
+    fhuYc9stXzxVqCTT2Wy6F1HZGyaPJRGwuIvOejfpMrgSxbBHDTXFihp/LW2V7EUxrVLkzLyU
+    s4CpWJKHNffbaXI4LU1VhUJoRV5vTVtXOWVQgSaIXHF1hJWQlHF3aXo+NV1zLos/W08moaWP
+    lp6Eo0Z8kGKpdrNZSLaruHV8e4e/RIYuV2eGT4Ktbr9/kpc7p6Wud4iNAhEAOw==
+  }
+
+  font create magfont -family Helvetica -size 13 -weight bold
+  font create nfont -family Helvetica -size 11 -weight normal
+
+  #
+  # The basics colors, one per column.
+  set basicColors {
+    {Yellow {#fff52A} {#f1f1f1} {#6a6611}}
+    {"Yellow\nOrange" {#ffc017} {#cfcfcf} {#6b510a}}
+    {Orange {#ff7500} {#a5a5a5} {#622d00}}
+    {Red {#ff2501} {#8b8b8b} {#620e00}}
+    {Magenta {#ec145d} {#828282} {#600826}}
+    {"Red\nViolet" {#a41496} {#636363} {#020940}}
+    {"Violet\nBlue" {#6a25b6} {#555555} {#2a0f48}}
+    {Blue {#324bde} {#646464} {#101846}}
+    {Cyan {#0a74f0} {#818181} {#064a9a}}
+    {"Green\nBlue" {#009bb4} {#969696} {#006474}}
+    {Green {#0fa706} {#979797} {#096604}}
+    {"Yellow\nGreen" {#9dd625} {#c9c9c9} {#496311}}
+  }
+
+  #
+  # Compute a set of interpolated colors
+  #
+  proc CreateGraduate {steps color1 color2} {
+    scan $color1 {#%2x%2x%2x} r1 g1 b1
+    scan $color2 {#%2x%2x%2x} r2 g2 b2
+    set colors [list]
+    for {set i 0} {$i < $steps} {incr i} {
+      set ratio [expr {$i/($steps-1.0)}]
+      lappend colors [format {#%02x%02x%02x} \
+                          [expr {$r1 + int(($r2 - $r1) * $ratio)}] \
+                          [expr {$g1 + int(($g2 - $g1) * $ratio)}] \
+                          [expr {$b1 + int(($b2 - $b1) * $ratio)}]]
     }
-
-
-    variable w .magicLens
-    catch {destroy $w}
-    toplevel $w
-    wm title $w "Color Magic Lens Demonstration"
-    wm geometry $w "1000x900+0+0"
-    wm iconname $w magicLens
-
-    grid [button $w.dismiss -text Dismiss -command "destroy $w"]  -row 2 -column 0 -pady 10    
-    grid [button $w.code -text "See Code" -command "showCode $w"]  -row 2 -column 1 -pady 10 
-
-    # Create a Zinc instance
-    variable zinc [zinc $w.z -render 1 -width 1000 -height 900 -borderwidth 0 \
-		       -lightangle 140 -backcolor \#cccccc]
-    grid $zinc  -row 1 -column 0 -columnspan 2 -sticky news
-    grid columnconfigure $w 0 -weight 1
-    grid columnconfigure $w 1 -weight 1
-    grid rowconfigure $w 1 -weight 2
-
-    variable imagePath [file join $::zinc_demos images]
-    variable texture [image create photo -file [file join $imagePath paper-grey1.gif]]
-    variable lensTexture [image create photo -file [file join $imagePath paper-grey.gif]]
-    $zinc configure -tile $texture
-
-    # Create the views
-    variable normView [$zinc add group 1 -priority 100]
-    variable lensView [$zinc add group 1 -priority 200]
-    variable infoView [$zinc add group $lensView]
-
-    variable zoom 1.20
-    $zinc scale $infoView $zoom $zoom
-
-    $zinc add rectangle $infoView {{0 0} {1000 900}} \
-	-filled 1 -fillcolor \#000000 -tile $lensTexture -linewidth 0
-
-    variable 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"
-	    $zinc add text $lGroup -priority 200 -position [list 0 [expr ($c + 1)* 65]] \
-		-text $txtColor -anchor center -alignment center -font $font8 -spacing 2 \
-		-composescale 0
-	}
-
-	incr x 80
+    return $colors
+  }
+
+  set dx 0
+  set dy 0
+  set zoom 1.20
+  set width 1000
+  set height 900
+  set simpleLens 1
+
+  variable w .magicLens
+  catch {destroy $w}
+  toplevel $w
+  wm title $w "Color Magic Lens Demonstration"
+  wm geometry $w "1000x900+0+0"
+  wm iconname $w magicLens
+  #
+  # Create a Zinc instance
+  pack [zinc $w.zinc -render 1 -width $width -height $height -borderwidth 0 \
+         -tile paper -backcolor {#cccccc}] -expand yes -fill both
+  #
+  # The main view. The unzoomed world is here.
+  $w.zinc add group 1 -tags normview
+  #
+  # The hidden view. It holds the hidden world.
+  # It is clipped by the lens shape.
+  $w.zinc add group 1 -tags hiddenview
+  #
+  # Create the lens itself. It is made of an atomic
+  # group, a back to catch the mouse events and a
+  # border. The back is not visible but remain sensitive.
+  if { $simpleLens } {
+    $w.zinc add arc 1 {{-100 -100} {100 100}} -tags {lens lensback} \
+          -linewidth 2 -linecolor {#222266;80} -filled 1 -fillcolor {#ffffff;0}
+  } {
+    $w.zinc add group 1 -atomic yes -tags lens
+    $w.zinc add arc lens {{-100 -100} {100 100}} -tags lensborder -linewidth 2 \
+        -linecolor {#222266;80}
+    $w.zinc clone lensborder -filled yes -visible no -tags lensback
+  }
+  #
+  # Add the clipping shape to the hidden view so that we can view
+  # the magnified view only within the lens.
+  $w.zinc clone lensback -visible yes -filled yes -tile paper \
+       -fillcolor {#ffffff;100} -tags {lens lenszone}
+  $w.zinc chggroup lenszone hiddenview true
+  $w.zinc itemconfigure hiddenview -clip lenszone
+  #
+  # The zoomed view is inside the hidden view.
+  $w.zinc add group hiddenview -tags magview
+  $w.zinc scale magview $zoom $zoom
+  #
+  # Create the vertical color stripes in both normal and magnified views.
+  # In the normal view multi-contours curves are used, they are filled
+  # with vertical axial gradients. In the magnified view arc items are
+  # used filled with solid colors.
+  set x 60
+  foreach colorDesc $basicColors {
+    #
+    # Color Description : name, Saturated, Unsaturated, Shadow
+    foreach {colorName satColor greyColor shadColor} $colorDesc break
+    #
+    # Add a group in each view
+    set normGroup [$w.zinc add group normview]
+    $w.zinc translate $normGroup $x 60 yes
+    set magGroup [$w.zinc add group magview]
+    $w.zinc translate $magGroup $x 60 yes
+    #
+    # Reference color on a ball shaped item.
+    set refBall [$w.zinc add arc $normGroup {{-30 -30} {30 30}} \
+          -fillcolor "=radial -12 -20|white 0|$satColor 40|$shadColor 100" \
+          -linewidth 2 -filled 1]
+    #
+    # Clone the reference ball and move it into the magview group
+    $w.zinc chggroup [$w.zinc clone $refBall] $magGroup
+    #
+    # Add the color name in magview
+    $w.zinc add text $magGroup -text $colorName -anchor center \
+         -alignment center -font magfont -spacing 2
+    #
+    # Create the color samples (Multi contours curve)
+    set gradientBar [$w.zinc add curve $normGroup {} -linewidth 2 \
+         -filled 1 -fillcolor "=axial 270|$satColor|$greyColor"]
+    #
+    # Create intermediate steps between colors (saturated -> unsaturated)
+    set c 0
+    foreach color [CreateGraduate 11 $satColor $greyColor] {
+      # Create a zinc item for the color
+      set sample [$w.zinc clone $refBall -fillcolor $color]
+      $w.zinc translate $sample 0 [expr {65*($c+1)}]
+      # 
+      # Add its shape to the multi-contours gradient bar
+      $w.zinc contour $gradientBar add 1 $sample
+      #
+      # Move the item to the maggroup
+      $w.zinc chggroup $sample $magGroup
+      # 
+      # Text of label Saturation % + Color.
+      set sampleText [$w.zinc add text $magGroup -text "[expr {((10 - $c)*10)}]%\n$color" \
+          -anchor center -alignment center -font nfont -composescale no]
+      $w.zinc translate $sampleText 0 [expr {65*($c+1)}]
+      incr c
     }
-
-    # Create the lens itself
-    variable lensGroup [$zinc add group 1 -priority 300 -atomic 1 -tags lens]
-    $zinc coords $lensGroup {300 110}
-    variable dx 0
-    variable 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
-
-    variable consigne [$zinc add text 1 -position {30 840} -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"]
-
-    variable cClone [$zinc clone $consigne -font $font9b]
-    $zinc chggroup $cClone $infoView
-
-    SetBindings
+    incr x 80
+  }
+  #
+  # Add the caption text.
+  $w.zinc add text normview -position {30 840} -font nfont -tags blurb -color white \
+      -text "Move the Magic Lens on a color to see the color value and saturation"
+  $w.zinc chggroup [$w.zinc clone blurb -font magfont] magview
+  #
+  # Lens motion callback proc.
+  proc LensMove {x y} {
+    variable w
+    variable zoom
+    $w.zinc translate lens $x $y yes
+    $w.zinc translate magview [expr {$x * (1-$zoom)}]  [expr {$y * (1-$zoom)}] yes
+  }
+  #
+  # The bindings needed to drag the lens.
+  $w.zinc bind lens <B1-Motion> {::magicLens::LensMove %x %y}
+  #
+  # Lets put the lens somewhere within the window area.
+  LensMove 300 110
 }