Changeset 2938 for trunk


Ignore:
Timestamp:
Apr 4, 2012 1:21:50 PM (12 years ago)
Author:
gah
Message:

experimental drawing entry enabled

Location:
trunk/gui/scripts
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/controlOwner.tcl

    r2753 r2938  
    5959    # in coordination with loaders inside the load function
    6060    array set _type2curpath {
     61        drawing components
    6162        choice current
    6263        boolean current
    … …  
    268269
    269270        set type [[tool] xml element -as type $path]
     271 puts stderr type=$type
    270272        if {[info exists _type2curpath($type)]} {
    271273            set currentpath $path.$_type2curpath($type)

  • trunk/gui/scripts/controls.tcl

    r2783 r2938  
    136136        choice {
    137137            Rappture::ChoiceEntry $w $_owner $path
     138            bind $w <<Value>> [itcl::code $this _controlChanged $name]
     139        }
     140        drawing {
     141            Rappture::DrawingEntry $w $_owner $path
    138142            bind $w <<Value>> [itcl::code $this _controlChanged $name]
    139143        }

  • trunk/gui/scripts/drawingentry.tcl

    r1929 r2938  
    1515itcl::class Rappture::DrawingEntry {
    1616    inherit itk::Widget
    17 
    1817    itk_option define -state state State "normal"
     18
     19    private variable _owner
     20    private variable _path
     21    private variable _cname2id
     22    private variable _worldX 0
     23    private variable _worldY 0
     24    private variable _worldWidth 0
     25    private variable _worldHeight 0
    1926
    2027    constructor {owner path args} { # defined below }
    … …  
    2431    public method label {}
    2532    public method tooltip {}
     33
     34    private method ParseDescription {}
     35    private method ParseLineDescription { cname }
     36    private method ParseGridDescription { cname }
     37    private method ParseTextDescription { cname }
     38    private method ParseStringDescription { cname }
     39    private method ParseNumberDescription { cname }
     40    private method GetCanvasHeight { }
     41    private method GetCanvasWidth { }
     42    private method ScreenX { x }
     43    private method ScreenY { y }
     44    private method ScreenCoords { coords }
     45    private method Highlight { tag }
     46    private method Unhighlight { tag }
    2647}
    2748
    … …  
    4162    }
    4263    set _path $path
    43 
     64    set _owner $owner
    4465    #
    4566    # Display the current drawing.
    4667    #
    4768    itk_component add drawing {
    48         Rappture::Drawing $itk_interior.drawing $owner $path
     69        canvas $itk_interior.canvas -background white -relief sunken -bd 1
     70    } {
     71        ignore -background
    4972    }
    5073    pack $itk_component(drawing) -expand yes -fill both
    51 
     74    ParseDescription
    5275    eval itk_initialize $args
    5376}
    … …  
    128151    }
    129152}
     153
     154itcl::body Rappture::DrawingEntry::ParseLineDescription { cname } {
     155    array set attr2option {
     156        "linewidth"     "-width"
     157        "arrow"         "-arrow"
     158        "dash"          "-dash"
     159        "color"         "-fill"
     160    }
     161    # Set default options first and then let tool.xml override them.
     162    array set options {
     163        -arrow          none
     164        -width          0
     165        -fill           black
     166        -dash           ""
     167    }
     168    # Coords
     169    set coords {}
     170    set coords [$_owner xml get $_path.components.$cname.coords]
     171    set coords [string trim $coords]
     172    if { $coords == "" } {
     173        set coords "0 0"
     174    } else {
     175        set coords [ScreenCoords $coords]
     176    }
     177    puts stderr "ParseLineDescrption description owner=$_owner path=$_path coords=$coords"
     178    set list {}
     179    foreach attr [$_owner xml children $_path.components.$cname] {
     180        if { [info exists attr2option($attr)] } {
     181            set option $attr2option($attr)
     182            set value [$_owner xml get $_path.components.$cname.$attr]
     183            set options($option) $value
     184        }
     185    }
     186    puts stderr "$itk_component(drawing) create line $coords"
     187    set id [eval $itk_component(drawing) create line $coords]
     188    set _cname2id($cname) $id
     189    eval $itk_component(drawing) itemconfigure $id [array get options]
     190}
     191
     192#
     193# ParseGridDescription --
     194#
     195itcl::body Rappture::DrawingEntry::ParseGridDescription { cname } {
     196    puts stderr "ParseGridDescrption description owner=$_owner path=$_path"
     197    foreach attr [$_owner xml children $_path.components.$cname] {
     198        puts stderr attr=$attr
     199    }
     200    array set attr2option {
     201        "linewidth"     "-width"
     202        "arrow"         "-arrow"
     203        "dash"          "-dash"
     204        "color"         "-fill"
     205    }
     206    # Set default options first and then let tool.xml override them.
     207    array set options {
     208        -arrow          none
     209        -width          0
     210        -fill           black
     211        -dash           ""
     212    }
     213    # Coords
     214    set xcoords [$_owner xml get $_path.components.$cname.xcoords]
     215    set xcoords [string trim $xcoords]
     216    set ycoords [$_owner xml get $_path.components.$cname.ycoords]
     217    set ycoords [string trim $ycoords]
     218    if { $ycoords == "" } {
     219        set ycoords "0 1"
     220        set ymax 1
     221        set ymin 0
     222    } else {
     223        set list {}
     224        set ymax -10000
     225        set ymin 10000
     226        foreach c $ycoords {
     227            set y [ScreenY $c]
     228            if { $y > $ymax } {
     229                set ymax $y
     230            }
     231            if { $y < $ymin } {
     232                set ymin $y
     233            }
     234            lappend list $y
     235        }
     236        set ycoords $list
     237    }
     238    if { $xcoords == "" } {
     239        set xcoords "0 1"
     240        set xmax 1
     241        set xmin 0
     242    } else {
     243        set list {}
     244        set xmax -10000
     245        set xmin 10000
     246        foreach c $xcoords {
     247            set x [ScreenX $c]
     248            if { $x > $xmax } {
     249                set xmax $x
     250            }
     251            if { $x < $xmin } {
     252                set xmin $x
     253            }
     254            lappend list $x
     255        }
     256        set xcoords $list
     257    }
     258    puts stderr "ParseLineDescrption description owner=$_owner path=$_path xcoords=$xcoords ycoords=$ycoords"
     259    set list {}
     260    foreach attr [$_owner xml children $_path.components.$cname] {
     261        if { [info exists attr2option($attr)] } {
     262            set option $attr2option($attr)
     263            set value [$_owner xml get $_path.components.$cname.$attr]
     264            set options($option) $value
     265        }
     266    }
     267    foreach y $ycoords {
     268        lappend ids \
     269            [eval $itk_component(drawing) create line $xmin $y $xmax $y \
     270                 [array get options]]
     271    }
     272    foreach x $xcoords {
     273        lappend ids \
     274            [eval $itk_component(drawing) create line $x $ymin $x $ymax \
     275                 [array get options]]
     276    }
     277    set _cname2id($cname) $ids
     278}
     279
     280itcl::body Rappture::DrawingEntry::ParseTextDescription { cname } {
     281    array set attr2option {
     282        "font"          "-font"
     283        "default"       "-text"
     284        "color"         "-fill"
     285        "text"          "-text"
     286        "anchor"        "-anchor"
     287    }
     288    puts stderr "ParseStringDescrption description owner=$_owner path=$_path"
     289
     290    # Set default options first and then let tool.xml override them.
     291    array set options {
     292        -font {Arial 12}
     293        -text {}
     294        -fill black
     295        -anchor c
     296    }
     297    foreach attr [$_owner xml children $_path.components.$cname] {
     298        if { [info exists attr2option($attr)] } {
     299            set option $attr2option($attr)
     300            set value [$_owner xml get $_path.components.$cname.$attr]
     301            set options($option) $value
     302        }
     303    }
     304    # Coords
     305    set coords {}
     306    set coords [$_owner xml get $_path.components.$cname.coords]
     307    set coords [string trim $coords]
     308    if { $coords == "" } {
     309        set coords "0 0"
     310    } else {
     311        set coords [ScreenCoords $coords]
     312    }
     313    puts stderr "$itk_component(drawing) create text $coords"
     314    set id [eval $itk_component(drawing) create text $coords]
     315    set _cname2id($cname) $id
     316    puts stderr "$itk_component(drawing) itemconfigure $id [array get options]"
     317    eval $itk_component(drawing) itemconfigure $id [array get options]
     318}
     319
     320itcl::body Rappture::DrawingEntry::ParseStringDescription { cname } {
     321    array set attr2option {
     322        "font"          "-font"
     323        "default"       "-text"
     324        "color"         "-fill"
     325    }
     326    puts stderr "ParseStringDescrption description owner=$_owner path=$_path"
     327
     328    # Set default options first and then let tool.xml override them.
     329    array set options {
     330        -font {Arial 12}
     331        -text {}
     332        -fill black
     333    }
     334    foreach attr [$_owner xml children $_path.components.$cname] {
     335        if { [info exists attr2option($attr)] } {
     336            set option $attr2option($attr)
     337            set value [$_owner xml get $_path.components.$cname.$attr]
     338            set options($option) $value
     339        }
     340    }
     341    # Coords
     342    set coords {}
     343    set coords [$_owner xml get $_path.components.$cname.coords]
     344    set coords [string trim $coords]
     345    if { $coords == "" } {
     346        set coords "0 0"
     347    }
     348    # Is there a label?
     349    set label [$_owner xml get $_path.components.$cname.about.label]
     350    set labelWidth 0
     351    if { $label != "" } {
     352        set labelId [$itk_component(drawing) create text -1000 -1000 \
     353                         -text $label -font $options(-font)]
     354        set labelWidth [font measure $options(-font) $label]
     355    }
     356    set id [$itk_component(drawing) create text -1000 -1000  -tag $cname]
     357    set entryWidth [font measure $options(-font) $options(-text) ]
     358
     359    foreach { x y } [ScreenCoords $coords] break
     360    set lx $x
     361    set ly $y
     362    set tx [expr $x + $labelWidth]
     363    set ty $y
     364
     365    eval $itk_component(drawing) coords $id $tx $ty
     366    if { $labelWidth > 0 } {
     367        puts stderr "LABEL($labelWidth):$itk_component(drawing) coords $labelId $lx $ly"
     368        eval $itk_component(drawing) coords $labelId $lx $ly
     369    }
     370    set _cname2id($cname) $id
     371    puts stderr "$itk_component(drawing) itemconfigure $id [array get options]"
     372    eval $itk_component(drawing) itemconfigure $id [array get options]
     373    set bbox [$itk_component(drawing) bbox $id]
     374    puts stderr "cname=$cname bbox=$bbox"
     375    set sid [eval $itk_component(drawing) create rectangle $bbox]
     376    $itk_component(drawing) itemconfigure $sid -fill "" -outline "" \
     377        -tag $cname-bg
     378    set sid [eval $itk_component(drawing) create rectangle $bbox]
     379    $itk_component(drawing) itemconfigure $sid -fill "" -outline "" \
     380        -tag $cname-sensor
     381    $itk_component(drawing) bind $cname-sensor <Enter> \
     382        [itcl::code $this Highlight $cname]
     383    $itk_component(drawing) bind $cname-sensor <Leave> \
     384        [itcl::code $this Unhighlight $cname]
     385    $itk_component(drawing) lower $cname-bg
     386    $itk_component(drawing) raise $cname-sensor
     387}
     388
     389itcl::body Rappture::DrawingEntry::ParseNumberDescription { cname } {
     390    puts stderr "ParseNumberDescrption description owner=$_owner path=$_path"
     391    foreach attr [$_owner xml children $_path.components.$cname] {
     392        puts stderr attr=$attr
     393    }
     394}
     395
     396itcl::body Rappture::DrawingEntry::ScreenX { x } {
     397    set norm [expr ($x - $_worldX) / double($_worldWidth)]
     398    puts stderr "ScreenX x=$x, norm=$norm wx=$_worldX ww=$_worldWidth"
     399    set x [expr int($norm * [GetCanvasWidth])]
     400    puts stderr "ScreenX after x=$x cw=[GetCanvasWidth]"
     401    return $x
     402}
     403
     404itcl::body Rappture::DrawingEntry::ScreenY { y } {
     405    set norm [expr ($y - $_worldY) / double($_worldWidth)]
     406    set y [expr int($norm * [GetCanvasHeight])]
     407    return $y
     408}
     409
     410itcl::body Rappture::DrawingEntry::ScreenCoords { coords } {
     411    set list {}
     412    foreach {x y} $coords {
     413        lappend list [ScreenX $x] [ScreenY $y]
     414    }
     415    return $list
     416}
     417
     418itcl::body Rappture::DrawingEntry::GetCanvasWidth { } {
     419    set w [winfo width $itk_component(drawing)]
     420    if { $w < 2 } {
     421        set w [winfo reqwidth $itk_component(drawing)]
     422    }
     423    return $w
     424}
     425
     426itcl::body Rappture::DrawingEntry::GetCanvasHeight { } {
     427    set h [winfo height $itk_component(drawing)]
     428    if { $h < 2 } {
     429        set h [winfo reqheight $itk_component(drawing)]
     430    }
     431    return $h
     432}
     433
     434itcl::body Rappture::DrawingEntry::ParseDescription {} {
     435    puts stderr "ParseDescrption description owner=$_owner path=$_path"
     436    set bbox [$_owner xml get $_path.about.bbox]
     437    puts stderr bbox=$bbox
     438    if { [llength $bbox] != 4 } {
     439        set bbox "0 0 [GetCanvasWidth] [GetCanvasHeight]"
     440    }
     441    foreach { x1 y1 x2 y2 } $bbox break
     442    set _worldWidth [expr $x2 - $x1]
     443    set _worldHeight [expr $y2 - $y1]
     444    set _worldX $x1
     445    set _worldY $y1
     446    foreach cname [$_owner xml children $_path.components] {
     447        switch -glob -- $cname {
     448            "line*" {
     449                ParseLineDescription $cname
     450            }
     451            "grid*" {
     452                ParseGridDescription $cname
     453            }
     454            "text*" {
     455                ParseTextDescription $cname
     456            }
     457            "string*" {
     458                ParseStringDescription $cname
     459            }
     460            "number*" {
     461                ParseNumberDescription $cname
     462            }
     463        }
     464    }
     465}
     466
     467
     468
     469itcl::body Rappture::DrawingEntry::Highlight { tag } {
     470    $itk_component(drawing) itemconfigure $tag-bg -outline black \
     471        -fill lightblue
     472}
     473
     474itcl::body Rappture::DrawingEntry::Unhighlight { tag } {
     475    $itk_component(drawing) itemconfigure $tag-bg -outline "" \
     476        -fill ""
     477}

  • trunk/gui/scripts/page.tcl

    r1929 r2938  
    7979            continue
    8080        }
    81 
    8281        if {$type == "loader"} {
    8382            #
    … …  
    139138            #
    140139            set w "$frame.drawing[incr num]"
    141             Rappture::DrawingEntry ::$w $_owner $path.$cname.current
     140            Rappture::DrawingEntry ::$w $_owner $path.$cname
    142141            pack $w -expand yes -fill both
    143142            $_owner widgetfor $path.$cname $w
Note: See TracChangeset for help on using the changeset viewer.