diff options
Diffstat (limited to 'demos/groupsInAtcStrips.tcl')
| -rw-r--r-- | demos/groupsInAtcStrips.tcl | 1230 |
1 files changed, 390 insertions, 840 deletions
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 <vinot@cena.fr> for whole graphic design and coding -# Christophe Mertz <mertz@cena.fr> 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 <vinot@cena.fr> 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 <ButtonRelease> ::groupsInAtcStrips::releaseStrip - $w.zinc bind $moveTag <B1-Motion> "::groupsInAtcStrips::motionStrip %x %y" - - $w.zinc bind $scaleTag <Double-Button-1> ::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 <B1-Motion> {::groupsInAtcStrips::MotionStrip %x %y} + $w.zinc bind scale <Double-Button-1> ::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 + } } |