Changeset 2986 for branches/blt4
- Timestamp:
- May 1, 2012, 9:37:59 AM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/blt4/gui/scripts/drawingentry.tcl
r2985 r2986 37 37 public method tooltip {} 38 38 39 private method AdjustDrawingArea { xAspect yAspect } 40 private method Highlight { tag } 39 41 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 } 46 52 private method ScreenX { x } 47 53 private method ScreenY { y } 48 private method ScreenCoords { coords }49 private method Highlight { tag }50 54 private method Unhighlight { tag } 51 private method Redraw {}52 55 } 53 56 … … 179 182 } 180 183 181 itcl::body Rappture::DrawingEntry::ParseLine Description {cname } {184 itcl::body Rappture::DrawingEntry::ParseLine { cpath cname } { 182 185 array set attr2option { 183 186 "linewidth" "-width" … … 195 198 # Coords 196 199 set coords {} 197 set coords [$_owner xml get $ _path.components.$cname.coords]200 set coords [$_owner xml get $cpath.coords] 198 201 set coords [string trim $coords] 199 202 if { $coords == "" } { … … 202 205 set coords [ScreenCoords $coords] 203 206 } 204 puts stderr "ParseLineDescrption description owner=$_owner path=$_path coords=$coords"207 puts stderr "ParseLineDescrption description owner=$_owner cpath=$cpath coords=$coords" 205 208 set list {} 206 foreach attr [$_owner xml children $ _path.components.$cname] {209 foreach attr [$_owner xml children $cpath] { 207 210 if { [info exists attr2option($attr)] } { 208 211 set option $attr2option($attr) 209 set value [$_owner xml get $ _path.components.$cname.$attr]212 set value [$_owner xml get $cpath.$attr] 210 213 set options($option) $value 211 214 } 212 215 } 216 set options(-tags) $cname 213 217 puts stderr "$itk_component(drawing) create line $coords" 214 218 set id [eval $itk_component(drawing) create line $coords] … … 218 222 219 223 # 220 # ParseGrid Description--221 # 222 itcl::body Rappture::DrawingEntry::ParseGrid Description {cname } {223 puts stderr "ParseGrid Descrption description owner=$_owner path=$_path"224 foreach attr [$_owner xml children $ _path.components.$cname] {224 # ParseGrid -- 225 # 226 itcl::body Rappture::DrawingEntry::ParseGrid { cpath cname } { 227 puts stderr "ParseGrid description owner=$_owner cpath=$cpath" 228 foreach attr [$_owner xml children $cpath] { 225 229 puts stderr attr=$attr 226 230 } … … 239 243 } 240 244 # Coords 241 set xcoords [$_owner xml get $ _path.components.$cname.xcoords]245 set xcoords [$_owner xml get $cpath.xcoords] 242 246 set xcoords [string trim $xcoords] 243 set ycoords [$_owner xml get $ _path.components.$cname.ycoords]247 set ycoords [$_owner xml get $cpath.ycoords] 244 248 set ycoords [string trim $ycoords] 245 249 if { $ycoords == "" } { … … 283 287 set xcoords $list 284 288 } 285 puts stderr "Parse LineDescrption description owner=$_owner path=$_path xcoords=$xcoords ycoords=$ycoords"289 puts stderr "ParseGrid description owner=$_owner cpath=$cpath xcoords=$xcoords ycoords=$ycoords" 286 290 set list {} 287 foreach attr [$_owner xml children $ _path.components.$cname] {291 foreach attr [$_owner xml children $cpath] { 288 292 if { [info exists attr2option($attr)] } { 289 293 set option $attr2option($attr) 290 set value [$_owner xml get $ _path.components.$cname.$attr]294 set value [$_owner xml get $cpath.$attr] 291 295 set options($option) $value 292 296 } 293 297 } 298 set options(-tags) $cname 294 299 foreach y $ycoords { 295 300 lappend ids \ … … 305 310 } 306 311 307 itcl::body Rappture::DrawingEntry::ParseText Description {cname } {312 itcl::body Rappture::DrawingEntry::ParseText { cpath cname } { 308 313 array set attr2option { 309 314 "font" "-font" … … 313 318 "anchor" "-anchor" 314 319 } 315 puts stderr "Parse StringDescrption description owner=$_owner path=$_path"320 puts stderr "ParseText description owner=$_owner cpath=$cpath" 316 321 317 322 # Set default options first and then let tool.xml override them. … … 322 327 -anchor c 323 328 } 324 foreach attr [$_owner xml children $ _path.components.$cname] {329 foreach attr [$_owner xml children $cpath] { 325 330 if { [info exists attr2option($attr)] } { 326 331 set option $attr2option($attr) 327 set value [$_owner xml get $ _path.components.$cname.$attr]332 set value [$_owner xml get $cpath.$attr] 328 333 set options($option) $value 329 334 } … … 331 336 # Coords 332 337 set coords {} 333 set coords [$_owner xml get $ _path.components.$cname.coords]338 set coords [$_owner xml get $cpath.coords] 334 339 set coords [string trim $coords] 335 340 if { $coords == "" } { … … 338 343 set coords [ScreenCoords $coords] 339 344 } 345 set options(-tags) $cname 340 346 puts stderr "$itk_component(drawing) create text $coords" 341 347 set id [eval $itk_component(drawing) create text $coords] … … 345 351 } 346 352 347 itcl::body Rappture::DrawingEntry::Parse StringDescription {cname } {353 itcl::body Rappture::DrawingEntry::ParseRectangle { cpath cname } { 348 354 array set attr2option { 349 " font" "-font"350 " default" "-text"351 " color" "-fill"352 } 353 puts stderr "Parse StringDescrption description owner=$_owner path=$_path"355 "outline" "-outline" 356 "fill" "-fill" 357 "linewidth" "-linewidth" 358 } 359 puts stderr "ParseRectangle description owner=$_owner cpath=$cpath" 354 360 355 361 # Set default options first and then let tool.xml override them. 356 362 array set options { 357 -f ont {Arial 12}358 - text {}359 - fillblack360 } 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] { 362 368 if { [info exists attr2option($attr)] } { 363 369 set option $attr2option($attr) 364 set value [$_owner xml get $ _path.components.$cname.$attr]370 set value [$_owner xml get $cpath.$attr] 365 371 set options($option) $value 366 372 } 367 373 } 368 # Coord s374 # Coordinates 369 375 set coords {} 370 set coords [$_owner xml get $ _path.components.$cname.coords]376 set coords [$_owner xml get $cpath.coords] 371 377 set coords [string trim $coords] 372 378 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 } 386 381 foreach { x y } [ScreenCoords $coords] break 387 382 set lx $x 388 383 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 398 385 puts stderr "$itk_component(drawing) itemconfigure $id [array get options]" 399 386 eval $itk_component(drawing) itemconfigure $id [array get options] 400 387 set bbox [$itk_component(drawing) bbox $id] 401 puts stderr "c name=$cnamebbox=$bbox"388 puts stderr "cpath=$cpath bbox=$bbox" 402 389 set sid [eval $itk_component(drawing) create rectangle $bbox] 403 390 $itk_component(drawing) itemconfigure $sid -fill "" -outline "" \ … … 414 401 } 415 402 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=$attr420 }421 }422 423 403 itcl::body Rappture::DrawingEntry::ScreenX { x } { 424 404 set norm [expr ($x - $_xMin) * $_xScale] … … 469 449 puts stderr "ParseDescrption description owner=$_owner path=$_path" 470 450 ParseBackground 451 ParseSubstitutions 471 452 foreach cname [$_owner xml children $_path.components] { 472 453 switch -glob -- $cname { 473 454 "line*" { 474 ParseLine Description$cname455 ParseLine $_path.components.$cname 475 456 } 476 457 "grid*" { 477 ParseGrid Description$cname458 ParseGrid $_path.components.$cname 478 459 } 479 460 "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 487 477 } 488 478 } … … 586 576 } 587 577 578 itcl::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.