From bd91dff5a3cb377ced2436119a0d8a5385ccffa5 Mon Sep 17 00:00:00 2001 From: lecoanet Date: Wed, 18 Oct 2006 12:34:46 +0000 Subject: Updated to a more simple and hopefully tclish script. Images are inlined. --- demos/magicLens.tcl | 461 +++++++++++++++++++--------------------------------- 1 file changed, 170 insertions(+), 291 deletions(-) (limited to 'demos/magicLens.tcl') 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 -# 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 {::magicLens::LensMove %x %y} - $zinc bind lens {::magicLens::LensStop %x %y} - - focus $w - - # Up, Down, Right, Left : Translate - bind $w {::magicLens::LensTranslate up} - bind $w {::magicLens::LensTranslate down} - bind $w {::magicLens::LensTranslate left} - bind $w {::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 ", , and keys or -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 {::magicLens::LensMove %x %y} + # + # Lets put the lens somewhere within the window area. + LensMove 300 110 } -- cgit v1.1