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

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)]]
    }


    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 [demosPath] 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
    }

    # 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
}