diff options
author | lecoanet | 2004-05-07 10:51:56 +0000 |
---|---|---|
committer | lecoanet | 2004-05-07 10:51:56 +0000 |
commit | 0c518c95e4d1c3270fbc67143a6351ee81bb68f0 (patch) | |
tree | 3801ddfa41a67c88f216698d1e96257c2ee2a598 /demos/groupsInAtcStrips.tcl | |
parent | 1761ee2e8ad9f23ef9231ec9952c25ab2ac88439 (diff) | |
download | tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.zip tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.tar.gz tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.tar.bz2 tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.tar.xz |
Switched from pack to grid; Demos are put in a namespace
Diffstat (limited to 'demos/groupsInAtcStrips.tcl')
-rw-r--r-- | demos/groupsInAtcStrips.tcl | 1383 |
1 files changed, 702 insertions, 681 deletions
diff --git a/demos/groupsInAtcStrips.tcl b/demos/groupsInAtcStrips.tcl index f00accb..87e140c 100644 --- a/demos/groupsInAtcStrips.tcl +++ b/demos/groupsInAtcStrips.tcl @@ -46,818 +46,839 @@ if {![info exists zincDemo]} { #package require profiler #::profiler::init +namespace eval groupsInAtcStrips { + variable w .groupsInAtcStrips -set 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 -set defaultfont [font create -family Helvetica -size 10 -weight bold] -set imagePath [file join $zinc_library demos images] + variable defaultfont [font create -family Helvetica -size 10 -weight bold] + variable imagePath [file join $zinc_library demos images] -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + 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 + ####################### + #################### -text $w.text -relief sunken -borderwidth 2 -height 5 -pack $w.text -expand yes -fill both + 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 - the use of groups for an advanced graphic design. -The following interactions are possible: - "drag&drop button1" on the callsign. - "button 1" triangle buttons on the right side of the strips - to modify strips size - "double click 1" on the blueish zone to fully reduce size} + $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. + "button 1" triangle buttons on the right side of the strips + to modify strips size + "double click 1" on the blueish zone to fully reduce size} -########################################### -# Zinc -########################################## -image create photo texture -file \ - [file join $zinc_library demos images background_texture.gif] + ########################################### + # Zinc + ########################################## + image create photo texture -file \ + [file join $zinc_library demos images background_texture.gif] -zinc $w.zinc -render 1 -width 700 -height 500 -borderwidth 0 -lightangle 130 -tile texture -pack $w.zinc -fill both -expand 1 + 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 -set stripGradients {} -set stripFontSet {} + variable stripGradients {} + variable stripFontSet {} -set delay 50; # ms between each animation steps -set 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 + 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 -#---------------------- + #---------------------- + # configuration data + #---------------------- -set ratio2FontSet {{1.2 normal} {10 large}} + variable ratio2FontSet {{1.2 normal} {10 large}} -set 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 cenapii-radar-b15 - type1 cenapii-digistrips-b12 - type2 cenapii-digistrips-b10 - type3 cenapii-digistrips-b10c + 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} } - large { - callsign cenapii-radar-m20 - type1 cenapii-radar-m18 - type2 cenapii-radar-b15 - type3 cenapii-digistrips-b12 + fontSet { + normal { + callsign cenapii-radar-b15 + type1 cenapii-digistrips-b12 + type2 cenapii-digistrips-b10 + type3 cenapii-digistrips-b10c + } + large { + callsign cenapii-radar-m20 + type1 cenapii-radar-m18 + type2 cenapii-radar-b15 + type3 cenapii-digistrips-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 cenapii-radar-m20 - color \#ffffff - anchor center + 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 cenapii-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 cenapii-radar-m20 + color \#ffffff + anchor center + } } } - btndn { - coords {0 43 26 86} - arrow {14 83 24 43 1 43 14 83} + } + clipcoords {3 3 332 80} + zones { + ident { + coords {3 3 90 50} + atomic 1 + priority 200 + sensitive 1 + tags move linewidth 1 - linecolor \#aabadd - fillcolor btnInside - label { - coords {13 56} - text - - font cenapii-radar-m20 - color \#ffffff - anchor center + 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 + } } - } - clipcoords {3 3 332 80} - zones { - ident { - coords {3 3 90 50} + zinfo { + coords {0 86} + rectcoords {0 0 340 20} + shadowcoords {8 8 348 28} + shadowcolor shad atomic 1 priority 200 sensitive 1 - tags move - linewidth 1 - filled 1 - relief sunken - linecolor \#ffeedd - fillcolor idnt + tags edit2 + linewidth 2 + linecolor \#aaccff + fillcolor back + relief roundraised fields { - callsign { - coords {10 18} - font callsign - text EWG361 + ssr { + coords {4 10} + font type3 + text 7656 anchor w - color \#000000 + color \#444444 } - company { - coords {10 34} - font type2 - text Eurowing - anchor w + pdep { + coords {47 10} + font type3 + text G23 + anchor center 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 + qfu { + coords {73 10} + font type3 + text 09R + anchor center color \#444444 } - cfmu { - coords {200 18} - font type1 - text 08:26 + slabel { + coords {105 10} + font type3 + text vit: anchor e color \#444444 } - ptsid { - coords {100 40} - font type2 - text NIPOR + speed { + coords {106 10} + font type3 + text 260 anchor w color \#444444 } - confsid { - coords {158 40} - font type2 - text 8G + pper { + coords {142 10} + font type3 + text EPL anchor center color \#444444 } - park { - coords {200 40} - font type2 - text G23 - anchor e + rfl { + coords {166 10} + font type3 + text 210 + anchor center color \#444444 } - dest { - coords {10 66} - font type2 - text DEST + cautra { + coords {183 10} + font type3 + text 8350 anchor w - color \#555555 + color \#444444 } - champ1 { - type rect - coords {45 56 135 76} - filled 1 - fillcolor ch1 - linecolor white - linewidth 0 + nsect { + coords {219 10} + font type3 + text MOD + anchor w + color \#444444 } - bret { - coords {200 66} - font type2 - text Bret. + 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 } } + } - 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 + proc TLGetHash {list tag} { + array set temp $list + if { [info exists temp($tag)] } { + return $temp($tag) } - } -# puts "Unknown tag $tag in $list" - return "" -} - - -# Création du Strip -proc createStrip {index x y style} { - global w stripGradients stripFontSet textures 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 - } + return "" } - # initialise les jeux de fontes - if { ![llength $stripFontSet] } { - set stripFontSet [TLGet $style fontSet] + 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 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]] + # 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 + } } - $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 + # 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] - # 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" + # 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 - 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] + # 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 } - - # bindings boutons Up et Down du Strip - $w.zinc bind "btnup$index" <1> extendedStrip - $w.zinc bind "btndn$index" <1> 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 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} { - global w textures stripFontSet 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]] + # 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" + } + } } + } + + # 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 $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] + 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($name)] } { - set textures($name) [image create photo \ + if { ! [info exists textures(zinfo)] } { + set textures(zinfo) [image create photo \ -file [file join $imagePath $texName]] } - $w.zinc itemconfigure $rectZone -tile $textures($name) + $w.zinc itemconfigure $rectZone -tile $textures(zinfo) } - - set fields [TLGet $zoneStyle fields] + + 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 $gz [TLGet $fieldStyle coords] \ - -filled [TLGet $fieldStyle filled] \ - -fillcolor [TLGet $fieldStyle fillcolor] \ - -linewidth [TLGet $fieldStyle linewidth] \ - -linecolor [TLGet $fieldStyle linecolor] \ - -priority 20 + $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 $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" - } + $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" + } } } -} - - -# Construction de la barre d'extension info du Strip -proc buildExtent {index parent infoStyle} { - global w textures stripFontSet 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 } -} - -# initialisation des bindings généraux dy Strip -proc initBindings {moveTag scaleTag} { - global w - - $w.zinc bind $moveTag <1> "catchStrip %x %y" - $w.zinc bind $moveTag <ButtonRelease> releaseStrip - $w.zinc bind $moveTag <B1-Motion> "motionStrip %x %y" - - $w.zinc bind $scaleTag <Double-Button-1> microStrip -} -# Callback CATCH de début de déplacement du Strip -proc catchStrip {x y} { - global w dx 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 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} { - global w dx dy + # 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]] -} + 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 {} { - global w + # 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 -} + 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 {} { - global w + # 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 + 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 -} + 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 {} { - global w + # 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] + 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 -} + displayRecoZone $index 0 + configButtons $index normalStrip 0 + changeStripFormat $index 1 0.63 0 1 + } -# Zoom Strip : micro format (zone ident) -proc microStrip {} { - global 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 : 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 {} { - global w + # Zoom Strip : extendedFormat + proc extendedStrip {} { + variable w - set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end] + 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 -} + $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} { - global w + # affiche/masque la zone Reco + proc displayRecoZone {index state} { + variable w - set priority [expr $state ? 200 : 0] - $w.zinc itemconfigure "zreco$index" -priority $priority -} + set priority [expr $state ? 200 : 0] + $w.zinc itemconfigure "zreco$index" -priority $priority + } -# affiche/masque la zone Extent -proc displayExtentZone {index state} { - global w + # affiche/masque la zone Extent + proc displayExtentZone {index state} { + variable w - $w.zinc itemconfigure "zinfo$index" -visible $state -sensitive $state -} + $w.zinc itemconfigure "zinfo$index" -visible $state -sensitive $state + } -# Configure affichage et callbacks des boutons du Strip -proc configButtons {index funcUp funcDown} { - global w + # 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> $funcUp - } { - $w.zinc itemconfigure "btnup$index" -visible 0 - } + # 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> $funcDown - } { - $w.zinc itemconfigure "btndn$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 + } } -} -# 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} { - global w dx dy scales steps 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} + # 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 } - 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 -} -proc _resize {index delay newXratio newYratio dx dy steps} { - global w + 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 _resize $index $delay [expr $newXratio+$dx] [expr $newYratio+$dy] $dx $dy $steps] + $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] } -#puts [::profiler::print] -} -proc getFKey {ratio} { - global ratio2FontSet + proc getFKey {ratio} { + variable ratio2FontSet - foreach param $ratio2FontSet { - foreach {maxRatio fKey} $param {} - set newfKey $fKey - if { $ratio < $maxRatio } { - return $newfKey; + foreach param $ratio2FontSet { + foreach {maxRatio fKey} $param {} + set newfKey $fKey + if { $ratio < $maxRatio } { + return $newfKey; + } } - } - return $newfKey; -} + return $newfKey; + } -proc setFontes {index ratio} { - global w stripFontSet oldFKey + 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 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 } - set oldFKey $newFKey } -} -# 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 -} + # 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 + } -initBindings move scale + initBindings move scale +} |