[3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[2386] | 2 | # ---------------------------------------------------------------------- |
---|
| 3 | # COMPONENT: drawingobsolete - 2D drawing of data |
---|
| 4 | # ====================================================================== |
---|
| 5 | # AUTHOR: Michael McLennan, Purdue University |
---|
[3177] | 6 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[2386] | 7 | # |
---|
| 8 | # See the file "license.terms" for information on usage and |
---|
| 9 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 10 | # ====================================================================== |
---|
| 11 | package require Itk |
---|
| 12 | |
---|
| 13 | option add *DrawingObsolete.width 4i widgetDefault |
---|
| 14 | option add *DrawingObsolete.height 3i widgetDefault |
---|
| 15 | |
---|
| 16 | itcl::class Rappture::DrawingObsolete { |
---|
| 17 | inherit itk::Widget |
---|
| 18 | |
---|
| 19 | # constructor {owner path args} { |
---|
| 20 | # Rappture::ControlOwner::constructor $owner |
---|
| 21 | # } { # defined below } |
---|
| 22 | constructor {owner path args} { # defined below } |
---|
| 23 | private variable _xmlobj "" |
---|
| 24 | private variable _owner "" |
---|
| 25 | private variable _path "" |
---|
| 26 | |
---|
| 27 | public method value {args} |
---|
| 28 | public method hilite {elem state} |
---|
| 29 | public method activate {elem x y} |
---|
| 30 | |
---|
| 31 | protected method _buildPopup {elem} |
---|
| 32 | |
---|
| 33 | private variable _elem2popup ;# maps drawing elem => popup of controls |
---|
| 34 | } |
---|
| 35 | |
---|
| 36 | itk::usual DrawingObsolete { |
---|
| 37 | keep -cursor -background |
---|
| 38 | } |
---|
| 39 | |
---|
| 40 | # ---------------------------------------------------------------------- |
---|
| 41 | # CONSTRUCTOR |
---|
| 42 | # ---------------------------------------------------------------------- |
---|
| 43 | itcl::body Rappture::DrawingObsolete::constructor {owner path args} { |
---|
| 44 | set _owner $owner |
---|
| 45 | set _path $path |
---|
| 46 | |
---|
| 47 | itk_component add canvas { |
---|
| 48 | canvas $itk_interior.canv |
---|
| 49 | } { |
---|
| 50 | usual |
---|
| 51 | keep -width -height |
---|
| 52 | } |
---|
| 53 | pack $itk_component(canvas) -expand yes -fill both |
---|
| 54 | |
---|
| 55 | eval itk_initialize $args |
---|
| 56 | } |
---|
| 57 | |
---|
| 58 | # ---------------------------------------------------------------------- |
---|
| 59 | # USAGE: value ?-check? ?<newval>? |
---|
| 60 | # |
---|
| 61 | # Clients use this to query/set the value for this widget. With |
---|
| 62 | # no args, it returns the current value for the widget. If the |
---|
| 63 | # <newval> is specified, it sets the value of the widget and |
---|
| 64 | # sends a <<Value>> event. If the -check flag is included, the |
---|
| 65 | # new value is not actually applied, but just checked for correctness. |
---|
| 66 | # ---------------------------------------------------------------------- |
---|
| 67 | itcl::body Rappture::DrawingObsolete::value {args} { |
---|
| 68 | set onlycheck 0 |
---|
| 69 | set i [lsearch -exact $args -check] |
---|
| 70 | if {$i >= 0} { |
---|
| 71 | set onlycheck 1 |
---|
| 72 | set args [lreplace $args $i $i] |
---|
| 73 | } |
---|
| 74 | |
---|
| 75 | if {[llength $args] == 0} { |
---|
| 76 | return $_xmlobj |
---|
| 77 | } elseif {[llength $args] > 1} { |
---|
| 78 | error "wrong # args: should be \"value ?-check? ?newval?\"" |
---|
| 79 | } |
---|
| 80 | |
---|
| 81 | if {$onlycheck} { |
---|
| 82 | # someday we may add validation... |
---|
| 83 | return |
---|
| 84 | } |
---|
| 85 | |
---|
| 86 | set c $itk_component(canvas) |
---|
| 87 | $c delete all |
---|
| 88 | foreach elem [array names _elem2popup] { |
---|
| 89 | destroy $_elem2popup($elem) |
---|
| 90 | } |
---|
| 91 | catch {unset $elem} |
---|
| 92 | set _xmlobj [lindex $args 0] |
---|
| 93 | |
---|
| 94 | if {"" != $_xmlobj} { |
---|
| 95 | foreach elem [$_xmlobj children] { |
---|
| 96 | switch -glob -- $elem { |
---|
| 97 | about* { |
---|
| 98 | continue |
---|
| 99 | } |
---|
| 100 | rectangle* { |
---|
| 101 | set xy0 [$_xmlobj get $elem.xya] |
---|
| 102 | set xy1 [$_xmlobj get $elem.xyb] |
---|
| 103 | set fill [$_xmlobj get $elem.fill] |
---|
| 104 | set outl [$_xmlobj get $elem.outl] |
---|
| 105 | set wdth [$_xmlobj get $elem.width] |
---|
| 106 | if {"" != $wdth && $wdth > 0 && $outl == ""} { |
---|
| 107 | set outl black |
---|
| 108 | } |
---|
| 109 | if {"" == $fill && "" == $outl} { |
---|
| 110 | _buildPopup $elem |
---|
| 111 | |
---|
| 112 | # this part gets highlighted |
---|
| 113 | eval $c create rect $xy0 $xy1 [list -outline "" -fill "" -tags $elem] |
---|
| 114 | # this part is the sensor that detects events |
---|
| 115 | set id [eval $c create rect $xy0 $xy1 [list -outline "" -fill ""]] |
---|
| 116 | $c bind $id <Enter> [itcl::code $this hilite $elem on] |
---|
| 117 | $c bind $id <Leave> [itcl::code $this hilite $elem off] |
---|
| 118 | $c bind $id <ButtonPress> [itcl::code $this activate $elem %X %Y] |
---|
| 119 | } else { |
---|
| 120 | if {"" == $fill} { set fill "{}" } |
---|
| 121 | if {"" == $outl} { set outl "{}" } |
---|
| 122 | eval $c create rect $xy0 $xy1 -width $wdth -outline $outl -fill $fill |
---|
| 123 | } |
---|
| 124 | } |
---|
| 125 | oval* { |
---|
| 126 | set xy0 [$_xmlobj get $elem.xya] |
---|
| 127 | set xy1 [$_xmlobj get $elem.xyb] |
---|
| 128 | set fill [$_xmlobj get $elem.fill] |
---|
| 129 | set outl [$_xmlobj get $elem.outl] |
---|
| 130 | set wdth [$_xmlobj get $elem.width] |
---|
| 131 | if {"" != $wdth && $wdth > 0 && $outl == ""} { |
---|
| 132 | set outl black |
---|
| 133 | } |
---|
| 134 | if {"" == $fill && "" == $outl} { |
---|
| 135 | } else { |
---|
| 136 | if {"" == $fill} { set fill "{}" } |
---|
| 137 | if {"" == $outl} { set outl "{}" } |
---|
| 138 | } |
---|
| 139 | eval $c create oval $xy0 $xy1 -width $wdth -outline $outl -fill $fill |
---|
| 140 | } |
---|
| 141 | polygon* { |
---|
| 142 | set xy [$_xmlobj get $elem.xy] |
---|
| 143 | regsub -all "\n" $xy " " xy |
---|
| 144 | set smth [$_xmlobj get $elem.smooth] |
---|
| 145 | set fill [$_xmlobj get $elem.fill] |
---|
| 146 | set outl [$_xmlobj get $elem.outl] |
---|
| 147 | set wdth [$_xmlobj get $elem.width] |
---|
| 148 | if {"" != $wdth && $wdth > 0 && $outl == ""} { |
---|
| 149 | set outl black |
---|
| 150 | } |
---|
| 151 | if {"" == $fill && "" == $outl} { |
---|
| 152 | } else { |
---|
| 153 | if {"" == $fill} { set fill "{}" } |
---|
| 154 | if {"" == $outl} { set outl "{}" } |
---|
| 155 | } |
---|
| 156 | eval $c create polygon $xy -width $wdth -outline $outl -fill $fill -smooth $smth |
---|
| 157 | } |
---|
| 158 | text* { |
---|
| 159 | set xy [$_xmlobj get $elem.xy] |
---|
| 160 | set txt [$_xmlobj get $elem.text] |
---|
| 161 | eval $c create text $xy -text $txt |
---|
| 162 | } |
---|
| 163 | } |
---|
| 164 | } |
---|
| 165 | } |
---|
| 166 | return $_xmlobj |
---|
| 167 | } |
---|
| 168 | |
---|
| 169 | # ---------------------------------------------------------------------- |
---|
| 170 | # USAGE: hilite <elem> <state> |
---|
| 171 | # |
---|
| 172 | # Used internally to highlight parts of the drawing when the mouse |
---|
| 173 | # passes over it. |
---|
| 174 | # ---------------------------------------------------------------------- |
---|
| 175 | itcl::body Rappture::DrawingObsolete::hilite {elem state} { |
---|
| 176 | if {$state} { |
---|
| 177 | $itk_component(canvas) itemconfigure $elem -outline red -width 2 |
---|
| 178 | } else { |
---|
| 179 | $itk_component(canvas) itemconfigure $elem -width 0 |
---|
| 180 | } |
---|
| 181 | } |
---|
| 182 | |
---|
| 183 | # ---------------------------------------------------------------------- |
---|
| 184 | # USAGE: activate <elem> <x> <y> |
---|
| 185 | # |
---|
| 186 | # Pops up the controls associated with a drawing element. |
---|
| 187 | # ---------------------------------------------------------------------- |
---|
| 188 | itcl::body Rappture::DrawingObsolete::activate {elem x y} { |
---|
| 189 | if {[info exists _elem2popup($elem)]} { |
---|
| 190 | after 10 [list $_elem2popup($elem) activate @$x,$y above] |
---|
| 191 | } |
---|
| 192 | } |
---|
| 193 | |
---|
| 194 | # ---------------------------------------------------------------------- |
---|
| 195 | # USAGE: _buildPopup <elem> |
---|
| 196 | # |
---|
| 197 | # Pops up the controls associated with a drawing element. |
---|
| 198 | # ---------------------------------------------------------------------- |
---|
| 199 | itcl::body Rappture::DrawingObsolete::_buildPopup {elem} { |
---|
| 200 | if {![info exists _elem2popup($elem)]} { |
---|
| 201 | set n 0 |
---|
| 202 | while {1} { |
---|
| 203 | set popup $itk_component(canvas).popup[incr n] |
---|
| 204 | if {![winfo exists $popup]} { |
---|
| 205 | break |
---|
| 206 | } |
---|
| 207 | } |
---|
| 208 | Rappture::Balloon $popup -title [$_xmlobj get $elem.parameters.about.label] |
---|
| 209 | set inner [$popup component inner] |
---|
| 210 | Rappture::Controls $inner.cntls $_owner |
---|
| 211 | pack $inner.cntls -expand yes -fill both |
---|
| 212 | foreach child [$_xmlobj children $elem.parameters] { |
---|
| 213 | if {[string match about* $child]} { |
---|
| 214 | continue |
---|
| 215 | } |
---|
| 216 | $inner.cntls insert end $_path.$elem.parameters.$child |
---|
| 217 | } |
---|
| 218 | |
---|
| 219 | set _elem2popup($elem) $popup |
---|
| 220 | } |
---|
| 221 | } |
---|