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/groupsInAtcStrips.tcl | 1230 ++++++++++++++----------------------------- demos/magicLens.tcl | 461 ++++++---------- 2 files changed, 560 insertions(+), 1131 deletions(-) (limited to 'demos') diff --git a/demos/groupsInAtcStrips.tcl b/demos/groupsInAtcStrips.tcl index 808b625..7634661 100644 --- a/demos/groupsInAtcStrips.tcl +++ b/demos/groupsInAtcStrips.tcl @@ -3,14 +3,8 @@ # Copyright (C) 2002 # Centre d'Études de la Navigation Aérienne # -# Authors: Jean-Luc Vinot for whole graphic design and coding -# Christophe Mertz for adding simple animations -# and integration in zinc-demos -# This integration is still not perfect and requires an extension in zinc -# We must know if a named gradient already exists, when launching -# many time the same demo in the same process! -# -# $Id: +# Authors: Jean-Luc Vinot for the graphic design +# Patrick Lecoanet for the tcl code. #----------------------------------------------------------------------------------- # This small application illustrates both the use of groups in combination # of -composescale attributes and an implementation of kind of air traffic @@ -36,41 +30,33 @@ # $delay and $steps. # #----------------------------------------------------------------------------------- -# -# Ported to Tcl by P.Lecoanet - if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } -#package require profiler -#::profiler::init namespace eval groupsInAtcStrips { - variable w .groupsInAtcStrips + variable w .groupsInAtcStrips - catch {destroy $w} - toplevel $w - wm title $w "Atc electronic strips using groups" - wm iconname $w groupsInAtcStrips + catch {destroy $w} + toplevel $w + wm title $w "Atc electronic strips using groups" + wm iconname $w groupsInAtcStrips - variable defaultfont [font create -family Helvetica -size 10 -weight bold] - variable imagePath [file join $::zinc_demos images] + 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 - 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 + ########################################### + # Text zone + ####################### + #################### - ########################################### - # Text zone - ####################### - #################### + grid [text $w.text -relief sunken -borderwidth 2 -height 5] \ + -row 0 -column 0 -columnspan 2 -sticky ew - grid [text $w.text -relief sunken -borderwidth 2 -height 5] \ - -row 0 -column 0 -columnspan 2 -sticky ew - - $w.text insert end {These fake air Traffic Control electronic strips illustrates + $w.text insert end {These fake air Traffic Control electronic strips illustrates the use of groups for an advanced graphic design. The following interactions are possible: "drag&drop button1" on the callsign. @@ -79,824 +65,388 @@ namespace eval groupsInAtcStrips { "double click 1" on the blueish zone to fully reduce size} - ########################################### - # Zinc - ########################################## - image create photo texture -file \ - [file join $::zinc_demos images background_texture.gif] - - grid [zinc $w.zinc -render 1 -width 700 -height 500 -borderwidth 0 \ - -lightangle 130 -tile texture] -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 stripGradients {} - variable stripFontSet {} - - - variable delay 50; # ms between each animation steps - variable steps 6; # number of steps for the animation - # scales() # this hash just memorizes the current x and y scaling ratio - # In a real appli, this should be memorized in strip objects - - #---------------------- - # configuration data - #---------------------- - - variable ratio2FontSet {{1.2 normal} {10 large}} - - set loadedFonts [font names] - foreach f $loadedFonts { - if { [regexp {^radar-} $f] } { - font delete $f - } - } - - # cenapii-radar-b15 - font create radar-b15 -family helvetica -size 16 -slant roman -weight bold - # cenapii-digistrips-b12 - font create radar-b12 -family helvetica -size 12 -slant roman -weight bold - # cenapii-digistrips-b10 and cenapii-digistrips-b10c - font create radar-b10 -family helvetica -size 10 -slant roman -weight bold - # cenapii-radar-m18 - font create radar-m18 -family helvetica -size 18 -slant roman -weight normal - # cenapii-radar-m20 - font create radar-m20 -family helvetica -size 20 -slant roman -weight normal - - variable stripStyle { - gradSet { - idnt {=axial 90|#ffffff 0|#ffeedd 30|#e9d1ca 90|#e9a89a} - back {#c1daff|#8aaaff} - shad {=path -40 -40|#000000;50 0|#000000;50 92|#000000;0 100} - btnOutside #ffeedd|#8a9acc - btnInside {=axial 180|#ffeedd|#8a9acc} - ch1 {#8aaaff|#5b76ed} - } - fontSet { - normal { - callsign radar-b15 - type1 radar-b12 - type2 radar-b10 - type3 radar-b10 - } - large { - callsign radar-m20 - type1 radar-m18 - type2 radar-b15 - type3 radar-b12 - } - } - width 340 - height 86 - shadowcoords {8 8 374 94} - shadowcolor shad - strip { - linewidth 3 - linecolor \#aaccff - fillcolor back - relief roundraised - } - buttons { - coords {340 0} - clipcoords {0 0 90 83} - zone { - coords {0 0 26 85} - fillcolor btnOutside - linewidth 0 - } - btns { - btnup { - coords {0 0 26 43} - arrow {14 2 24 40 1 40 14 2} - linewidth 1 - linecolor \#aabadd - fillcolor btnInside - label { - coords {13 27} - text + - font radar-m20 - color \#ffffff - anchor center - } - } - btndn { - coords {0 43 26 86} - arrow {14 83 24 43 1 43 14 83} - linewidth 1 - linecolor \#aabadd - fillcolor btnInside - label { - coords {13 56} - text - - font radar-m20 - color \#ffffff - anchor center - } - } - } - } - clipcoords {3 3 332 80} - zones { - ident { - coords {3 3 90 50} - atomic 1 - priority 200 - sensitive 1 - tags move - linewidth 1 - filled 1 - relief sunken - linecolor \#ffeedd - fillcolor idnt - fields { - callsign { - coords {10 18} - font callsign - text EWG361 - anchor w - color \#000000 - } - company { - coords {10 34} - font type2 - text Eurowing - anchor w - color \#444444 - } - } - } - input { - coords {3 3 334 82} - atomic 1 - priority 100 - sensitive 1 - tags scale - linewidth 0 - filled 1 - relief flat - linecolor white - fillcolor back # \#afb2cc - fields { - type { - coords {100 18} - font type1 - text TYPA - anchor w - color \#444444 - } - cfmu { - coords {200 18} - font type1 - text 08:26 - anchor e - color \#444444 - } - ptsid { - coords {100 40} - font type2 - text NIPOR - anchor w - color \#444444 - } - confsid { - coords {158 40} - font type2 - text 8G - anchor center - color \#444444 - } - park { - coords {200 40} - font type2 - text G23 - anchor e - color \#444444 - } - dest { - coords {10 66} - font type2 - text DEST - anchor w - color \#555555 - } - champ1 { - type rect - coords {45 56 135 76} - filled 1 - fillcolor ch1 - linecolor white - linewidth 0 - } - bret { - coords {200 66} - font type2 - text Bret. - anchor e - color \#444444 - } - } - } - zreco { - coords {210 3 346 82} - atomic 1 - priority 200 - texture stripped_texture.gif - sensitive 1 - tags edit - linewidth 2 - filled 1 - relief sunken - linecolor \#deecff - fillcolor \#d3e5ff - } - } - zinfo { - coords {0 86} - rectcoords {0 0 340 20} - shadowcoords {8 8 348 28} - shadowcolor shad - atomic 1 - priority 200 - sensitive 1 - tags edit2 - linewidth 2 - linecolor \#aaccff - fillcolor back - relief roundraised - fields { - ssr { - coords {4 10} - font type3 - text 7656 - anchor w - color \#444444 - } - pdep { - coords {47 10} - font type3 - text G23 - anchor center - color \#444444 - } - qfu { - coords {73 10} - font type3 - text 09R - anchor center - color \#444444 - } - slabel { - coords {105 10} - font type3 - text vit: - anchor e - color \#444444 - } - speed { - coords {106 10} - font type3 - text 260 - anchor w - color \#444444 - } - pper { - coords {142 10} - font type3 - text EPL - anchor center - color \#444444 - } - rfl { - coords {166 10} - font type3 - text 210 - anchor center - color \#444444 - } - cautra { - coords {183 10} - font type3 - text 8350 - anchor w - color \#444444 - } - nsect { - coords {219 10} - font type3 - text MOD - anchor w - color \#444444 - } - day { - coords {297 10} - font type3 - text 21/05/02 - anchor e - color \#444444 - } - hour { - coords {332 10} - font type3 - text 13:50 - anchor e - color \#444444 - } - } - - } - } - - - - proc TLGetHash {list tag} { - array set temp $list - if { [info exists temp($tag)] } { - return $temp($tag) - } - return "" - } - - proc TLGet {list tag} { - foreach {key val} $list { - if { [string compare $key $tag] == 0 } { - # puts "TLGet found \"$val\" for \"$key\"" - return $val - } - } - # puts "Unknown tag $tag in $list" - return "" - } - - - # Création du Strip - proc createStrip {index x y style} { - variable w - variable stripGradients - variable stripFontSet - variable textures - variable imagePath - - # initialise les gradients - if { [llength $stripGradients] == 0 } { - foreach {name gradient} [TLGet $style gradSet] { - # création des gradiants nommés - if {! [$w.zinc gname $name]} { - $w.zinc gname $gradient $name - } - # the previous test is usefull only - # when this script is executed many time in the same process - # (it is typically the case in zinc-demos) - lappend stripGradients $name - } - } - - # initialise les jeux de fontes - if { ![llength $stripFontSet] } { - set stripFontSet [TLGet $style fontSet] - } - - # création du groupe de base : coords - set g1 [$w.zinc add group 1 -priority 100 -tags "base$index"] - $w.zinc coords $g1 [list $x $y] - - # group de transfo 1 : scaling (à partir du coin haut droit) - set g2 [$w.zinc add group $g1 -tags "scaling$index"] - - #------------------------------------------------------------- - # réalisation du strip lui même (papier support + ombre portée - #------------------------------------------------------------- - - # params strip - set stripw [TLGet $style width] - set striph [TLGet $style height] - - # ombre portée - $w.zinc add rectangle $g2 [TLGet $style shadowcoords] \ - -filled 1 -linewidth 0 -fillcolor [TLGet $style shadowcolor] \ - -priority 10 -tags "shadow$index" - - # strip - set sstyle [TLGet $style strip] - set strip [$w.zinc add rectangle $g2 [list 0 0 $stripw $striph] -filled 1 \ - -linewidth [TLGet $sstyle linewidth] \ - -linecolor [TLGet $sstyle linecolor] \ - -fillcolor [TLGet $sstyle fillcolor] \ - -relief [TLGet $sstyle relief] \ - -priority 20 -tags "strip$index"] - - set texName [TLGet $sstyle texture] - if { [llength $texName] != 0 } { - if { ! [info exists textures(strip)] } { - set textures(strip) [image create photo -file [file join $imagePath $texName]] - } - $w.zinc itemconfigure $strip -tile $textures(strip) - } - - - #------------------------------------------------- - # ajout de la zone des boutons (à droite du strip) - #------------------------------------------------- - set bStyle [TLGet $style buttons] - if { [llength $bStyle] != 0 } { - # le groupe de la zone bouton - set btnGroup [$w.zinc add group $g2 -priority 40] - $w.zinc coords $btnGroup [TLGet $bStyle coords] - - # sa zone de clipping - set btnClip [$w.zinc add rectangle $btnGroup [TLGet $bStyle clipcoords] \ - -filled 0 -visible 0] - - # le clipping du groupe bouton - $w.zinc itemconfigure $btnGroup -clip $btnClip - - # zone bouton - set bZone [TLGet $bStyle zone] - $w.zinc add rectangle $btnGroup [TLGet $bZone coords] \ - -filled 1 -linewidth [TLGet $bZone linewidth] \ - -fillcolor [TLGet $bZone fillcolor] -composescale 0 \ - -tags "content$index" - - set btns [TLGet $bStyle btns] - foreach {name btnStyle} $btns { - # puts "bouton $name $btnStyle" - - set sGroup [$w.zinc add group $btnGroup -atomic 1 -sensitive 1 \ - -composescale 0 -tags [list "$name$index" "content$index"]] - - $w.zinc add rectangle $sGroup [TLGet $btnStyle coords] \ - -filled 1 -visible 0 -priority 100 - $w.zinc add curve $sGroup [TLGet $btnStyle arrow] \ - -closed 1 -filled 1 -priority 50 \ - -linewidth [TLGet $btnStyle linewidth] \ - -linecolor [TLGet $btnStyle linecolor] \ - -fillcolor [TLGet $btnStyle fillcolor] - set lab [TLGet $btnStyle label] - $w.zinc add text $sGroup -priority 60 \ - -position [TLGet $lab coords] -text [TLGet $lab text] \ - -font [TLGet $lab font] -color [TLGet $lab color] \ - -anchor [TLGet $lab anchor] - } - - # bindings boutons Up et Down du Strip - $w.zinc bind "btnup$index" <1> ::groupsInAtcStrips::extendedStrip - $w.zinc bind "btndn$index" <1> ::groupsInAtcStrips::smallStrip - } - - # construction du contenu du strip - buildContent $index $g2 100 $style - - # et de la barre d'extension info (extended format) - buildExtent $index $g2 [TLGet $style zinfo] - } - - # Construction des zones internes du Strips - proc buildContent {index parent priority style} { - variable w - variable textures - variable stripFontSet - variable imagePath - - # group content - set g3 [$w.zinc add group $parent -priority $priority] - - # zone de clipping - set clip [$w.zinc add rectangle $g3 [TLGet $style clipcoords] \ - -filled 0 -visible 0] - - # clipping du groupe content - $w.zinc itemconfigure $g3 -clip $clip - - # création d'un group intermédiaire pour bloquer le scaling - set g4 [$w.zinc add group $g3 -composescale 0 -tags "content$index"] - - # création des zones - set zones [TLGet $style zones] - foreach {name zoneStyle} $zones { - # group de zone - set gz [$w.zinc add group $g4] - - if { [TLGet $zoneStyle atomic] } { - $w.zinc itemconfigure $gz -atomic 1 \ - -sensitive [TLGet $zoneStyle sensitive] \ - -priority [TLGet $zoneStyle priority] \ - -tags [concat "$name$index" [TLGet $zoneStyle tags]] - } - - set rectZone [$w.zinc add rectangle $gz [TLGet $zoneStyle coords] \ - -filled [TLGet $zoneStyle filled] \ - -linewidth [TLGet $zoneStyle linewidth] \ - -linecolor [TLGet $zoneStyle linecolor] \ - -fillcolor [TLGet $zoneStyle fillcolor] \ - -relief [TLGet $zoneStyle relief] \ - -priority 10 -tags "$name$index"] - - set texName [TLGet $zoneStyle texture] - if { [llength $texName] != 0 } { - if { ! [info exists textures($name)] } { - set textures($name) [image create photo \ - -file [file join $imagePath $texName]] - } - $w.zinc itemconfigure $rectZone -tile $textures($name) - } - - set fields [TLGet $zoneStyle fields] - set fontStyle [TLGet $stripFontSet normal] - foreach {field fieldStyle} $fields { - set fsType [TLGet $fieldStyle type] - if { $fsType == "rect" } { - $w.zinc add rectangle $gz [TLGet $fieldStyle coords] \ - -filled [TLGet $fieldStyle filled] \ - -fillcolor [TLGet $fieldStyle fillcolor] \ - -linewidth [TLGet $fieldStyle linewidth] \ - -linecolor [TLGet $fieldStyle linecolor] \ - -priority 20 - } else { - set font [TLGet $fieldStyle font] - # puts "buildContent field:$field font:$font" - $w.zinc add text $gz -position [TLGet $fieldStyle coords] \ - -text [TLGet $fieldStyle text] \ - -font [TLGet $fontStyle $font] \ - -color [TLGet $fieldStyle color] \ - -anchor [TLGet $fieldStyle anchor] \ - -priority 30 -tags "$font$index" - } - } - } - } + font create dfont -family Helvetica -size 10 -weight bold + font create radar-b15 -family helvetica -size 16 -slant roman -weight bold + font create radar-b12 -family helvetica -size 12 -slant roman -weight bold + font create radar-b10 -family helvetica -size 10 -slant roman -weight bold + font create radar-m18 -family helvetica -size 18 -slant roman -weight normal + font create radar-m20 -family helvetica -size 20 -slant roman -weight normal + + set fontsets(scales) {1.2 normal 10 large} + set fontsets(normal,callsign) radar-b15 + set fontsets(normal,type1) radar-b12 + set fontsets(normal,type2) radar-b10 + set fontsets(normal,type3) radar-b10 + set fontsets(large,callsign) radar-m20 + set fontsets(large,type1) radar-m18 + set fontsets(large,type2) radar-b15 + set fontsets(large,type3) radar-b12 + + image create photo backtex -data { + R0lGODlhIAAgAPcAALi4uLe3t7a2trS0tLOzs7KysrGxsbCwsK+vr66urq2traysrKurq6qq + qqmpqaioqKenp6ampqWlpaSkpKOjo6KioqGhoaCgoJ+fn56enp2dnZycnJubm5qampmZmZiY + mJeXl5aWlpWVlZSUlJOTk5KSkpGRkZCQkI+Pj46Ojo2NjYyMjIuLi4qKiomJiYiIiIeHh4aG + hoWFhYSEhIODg4KCgoGBgYCAgH9/f35+fn19fXx8fHt7e3p6enl5eXh4eHR0dAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAAAAAAALAAAAAAgACAABwj/ADto4ABCAwgS + Ijps4NAhA4cJE0SIcJjhggUKDxxcGBEixAiGAz04oEDwQ4cQJjiU+MBhxAcNIzZMkGDBQgQI + FDyEwGCBw4YNHShQMFhQQwcLIj5sAMEhAwkOEiSczFABQ0uaHjowLLhBxM4IEi54wFCBZQUO + HixgGCECw9oPKSRw+OChroYJFECY+JAhQwkTGjCUGHEBgwi0JTo8qHCCA4oHHT6w1GBwRIcJ + DyxIrvAgwswKGz5SnLD2RImHHRRqWNjUQoULGfZ2ABGi6VIMeCVAEEwhAwYKEkMUvPD652+X + IVCkCBGYpwXfFTKEgKCho3AQIDAU3lB3A2wLGkSQ/zhawUJX00o1ZBCRIsXF1+A/gMjqwaTb + urgnfCCB4sQIEArNRsIIE0RQgXonhZDVByKogFx2Qik3wm8ZyKdgZEKpBOBCHmDnAQl0SbRB + TSKYIMIFE2hAFwoeZOBBZx2ckBIFmrmEgQQPUHASB27lZSIIInhQAQp3XbDdWB+gwIKD3vGF + F3caULBAByqY4AGPETAwAVomWQABCHT5NJtlGag1l0AcmLCcehdI4IAFIJRwAgkXMJBUYBl0 + MMIJUeGlVl8ooECCdxlocEEEPYVQAgkeXAAUCCMM5oEGDDwwQQXlZbBBCSF4Z5VWq6n30wcj + DBSnCSFckKNVdXUYZGCrbf/gG1sbVDBTeEwV6hNnhUbmoUKazmeBBBNEpgFNE4BXwlisanCW + enONRdMFHYBoa19eWbUBT/95IEKgIPgF4EGl6rYlpxdoYCIMMgSqkAgSJLDABTx6oAIEB26b + 7pUkgBCVVhC0KFAGGVFgAoACVUABBpbCtlpkHiw6V5UYrHCCg3xVyGC4GPxkJGwdiFDCoubJ + GoIKJICWZgiupesABhl49kEImvrWkgkuUVBBVBuAOEEDEoAZ3U9yQRWBehB4VxVDVDF1UXiH + HehfV0HS25BDI2bFAUMcGApimfQCaWAIH4QlJXEZAClZTBB3HapvxIEWQgQRbE1qBxF8ABsJ + JFRaBAIDiFYQwQPIWl1mzymUkMKgW28QQa1vahduX5T3hUEDcFIWQgeAURAa2R8kXSZ2HNBp + kWuYnnX0eBzUNkIGQ3WgHQaPu3XYUOq5BXOhG0iwaUO1pvBfCAEBADs= + } + + image create photo striptex -data { + R0lGODlhCgBQAID/ALbd9tnn6ywAAAAACgBQAAACNYyPmcDtCqN0FMiL68Nc6daFx8eIImmZ + HaquZMux8CXPUW17bw7h/Lj7IXxC4s/IQ+aUNmYBADuioNSSFFMFXrHZ7mMr8YpZ4LE5AX6d + m+X1Oe1+t+NiOJ1UAAA7 + } + + ########################################## + # Zinc + ########################################## + grid [zinc $w.zinc -render 1 -width 700 -height 500 -borderwidth 0 \ + -lightangle 130 -tile backtex] -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 + + $w.zinc gname {=axial 90|#ffffff 0|#ffeedd 30|#e9d1ca 90|#e9a89a} idnt + $w.zinc gname {#c1daff|#8aaaff} back + $w.zinc gname {=path -40 -40|#000000;50 0|#000000;50 92|#000000;0 100} shad + $w.zinc gname {#ffeedd|#8a9acc} btnOutside + $w.zinc gname {=axial 180|#ffeedd|#8a9acc} btnInside + $w.zinc gname {#8aaaff|#5b76ed} ch1 + + set anim(delay) 50; # ms between each animation steps + set anim(steps) 6; # number of steps for the animation + + # + # The strip building routine + proc Strip { } { + variable scale + variable w + # + # Creating the object group + set stripG [$w.zinc add group 1] + # + # Add a group for all items that will need scaling + set scaleG [$w.zinc add group $stripG -tags scaling] + # + # Add add background shadow + $w.zinc add rectangle $scaleG {8 8 374 94} -filled 1 -linewidth 0 \ + -fillcolor shad -tags shadow + # + # This is the strip background + $w.zinc add rectangle $scaleG {0 0 340 86} -filled 1 \ + -linewidth 3 -linecolor {#aaccff} -fillcolor back -relief roundraised + # + # Add a group for the two size change buttons. + set btnGroup [$w.zinc add group $scaleG] + $w.zinc translate $btnGroup 340 0 true + # + # Clip the button group to a rectangular shape that will + # be scaled with the rest of the strip. + $w.zinc itemconfigure $btnGroup -clip [$w.zinc add rectangle $btnGroup {0 0 90 83} -visible no] + # + # Here the cylindrical background of the button area. + # The scale is not inherited to preserve the cylindrical + # relief of the area, this is explain the need for a + # clipping on btnGroup. + $w.zinc add rectangle $btnGroup {0 0 26 85} -filled 1 -linewidth 0 \ + -fillcolor btnOutside -composescale 0 -tags content - # Construction de la barre d'extension info du Strip - proc buildExtent {index parent infoStyle} { - variable w - variable textures - variable stripFontSet - variable imagePath - - # group content - set extGroup [$w.zinc add group $parent] - $w.zinc coords $extGroup [TLGet $infoStyle coords] - $w.zinc itemconfigure $extGroup -visible 0 \ - -atomic [TLGet $infoStyle atomic] \ - -sensitive [TLGet $infoStyle sensitive] \ - -priority [TLGet $infoStyle priority] \ - -tags [concat "zinfo$index" [TLGet $infoStyle tags]] - - # ombre portée - $w.zinc add rectangle $extGroup [TLGet $infoStyle shadowcoords] \ - -filled 1 -linewidth 0 -priority 10 -tags "shadow$index" \ - -fillcolor [TLGet $infoStyle shadowcolor] - - set rectZone [$w.zinc add rectangle $extGroup [TLGet $infoStyle rectcoords] \ - -filled 1 -priority 20 \ - -linewidth [TLGet $infoStyle linewidth] \ - -linecolor [TLGet $infoStyle linecolor] \ - -fillcolor [TLGet $infoStyle fillcolor] \ - -relief [TLGet $infoStyle relief]] - - set texName [TLGet $infoStyle texture] - if { [llength $texName] != 0 } { - if { ! [info exists textures(zinfo)] } { - set textures(zinfo) [image create photo \ - -file [file join $imagePath $texName]] - } - $w.zinc itemconfigure $rectZone -tile $textures(zinfo) - } - - set fields [TLGet $infoStyle fields] - set fontStyle [TLGet $stripFontSet normal] - foreach {field fieldStyle} $fields { - set fsType [TLGet $fieldStyle type] - if { $fsType == "rect" } { - $w.zinc add rectangle $extGroup [TLGet $fieldStyle coords] \ - -filled [TLGet $fieldStyle filled] \ - -fillcolor [TLGet $fieldStyle fillcolor] \ - -linewidth [TLGet $fieldStyle linewidth] \ - -linecolor [TLGet $fieldStyle linecolor] \ - -priority 40 - } else { - set font [TLGet $fieldStyle font] - # puts "buildContent field:$field font:$font" - $w.zinc add text $extGroup -position [TLGet $fieldStyle coords] \ - -text [TLGet $fieldStyle text] \ - -font [TLGet $fontStyle $font] \ - -color [TLGet $fieldStyle color] \ - -anchor [TLGet $fieldStyle anchor] \ - -priority 50 -tags "$font$index" - } - } - } - - # initialisation des bindings généraux dy Strip - proc initBindings {moveTag scaleTag} { - variable w - - $w.zinc bind $moveTag <1> "::groupsInAtcStrips::catchStrip %x %y" - $w.zinc bind $moveTag ::groupsInAtcStrips::releaseStrip - $w.zinc bind $moveTag "::groupsInAtcStrips::motionStrip %x %y" - - $w.zinc bind $scaleTag ::groupsInAtcStrips::microStrip - } - - # Callback CATCH de début de déplacement du Strip - proc catchStrip {x y} { - variable w - variable dx - variable dy - - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] - foreach {lx ly} [$w.zinc coords "base$index"] break - set dx [expr $lx - $x] - set dy [expr $ly - $y] - - $w.zinc itemconfigure "base$index" -priority 200 - } - - # Callback MOVE de fin de déplacement du Strip - proc motionStrip {x y} { - variable w - variable dx - variable dy - - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] - $w.zinc coords "base$index" [list [expr $x + $dx] [expr $y + $dy]] - } - - # Callback RELEASE de fin de déplacement du Strip - proc releaseStrip {} { - variable w - - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] - $w.zinc itemconfigure "base$index" -priority 100 - } - - # Zoom Strip : normal format - proc normalStrip {} { - variable w - - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] - $w.zinc itemconfigure "input$index" -sensitive 1 - - displayRecoZone $index 1 - displayExtentZone $index 0 - configButtons $index extendedStrip smallStrip - changeStripFormat $index 1 1 0 1 - } - - # Zoom Strip : small format (lignes 1 et 2) - proc smallStrip {} { - variable w - - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] - - displayRecoZone $index 0 - configButtons $index normalStrip 0 - changeStripFormat $index 1 0.63 0 1 - } - - # Zoom Strip : micro format (zone ident) - proc microStrip {} { - variable w - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] - - configButtons $index normalStrip 0 - changeStripFormat $index 0.28 0.63 0 1 - - } - - # Zoom Strip : extendedFormat - proc extendedStrip {} { - variable w - - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] - - $w.zinc itemconfigure "input$index" -sensitive 0 - $w.zinc itemconfigure "base$index" -priority 150 - displayRecoZone $index 0 - displayExtentZone $index 1 - configButtons $index 0 normalStrip - changeStripFormat $index 1.3 1.3 1 1.3 - } - - - # affiche/masque la zone Reco - proc displayRecoZone {index state} { - variable w - - set priority [expr $state ? 200 : 0] - $w.zinc itemconfigure "zreco$index" -priority $priority + ArrowButton $btnGroup + {0 0 26 43} {14 2 24 40 1 40 14 2} {13 27} [list $stripG more content] + ArrowButton $btnGroup - {0 43 26 86} {14 83 24 43 1 43 14 83} {13 56} [list $stripG less content] + + # + # This group will get the strip useful content. Its area is clipped. + set clippedContent [$w.zinc add group $scaleG] + $w.zinc itemconfigure $clippedContent \ + -clip [$w.zinc add rectangle $clippedContent {3 3 332 80} -visible 0] + # + # One more group to control whether the scale is inherited or not. + set content [$w.zinc add group $clippedContent -composescale 0 -tags content] + # + # The strip is divided into functional textual zones. + # They are created here. + set input [Zone $content {3 3 334 82} 0 white back {} flat [list $stripG scale input]] + TextField $input TYPA type1 {100 18} {#444444} w + TextField $input 08:26 type1 {200 18} {#444444} e + TextField $input NIPOR type2 {100 40} {#444444} w + TextField $input 8G type2 {158 40} {#444444} center + TextField $input G23 type2 {200 40} {#444444} e + TextField $input DEST type2 {10 66} {#555555} w + TextField $input Bret. type2 {200 66} {#444444} e + RectField $input {45 56 135 76} ch1 + + Zone $content {210 3 346 82} 2 {#deecff} {#d3e5ff} striptex sunken {zreco edit} + + set ident [Zone $content {3 3 90 50} 1 {#ffeedd} idnt {} sunken [list $stripG move]] + $w.zinc raise $ident + TextField $ident EWG361 callsign {10 18} {#000000} w + TextField $ident Eurowing type2 {10 34} {#444444} w + # + # Add and extension area beneath the main strip + # This extension is shown when the strip is shown in its + # extended form. + set extent [$w.zinc add group $scaleG -atomic yes -tags {zinfo edit2}] + $w.zinc translate $extent 0 86 true + # + # Add a background shadow. + $w.zinc add rectangle $extent {8 8 348 28} \ + -filled 1 -linewidth 0 -tags shadow -fillcolor shad + # + # This is the extention background + $w.zinc add rectangle $extent {0 0 340 20} -filled 1 \ + -linewidth 2 -linecolor {#aaccff} -fillcolor back -relief roundraised + TextField $extent 7656 type3 {4 10} {#444444} w + TextField $extent G23 type3 {47 10} {#444444} center + TextField $extent 09R type3 {73 10} {#444444} center + TextField $extent vit: type3 {105 10} {#444444} e + TextField $extent 260 type3 {106 10} {#444444} w + TextField $extent EPL type3 {142 10} {#444444} center + TextField $extent 210 type3 {166 10} {#444444} center + TextField $extent 8350 type3 {183 10} {#444444} w + TextField $extent MOD type3 {219 10} {#444444} w + TextField $extent 21/05/02 type3 {297 10} {#444444} e + TextField $extent 13:50 type3 {332 10} {#444444} e + DisplayExtentZone $stripG no + + # + # Preset the scale and font size of the layout + set scale($stripG,x) 1.0 + set scale($stripG,y) 1.0 + set scale($stripG,fontset) normal + + return $stripG + } + + proc ArrowButton {top text coords arrow labelpos tags} { + variable w + set sGroup [$w.zinc add group $top -atomic 1 -composescale 0 -tags $tags] + $w.zinc add rectangle $sGroup $coords -filled 1 -visible 0 + $w.zinc add curve $sGroup $arrow -closed 1 -filled 1 \ + -linewidth 1 -linecolor {#aabadd} -fillcolor btnInside + $w.zinc add text $sGroup -position $labelpos -text $text \ + -font radar-m20 -color {#ffffff} -anchor center + } + + proc RectField {top coords fillcolor} { + variable w + $w.zinc add rectangle $top $coords -linewidth 0 -filled yes \ + -fillcolor $fillcolor + } + + proc TextField {top text fonttype coords color anchor} { + variable w + variable fontsets + $w.zinc add text $top -position $coords -text $text -font $fontsets(normal,$fonttype) \ + -color $color -anchor $anchor -tags $fonttype + } + + proc Zone {top coords linewidth linecolor fillcolor texture relief tags} { + variable w + # + # Zone group + set gz [$w.zinc add group $top -atomic 1 -tags $tags] + # + # Zone background + set rectZone [$w.zinc add rectangle $gz $coords \ + -filled yes -linewidth $linewidth -linecolor $linecolor \ + -fillcolor $fillcolor -relief $relief] + if { $texture ne "" } { + $w.zinc itemconfigure $rectZone -tile $texture } + return $gz + } - # affiche/masque la zone Extent - proc displayExtentZone {index state} { - variable w - - $w.zinc itemconfigure "zinfo$index" -visible $state -sensitive $state - } - - # Configure affichage et callbacks des boutons du Strip - proc configButtons {index funcUp funcDown} { - variable w - - # button Up - if { $funcUp != 0 } { - $w.zinc itemconfigure "btnup$index" -visible 1 - $w.zinc bind "btnup$index" <1> ::groupsInAtcStrips::$funcUp - } { - $w.zinc itemconfigure "btnup$index" -visible 0 - } - - # button Down - if { $funcDown != 0 } { - $w.zinc itemconfigure "btndn$index" -visible 1 - $w.zinc bind "btndn$index" <1> ::groupsInAtcStrips::$funcDown - } { - $w.zinc itemconfigure "btndn$index" -visible 0 - } - } - + # + # Called when the user click on the strip's identification area. + proc CatchStrip {x y} { + variable w + variable dx + variable dy - # this function has been hacked to provide the user with an animation - # The animation is (too) simple but provide a better feedback than without - proc changeStripFormat {index xratio yratio composeflag fontratio} { - variable w - variable dx - variable dy - variable scales - variable steps - variable delay - - # réinitialisation du groupe scaling - $w.zinc treset "scaling$index" - - # configure le blocage de transformation du format des champs - $w.zinc itemconfigure "content$index" -composescale $composeflag - - # applique le nouveau scaling - if { ![info exists scales($index)] } { - set scales($index) {1 1} - } - foreach {oldXratio oldYratio} $scales($index) {} - set scales($index) [list $xratio $yratio] - set dx [expr ($xratio - $oldXratio) / $steps] - set dy [expr ($yratio - $oldYratio) / $steps] - _resize $index $delay [expr $oldXratio+$dx] [expr $oldYratio+$dy] $dx $dy $steps - setFontes $index $yratio + set strip [lindex [$w.zinc itemcget current -tags] 0] + foreach {lx ly} [$w.zinc coords $strip] break + set dx [expr {$lx - $x}] + set dy [expr {$ly - $y}] + $w.zinc raise $strip + } + + # + # Called when the mouse drag the strip + proc MotionStrip {x y} { + variable w + variable dx + variable dy + + set strip [lindex [$w.zinc itemcget current -tags] 0] + $w.zinc translate $strip [expr $x + $dx] [expr $y + $dy] true + } + + # + # ExtendedStrip, NormalStrip, SmallStrip, MicroStrip + # Those functions controls the transition from the current + # strip layout to the named layout. + # They are bonud to the resize buttons to the right of + # the strip. + proc NormalStrip {} { + variable w + set strip [lindex [$w.zinc itemcget current -tags] 0] + $w.zinc itemconfigure $strip*input -sensitive 1 + + DisplayRecoZone $strip yes + DisplayExtentZone $strip no + ConfigButtons $strip ExtendedStrip SmallStrip + ChangeStripFormat $strip 1 1 no + } + + proc SmallStrip {} { + variable w + set strip [lindex [$w.zinc itemcget current -tags] 0] + DisplayRecoZone $strip no + ConfigButtons $strip NormalStrip {} + ChangeStripFormat $strip 1 0.63 no + } + + proc MicroStrip {} { + variable w + set strip [lindex [$w.zinc itemcget current -tags] 0] + ConfigButtons $strip NormalStrip {} + ChangeStripFormat $strip 0.28 0.63 no + } + + proc ExtendedStrip {} { + variable w + set strip [lindex [$w.zinc itemcget current -tags] 0] + $w.zinc itemconfigure $strip*input -sensitive 0 + $w.zinc raise $strip + DisplayRecoZone $strip no + DisplayExtentZone $strip yes + ConfigButtons $strip {} NormalStrip + ChangeStripFormat $strip 1.3 1.3 yes + } + + # + # Controls the display of the gesture recognition area. + proc DisplayRecoZone {strip bool} { + variable w + $w.zinc itemconfigure $strip*zreco -visible $bool + } + + # + # Controls the display of the extended information area. + proc DisplayExtentZone {strip bool} { + variable w + $w.zinc itemconfigure $strip*zinfo -visible $bool -sensitive $bool + } + + # + # Update the scaling buttons to reflect the current + # layout of the strip. + proc ConfigButtons {strip funcUp funcDown} { + variable w + if { $funcUp ne "" } { + $w.zinc itemconfigure $strip*more -visible 1 + $w.zinc bind more <1> ::groupsInAtcStrips::$funcUp + } { + $w.zinc itemconfigure $strip*more -visible 0 } - - proc _resize {index delay newXratio newYratio dx dy steps} { - variable w - - $w.zinc treset "scaling$index" - $w.zinc scale "scaling$index" $newXratio $newYratio - # jeu de fontes - incr steps -1 - if { $steps > 0 } { - after $delay [list ::groupsInAtcStrips::_resize $index $delay [expr $newXratio+$dx] \ - [expr $newYratio+$dy] $dx $dy $steps] - } - #puts [::profiler::print] + if { $funcDown ne "" } { + $w.zinc itemconfigure $strip*less -visible 1 + $w.zinc bind less <1> ::groupsInAtcStrips::$funcDown + } { + $w.zinc itemconfigure $strip*less -visible 0 } - - proc getFKey {ratio} { - variable ratio2FontSet - - foreach param $ratio2FontSet { - foreach {maxRatio fKey} $param {} - set newfKey $fKey - if { $ratio < $maxRatio } { - return $newfKey; - } - } - - return $newfKey; + } + + # + # Change the strip size hiding information has needed. + # Uses an animation to highlight the state change to te user. + proc ChangeStripFormat {strip xscale yscale composeflag} { + variable w + variable scale + variable anim + # + # Adjust the scale inheritance of the content area + $w.zinc itemconfigure $strip*content -composescale $composeflag + # + # Compute the scaling animation and start it. + # At the same time if needed switch to bigger/smaller fonts. + set dx [expr {($xscale - $scale($strip,x)) / $anim(steps)}] + set dy [expr {($yscale - $scale($strip,y)) / $anim(steps)}] + set newXScale [expr {$scale($strip,x) + $dx}] + set newYScale [expr {$scale($strip,y) + $dy}] + set scale($strip,x) $xscale + set scale($strip,y) $yscale + SetFontes $strip + ::groupsInAtcStrips::ResizeAnim $strip $newXScale $newYScale $dx $dy $anim(steps) + } + + # + # This is the animation stepping function + proc ResizeAnim {strip xscale yscale dx dy steps} { + variable w + variable anim + $w.zinc treset $strip*scaling + $w.zinc scale $strip*scaling $xscale $yscale + incr steps -1 + if { $steps > 0 } { + after $anim(delay) [list ::groupsInAtcStrips::ResizeAnim $strip [expr {$xscale+$dx}] \ + [expr {$yscale+$dy}] $dx $dy $steps] } - - - proc setFontes {index ratio} { - variable w - variable stripFontSet - variable oldFKey - - set newFKey [getFKey $ratio] - if {![info exists oldFKey] || ([string compare $oldFKey $newFKey] != 0) } { - set fontStyle [TLGet $stripFontSet $newFKey] - #puts "setFontes $oldFKey -> $newFKey" - if { [llength $fontStyle] != 0 } { - foreach type {callsign type1 type2 type3} { - $w.zinc itemconfigure "$type$index" -font [TLGet $fontStyle $type] - } - } - set oldFKey $newFKey - } + } + + proc SetFontes {strip} { + variable w + variable scale + variable fontsets + # + # Find a fontset matching the current y scale + foreach {maxScale fs} $fontsets(scales) { + if { $scale($strip,y) < $maxScale } break } - - - # test Strips - for {set xn 10; set yn 30; set index 0} {$index < 4} {incr index; incr xn 50; incr yn 120} { - createStrip $index $xn $yn $stripStyle + if { $scale($strip,fontset) ne $fs } { + foreach type {callsign type1 type2 type3} { + $w.zinc itemconfigure $strip*$type -font $fontsets($fs,$type) + } } - - initBindings move scale + set scale($strip,fontset) $fs + } + # + # Initialization of user input bindings.. + $w.zinc bind more <1> ::groupsInAtcStrips::ExtendedStrip + $w.zinc bind less <1> ::groupsInAtcStrips::SmallStrip + $w.zinc bind move <1> {::groupsInAtcStrips::CatchStrip %x %y} + $w.zinc bind move {::groupsInAtcStrips::MotionStrip %x %y} + $w.zinc bind scale ::groupsInAtcStrips::MicroStrip + + # + # Generate a handful of strips + for {set xn 10; set yn 30; set i 0} {$i < 4} {incr i; incr xn 50; incr yn 120} { + $w.zinc translate [Strip] $xn $yn true + } } 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