aboutsummaryrefslogtreecommitdiff
path: root/demos/groupsInAtcStrips.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'demos/groupsInAtcStrips.tcl')
-rw-r--r--demos/groupsInAtcStrips.tcl902
1 files changed, 0 insertions, 902 deletions
diff --git a/demos/groupsInAtcStrips.tcl b/demos/groupsInAtcStrips.tcl
deleted file mode 100644
index 0c7f4d9..0000000
--- a/demos/groupsInAtcStrips.tcl
+++ /dev/null
@@ -1,902 +0,0 @@
-#-----------------------------------------------------------------------------------
-#
-# 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:
-#-----------------------------------------------------------------------------------
-# This small application illustrates both the use of groups in combination
-# of -composescale attributes and an implementation of kind of air traffic
-# control electronic strips.
-# However it is only a simplified example given as is, without any immediate usage!
-#
-# 3 strips formats are accessible through "+" / "-" buttons on the right side
-#
-# 1. small-format: with 2 lines of info, and reduced length
-#
-# 2. normal-format: with 3 lines of info, full length
-#
-# 3. extended-format: with 3 lines of infos, full length
-# the 3 lines are zoomed
-# an additionnel 4th lone is displayed
-#
-# An additionnal 4th format (micro-format) is available when double-clicking somewhere...
-#
-# Strips can be moved around by drag&drop from the callsign
-#
-# When changing size, strips are animated. The animation is a very simple one,
-# which should be enhanced.... You can change the animation parameters, by modifyng
-# $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
-
- 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 [demosPath] 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
-
-
-
- ###########################################
- # Text zone
- #######################
- ####################
-
- 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}
-
-
- ###########################################
- # Zinc
- ##########################################
- image create photo texture -file \
- [file join [demosPath] 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"
- }
- }
- }
- }
-
- # 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
- }
-
-
- # 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
- }
- }
-
-
- # 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
- }
-
- 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]
- }
-
- proc getFKey {ratio} {
- variable ratio2FontSet
-
- foreach param $ratio2FontSet {
- foreach {maxRatio fKey} $param {}
- set newfKey $fKey
- if { $ratio < $maxRatio } {
- return $newfKey;
- }
- }
-
- return $newfKey;
- }
-
-
- 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
- }
- }
-
-
- # 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
-}
generated by cgit v1.1 at 2024-05-18 17:01:53 +0000