Changeset 2938 for trunk/gui/scripts/drawingentry.tcl
- Timestamp:
- Apr 4, 2012, 1:21:50 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/drawingentry.tcl
r1929 r2938 15 15 itcl::class Rappture::DrawingEntry { 16 16 inherit itk::Widget 17 18 17 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 19 26 20 27 constructor {owner path args} { # defined below } … … 24 31 public method label {} 25 32 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 } 26 47 } 27 48 … … 41 62 } 42 63 set _path $path 43 64 set _owner $owner 44 65 # 45 66 # Display the current drawing. 46 67 # 47 68 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 49 72 } 50 73 pack $itk_component(drawing) -expand yes -fill both 51 74 ParseDescription 52 75 eval itk_initialize $args 53 76 } … … 128 151 } 129 152 } 153 154 itcl::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 # 195 itcl::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 280 itcl::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 320 itcl::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 389 itcl::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 396 itcl::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 404 itcl::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 410 itcl::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 418 itcl::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 426 itcl::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 434 itcl::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 469 itcl::body Rappture::DrawingEntry::Highlight { tag } { 470 $itk_component(drawing) itemconfigure $tag-bg -outline black \ 471 -fill lightblue 472 } 473 474 itcl::body Rappture::DrawingEntry::Unhighlight { tag } { 475 $itk_component(drawing) itemconfigure $tag-bg -outline "" \ 476 -fill "" 477 }
Note: See TracChangeset
for help on using the changeset viewer.