Changeset 2986 for branches/blt4/gui


Ignore:
Timestamp:
May 1, 2012, 9:37:59 AM (13 years ago)
Author:
gah
Message:
 
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/blt4/gui/scripts/drawingentry.tcl

    r2985 r2986  
    3737    public method tooltip {}
    3838
     39    private method AdjustDrawingArea { xAspect yAspect }
     40    private method Highlight { tag }
    3941    private method ParseDescription {}
    40     private method ParseLineDescription { cname }
    41     private method ParseGridDescription { cname }
    42     private method ParseTextDescription { cname }
    43     private method ParseStringDescription { cname }
    44     private method ParseNumberDescription { cname }
    45     private method AdjustDrawingArea { xAspect yAspect }
     42    private method ParseGrid { cpath cname }
     43    private method ParseHotspot { cpath cname }
     44    private method ParseLine { cpath cname }
     45    private method ParseOval { cpath cname }
     46    private method ParsePicture { cpath cname }
     47    private method ParsePolygon { cpath cname }
     48    private method ParseRectangle { cpath cname }
     49    private method ParseText { cpath cname }
     50    private method Redraw {}
     51    private method ScreenCoords { coords }
    4652    private method ScreenX { x }
    4753    private method ScreenY { y }
    48     private method ScreenCoords { coords }
    49     private method Highlight { tag }
    5054    private method Unhighlight { tag }
    51     private method Redraw {}
    5255}
    5356
    … …  
    179182}
    180183
    181 itcl::body Rappture::DrawingEntry::ParseLineDescription { cname } {
     184itcl::body Rappture::DrawingEntry::ParseLine { cpath cname } {
    182185    array set attr2option {
    183186        "linewidth"     "-width"
    … …  
    195198    # Coords
    196199    set coords {}
    197     set coords [$_owner xml get $_path.components.$cname.coords]
     200    set coords [$_owner xml get $cpath.coords]
    198201    set coords [string trim $coords]
    199202    if { $coords == "" } {
    … …  
    202205        set coords [ScreenCoords $coords]
    203206    }
    204     puts stderr "ParseLineDescrption description owner=$_owner path=$_path coords=$coords"
     207    puts stderr "ParseLineDescrption description owner=$_owner cpath=$cpath coords=$coords"
    205208    set list {}
    206     foreach attr [$_owner xml children $_path.components.$cname] {
     209    foreach attr [$_owner xml children $cpath] {
    207210        if { [info exists attr2option($attr)] } {
    208211            set option $attr2option($attr)
    209             set value [$_owner xml get $_path.components.$cname.$attr]
     212            set value [$_owner xml get $cpath.$attr]
    210213            set options($option) $value
    211214        }
    212215    }
     216    set options(-tags) $cname
    213217    puts stderr "$itk_component(drawing) create line $coords"
    214218    set id [eval $itk_component(drawing) create line $coords]
    … …  
    218222
    219223#
    220 # ParseGridDescription --
    221 #
    222 itcl::body Rappture::DrawingEntry::ParseGridDescription { cname } {
    223     puts stderr "ParseGridDescrption description owner=$_owner path=$_path"
    224     foreach attr [$_owner xml children $_path.components.$cname] {
     224# ParseGrid --
     225#
     226itcl::body Rappture::DrawingEntry::ParseGrid { cpath cname } {
     227    puts stderr "ParseGrid description owner=$_owner cpath=$cpath"
     228    foreach attr [$_owner xml children $cpath] {
    225229        puts stderr attr=$attr
    226230    }
    … …  
    239243    }
    240244    # Coords
    241     set xcoords [$_owner xml get $_path.components.$cname.xcoords]
     245    set xcoords [$_owner xml get $cpath.xcoords]
    242246    set xcoords [string trim $xcoords]
    243     set ycoords [$_owner xml get $_path.components.$cname.ycoords]
     247    set ycoords [$_owner xml get $cpath.ycoords]
    244248    set ycoords [string trim $ycoords]
    245249    if { $ycoords == "" } {
    … …  
    283287        set xcoords $list
    284288    }
    285     puts stderr "ParseLineDescrption description owner=$_owner path=$_path xcoords=$xcoords ycoords=$ycoords"
     289    puts stderr "ParseGrid description owner=$_owner cpath=$cpath xcoords=$xcoords ycoords=$ycoords"
    286290    set list {}
    287     foreach attr [$_owner xml children $_path.components.$cname] {
     291    foreach attr [$_owner xml children $cpath] {
    288292        if { [info exists attr2option($attr)] } {
    289293            set option $attr2option($attr)
    290             set value [$_owner xml get $_path.components.$cname.$attr]
     294            set value [$_owner xml get $cpath.$attr]
    291295            set options($option) $value
    292296        }
    293297    }
     298    set options(-tags) $cname
    294299    foreach y $ycoords {
    295300        lappend ids \
    … …  
    305310}
    306311
    307 itcl::body Rappture::DrawingEntry::ParseTextDescription { cname } {
     312itcl::body Rappture::DrawingEntry::ParseText { cpath cname } {
    308313    array set attr2option {
    309314        "font"          "-font"
    … …  
    313318        "anchor"        "-anchor"
    314319    }
    315     puts stderr "ParseStringDescrption description owner=$_owner path=$_path"
     320    puts stderr "ParseText description owner=$_owner cpath=$cpath"
    316321
    317322    # Set default options first and then let tool.xml override them.
    … …  
    322327        -anchor c
    323328    }
    324     foreach attr [$_owner xml children $_path.components.$cname] {
     329    foreach attr [$_owner xml children $cpath] {
    325330        if { [info exists attr2option($attr)] } {
    326331            set option $attr2option($attr)
    327             set value [$_owner xml get $_path.components.$cname.$attr]
     332            set value [$_owner xml get $cpath.$attr]
    328333            set options($option) $value
    329334        }
    … …  
    331336    # Coords
    332337    set coords {}
    333     set coords [$_owner xml get $_path.components.$cname.coords]
     338    set coords [$_owner xml get $cpath.coords]
    334339    set coords [string trim $coords]
    335340    if { $coords == "" } {
    … …  
    338343        set coords [ScreenCoords $coords]
    339344    }
     345    set options(-tags) $cname
    340346    puts stderr "$itk_component(drawing) create text $coords"
    341347    set id [eval $itk_component(drawing) create text $coords]
    … …  
    345351}
    346352
    347 itcl::body Rappture::DrawingEntry::ParseStringDescription { cname } {
     353itcl::body Rappture::DrawingEntry::ParseRectangle { cpath cname } {
    348354    array set attr2option {
    349         "font"          "-font"
    350         "default"       "-text"
    351         "color"         "-fill"
    352     }
    353     puts stderr "ParseStringDescrption description owner=$_owner path=$_path"
     355        "outline"       "-outline"
     356        "fill"          "-fill"
     357        "linewidth"     "-linewidth"
     358    }
     359    puts stderr "ParseRectangle description owner=$_owner cpath=$cpath"
    354360
    355361    # Set default options first and then let tool.xml override them.
    356362    array set options {
    357         -font {Arial 12}
    358         -text {}
    359         -fill black
    360     }
    361     foreach attr [$_owner xml children $_path.components.$cname] {
     363        -fill blue
     364        -linewidth 1
     365        -outline black
     366    }
     367    foreach attr [$_owner xml children $cpath] {
    362368        if { [info exists attr2option($attr)] } {
    363369            set option $attr2option($attr)
    364             set value [$_owner xml get $_path.components.$cname.$attr]
     370            set value [$_owner xml get $cpath.$attr]
    365371            set options($option) $value
    366372        }
    367373    }
    368     # Coords
     374    # Coordinates
    369375    set coords {}
    370     set coords [$_owner xml get $_path.components.$cname.coords]
     376    set coords [$_owner xml get $cpath.coords]
    371377    set coords [string trim $coords]
    372378    if { $coords == "" } {
    373         set coords "0 0"
    374     }
    375     # Is there a label?
    376     set label [$_owner xml get $_path.components.$cname.about.label]
    377     set labelWidth 0
    378     if { $label != "" } {
    379         set labelId [$itk_component(drawing) create text -1000 -1000 \
    380                          -text $label -font $options(-font)]
    381         set labelWidth [font measure $options(-font) $label]
    382     }
    383     set id [$itk_component(drawing) create text -1000 -1000  -tag $cname]
    384     set entryWidth [font measure $options(-font) $options(-text) ]
    385 
     379        set coords "0 0 1 1"
     380    }
    386381    foreach { x y } [ScreenCoords $coords] break
    387382    set lx $x
    388383    set ly $y
    389     set tx [expr $x + $labelWidth]
    390     set ty $y
    391 
    392     eval $itk_component(drawing) coords $id $tx $ty
    393     if { $labelWidth > 0 } {
    394         puts stderr "LABEL($labelWidth):$itk_component(drawing) coords $labelId $lx $ly"
    395         eval $itk_component(drawing) coords $labelId $lx $ly
    396     }
    397     set _cname2id($cname) $id
     384
    398385    puts stderr "$itk_component(drawing) itemconfigure $id [array get options]"
    399386    eval $itk_component(drawing) itemconfigure $id [array get options]
    400387    set bbox [$itk_component(drawing) bbox $id]
    401     puts stderr "cname=$cname bbox=$bbox"
     388    puts stderr "cpath=$cpath bbox=$bbox"
    402389    set sid [eval $itk_component(drawing) create rectangle $bbox]
    403390    $itk_component(drawing) itemconfigure $sid -fill "" -outline "" \
    … …  
    414401}
    415402
    416 itcl::body Rappture::DrawingEntry::ParseNumberDescription { cname } {
    417     puts stderr "ParseNumberDescrption description owner=$_owner path=$_path"
    418     foreach attr [$_owner xml children $_path.components.$cname] {
    419         puts stderr attr=$attr
    420     }
    421 }
    422 
    423403itcl::body Rappture::DrawingEntry::ScreenX { x } {
    424404    set norm [expr ($x - $_xMin) * $_xScale]
    … …  
    469449    puts stderr "ParseDescrption description owner=$_owner path=$_path"
    470450    ParseBackground
     451    ParseSubstitutions
    471452    foreach cname [$_owner xml children $_path.components] {
    472453        switch -glob -- $cname {
    473454            "line*" {
    474                 ParseLineDescription $cname
     455                ParseLine $_path.components.$cname
    475456            }
    476457            "grid*" {
    477                 ParseGridDescription $cname
     458                ParseGrid $_path.components.$cname
    478459            }
    479460            "text*" {
    480                 ParseTextDescription $cname
    481             }
    482             "string*" {
    483                 ParseStringDescription $cname
    484             }
    485             "number*" {
    486                 ParseNumberDescription $cname
     461                ParseText $_path.components.$cname
     462            }
     463            "picture*" {
     464                ParsePicture $_path.components.$cname
     465            }
     466            "rectangle*" {
     467                ParseRectangle $_path.components.$cname
     468            }
     469            "oval*" {
     470                ParseOval $_path.components.$cname
     471            }
     472            "polygon*" {
     473                ParsePolygon $_path.components.$cname
     474            }
     475            "hotspot*" {
     476                ParseHotspot $_path.components.$cname
    487477            }
    488478        }
    … …  
    586576}
    587577
     578itcl::body Rappture::DrawingEntry::ParseSubstitutions {} {
     579   foreach var [$_owner xml children $_path.substitutions] {
     580       if { ![string match "variable*" $var] } {
     581           continue
     582       }
     583       set varPath $_path.substitutions.$var
     584       foreach elem [$_owner xml children $varPath] {
     585           set map ""
     586           set name ""
     587           set path ""
     588           switch -- $elem {
     589            #  Background color of the drawing canvas (default white)
     590            "name" {
     591                set name [$_owner xml get $varPath.$elem]
     592            }
     593            "path" {
     594                set path [$_owner xml get $varPath.$elem]
     595            }
     596            "map" {
     597                set from [$_owner xml get $varPath.$elem.from]
     598                set to [$_owner xml get $varPath.$elem.to]
     599                if { $from == "" || $to == "" } {
     600                    puts stderr "empty translation in map table \"$varPath\""
     601                }
     602                lappend map $from $to
     603            }
     604            if { $name == "" } {
     605                puts stderr \
     606                    "no name defined for substituion variable \"$varPath\""
     607                continue
     608            }
     609            if { [info exists _name2path($name)] } {
     610                puts stderr \
     611                    "substitution variable \"$name\" already defined"
     612                continue
     613            }           
     614            set _name2path($name) $path
     615            if { $path == "" } {
     616                puts stderr \
     617                    "no path defined for substituion variable \"$varPath\""
     618                continue
     619            }
     620            set _name2map($name) $map
     621        }
     622    }
     623}
Note: See TracChangeset for help on using the changeset viewer.