path: root/demos/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
#
#      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