1# plotpriv.tcl -- 2# Facilities to draw simple plots in a dedicated canvas 3# 4# Note: 5# This source file contains the private functions. 6# It is the companion of "plotchart.tcl" 7# 8 9# WidthCanvas -- 10# Return the width of the canvas 11# Arguments: 12# w Name of the canvas 13# Result: 14# Width in pixels 15# 16proc ::Plotchart::WidthCanvas {w} { 17 set width [winfo width $w] 18 19 if { $width < 10 } { 20 set width [$w cget -width] 21 } 22 return $width 23} 24 25# HeightCanvas -- 26# Return the height of the canvas 27# Arguments: 28# w Name of the canvas 29# Result: 30# Height in pixels 31# 32proc ::Plotchart::HeightCanvas {w} { 33 set height [winfo height $w] 34 35 if { $height < 10 } { 36 set height [$w cget -height] 37 } 38 return $height 39} 40 41# SavePlot -- 42# Save the plot/chart to a PostScript file (using default options) 43# Arguments: 44# w Name of the canvas 45# filename Name of the file to write 46# args Optional format (-format name) 47# Result: 48# None 49# Side effect: 50# A (new) PostScript file 51# 52proc ::Plotchart::SavePlot { w filename args } { 53 54 if { [llength $args] == 0 } { 55 # 56 # Wait for the canvas to become visible - just in case. 57 # Then write the file 58 # 59 update idletasks 60 $w postscript -file $filename 61 } else { 62 if { [llength $args] == 2 && [lindex $args 0] == "-format" } { 63 package require Img 64 set format [lindex $args 1] 65 66 # 67 # This is a kludge: 68 # Somehow tkwait does not always work (on Windows XP, that is) 69 # 70 raise [winfo toplevel $w] 71 # tkwait visibility [winfo toplevel $w] 72 after 2000 {set ::Plotchart::waited 0} 73 vwait ::Plotchart::waited 74 set img [image create photo -data $w -format window] 75 $img write $filename -format $format 76 } else { 77 return -code error "Unknown option: $args - must be: -format img-format" 78 } 79 } 80} 81 82# MarginsRectangle -- 83# Determine the margins for a rectangular plot/chart 84# Arguments: 85# w Name of the canvas 86# notext Number of lines of text to make room for at the top 87# (default: 2.0) 88# text_width Number of characters to be displayed at most on left 89# (default: 8) 90# Result: 91# List of four values 92# 93proc ::Plotchart::MarginsRectangle { w {notext 2.0} {text_width 8}} { 94 variable config 95 96 set char_width $config(font,char_width) 97 set char_height $config(font,char_height) 98 set config($w,font,char_width) $char_width 99 set config($w,font,char_height) $char_height 100 101 foreach {char_width char_height} [FontMetrics $w] {break} 102 set margin_right [expr {$char_width * 4}] 103 if { $margin_right < $config($w,margin,right) } { 104 set margin_right $config($w,margin,right) 105 } 106 set margin_bottom [expr {$char_height * 2 + 2}] 107 if { $margin_bottom < $config($w,margin,bottom) } { 108 set margin_bottom $config($w,margin,bottom) 109 } 110 111 set pxmin [expr {$char_width*$text_width}] 112 if { $pxmin < $config($w,margin,left) } { 113 set pxmin $config($w,margin,left) 114 } 115 set pymin [expr {int($char_height*$notext)}] 116 if { $pymin < $config($w,margin,top) } { 117 set pymin $config($w,margin,top) 118 } 119 set pxmax [expr {[WidthCanvas $w] - $margin_right}] 120 set pymax [expr {[HeightCanvas $w] - $margin_bottom}] 121 122 return [list $pxmin $pymin $pxmax $pymax] 123} 124 125# MarginsSquare -- 126# Determine the margins for a square plot/chart 127# Arguments: 128# w Name of the canvas 129# notext Number of lines of text to make room for at the top 130# (default: 2.0) 131# text_width Number of characters to be displayed at most on left 132# (default: 8) 133# Result: 134# List of four values 135# 136proc ::Plotchart::MarginsSquare { w {notext 2.0} {text_width 8}} { 137 variable config 138 139 set char_width $config(font,char_width) 140 set char_height $config(font,char_height) 141 set config($w,font,char_width) $char_width 142 set config($w,font,char_height) $char_height 143 144 foreach {char_width char_height} [FontMetrics $w] {break} 145 set margin_right [expr {$char_width * 4}] 146 if { $margin_right < $config($w,margin,right) } { 147 set margin_right $config($w,margin,right) 148 } 149 set margin_bottom [expr {$char_height * 2 + 2}] 150 if { $margin_bottom < $config($w,margin,bottom) } { 151 set margin_bottom $config($w,margin,bottom) 152 } 153 154 set pxmin [expr {$char_width*$text_width}] 155 if { $pxmin < $config($w,margin,left) } { 156 set pxmin $config($w,margin,left) 157 } 158 set pymin [expr {int($char_height*$notext)}] 159 if { $pymin < $config($w,margin,top) } { 160 set pymin $config($w,margin,top) 161 } 162 set pxmax [expr {[WidthCanvas $w] - $margin_right}] 163 set pymax [expr {[HeightCanvas $w] - $margin_bottom}] 164 165 if { $pxmax-$pxmin > $pymax-$pymin } { 166 set pxmax [expr {$pxmin + ($pymax - $pymin)}] 167 } else { 168 set pymax [expr {$pymin + ($pxmax - $pxmin)}] 169 } 170 171 return [list $pxmin $pymin $pxmax $pymax] 172} 173 174# MarginsCircle -- 175# Determine the margins for a circular plot/chart 176# Arguments: 177# w Name of the canvas 178# Result: 179# List of four values 180# 181proc ::Plotchart::MarginsCircle { w } { 182 set pxmin 80 183 set pymin 30 184 set pxmax [expr {[WidthCanvas $w] - 80}] 185 set pymax [expr {[HeightCanvas $w] - 30}] 186 #set pxmax [expr {[$w cget -width] - 80}] 187 #set pymax [expr {[$w cget -height] - 30}] 188 189 set dx [expr {$pxmax-$pxmin+1}] 190 set dy [expr {$pymax-$pymin+1}] 191 192 if { $dx < $dy } { 193 set pyminn [expr {($pymin+$pymax-$dx)/2}] 194 set pymaxn [expr {($pymin+$pymax+$dx)/2}] 195 set pymin $pyminn 196 set pymax $pymaxn 197 } else { 198 set pxminn [expr {($pxmin+$pxmax-$dy)/2}] 199 set pxmaxn [expr {($pxmin+$pxmax+$dy)/2}] 200 set pxmin $pxminn 201 set pxmax $pxmaxn 202 } 203 204 return [list $pxmin $pymin $pxmax $pymax] 205} 206 207# Margins3DPlot -- 208# Determine the margins for a 3D plot 209# Arguments: 210# w Name of the canvas 211# Result: 212# List of four values 213# 214proc ::Plotchart::Margins3DPlot { w } { 215 variable scaling 216 217 set yfract 0.33 218 set zfract 0.50 219 if { [info exists scaling($w,yfract)] } { 220 set yfract $scaling($w,yfract) 221 } else { 222 set scaling($w,yfract) $yfract 223 } 224 if { [info exists scaling($w,zfract)] } { 225 set zfract $scaling($w,zfract) 226 } else { 227 set scaling($w,zfract) $zfract 228 } 229 230 set yzwidth [expr {(-120+[WidthCanvas $w])/(1.0+$yfract)}] 231 set yzheight [expr {(-60+[HeightCanvas $w])/(1.0+$zfract)}] 232 #set yzwidth [expr {(-120+[$w cget -width])/(1.0+$yfract)}] 233 #set yzheight [expr {(-60+[$w cget -height])/(1.0+$zfract)}] 234 235 set pxmin [expr {60+$yfract*$yzwidth}] 236 set pxmax [expr {[WidthCanvas $w] - 60}] 237 #set pxmax [expr {[$w cget -width] - 60}] 238 set pymin 30 239 set pymax [expr {30+$yzheight}] 240 241 return [list $pxmin $pymin $pxmax $pymax] 242} 243 244# SetColours -- 245# Set the colours for those plots that treat them as a global resource 246# Arguments: 247# w Name of the canvas 248# args List of colours to be used 249# Result: 250# None 251# 252proc ::Plotchart::SetColours { w args } { 253 variable scaling 254 255 set scaling($w,colours) $args 256} 257 258# CycleColours -- 259# create cycling colours for those plots that treat them as a global resource 260# Arguments: 261# colours List of colours to be used. An empty list will activate to default colours 262# nr_data Number of data records 263# Result: 264# List of 'nr_data' colours to be used 265# 266proc ::Plotchart::CycleColours { colours nr_data } { 267 if {![llength ${colours}]} { 268 # force to most usable default colour list 269 set colours {green blue red cyan yellow magenta} 270 } 271 272 if {[llength ${colours}] < ${nr_data}} { 273 # cycle through colours 274 set init_colours ${colours} 275 set colours {} 276 set pos 0 277 for {set nr 0} {${nr} < ${nr_data}} {incr nr} { 278 lappend colours [lindex ${init_colours} ${pos}] 279 incr pos 280 if {[llength ${init_colours}] <= ${pos}} { 281 set pos 0 282 } 283 } 284 if {[string equal [lindex ${colours} 0] [lindex ${colours} end]]} { 285 # keep first and last colour different from selected colours 286 # this will /sometimes fail in cases with only one/two colours in list 287 set colours [lreplace ${colours} end end [lindex ${colours} 1]] 288 } 289 } 290 return ${colours} 291} 292 293# DataConfig -- 294# Configure the data series 295# Arguments: 296# w Name of the canvas 297# series Name of the series in question 298# args Option and value pairs 299# Result: 300# None 301# 302proc ::Plotchart::DataConfig { w series args } { 303 variable data_series 304 variable options 305 variable option_keys 306 variable option_values 307 308 foreach {option value} $args { 309 set idx [lsearch $options $option] 310 if { $idx < 0 } { 311 return -code error "Unknown or invalid option: $option (value: $value)" 312 } else { 313 set key [lindex $option_keys $idx] 314 set idx [lsearch $option_values $key] 315 set values [lindex $option_values [incr idx]] 316 if { $values != "..." } { 317 if { [lsearch $values $value] < 0 } { 318 return -code error "Unknown or invalid value: $value for option $option - $values" 319 } 320 } 321 set data_series($w,$series,$key) $value 322 } 323 } 324} 325 326# ScaleIsometric -- 327# Determine the scaling for an isometric plot 328# Arguments: 329# w Name of the canvas 330# xmin Minimum x coordinate 331# ymin Minimum y coordinate 332# xmax Maximum x coordinate 333# ymax Maximum y coordinate 334# (default: 1.5) 335# Result: 336# None 337# Side effect: 338# Array with scaling parameters set 339# 340proc ::Plotchart::ScaleIsometric { w xmin ymin xmax ymax } { 341 variable scaling 342 343 set pxmin $scaling($w,pxmin) 344 set pymin $scaling($w,pymin) 345 set pxmax $scaling($w,pxmax) 346 set pymax $scaling($w,pymax) 347 348 set dx [expr {double($xmax-$xmin)/($pxmax-$pxmin)}] 349 set dy [expr {double($ymax-$ymin)/($pymax-$pymin)}] 350 351 # 352 # Which coordinate is dominant? 353 # 354 if { $dy < $dx } { 355 set yminn [expr {0.5*($ymax+$ymin) - 0.5 * $dx * ($pymax-$pymin)}] 356 set ymaxn [expr {0.5*($ymax+$ymin) + 0.5 * $dx * ($pymax-$pymin)}] 357 set ymin $yminn 358 set ymax $ymaxn 359 } else { 360 set xminn [expr {0.5*($xmax+$xmin) - 0.5 * $dy * ($pxmax-$pxmin)}] 361 set xmaxn [expr {0.5*($xmax+$xmin) + 0.5 * $dy * ($pxmax-$pxmin)}] 362 set xmin $xminn 363 set xmax $xmaxn 364 } 365 366 worldCoordinates $w $xmin $ymin $xmax $ymax 367} 368 369# PlotHandler -- 370# Handle the subcommands for an XY plot or chart 371# Arguments: 372# type Type of plot/chart 373# w Name of the canvas 374# command Subcommand or method to run 375# args Data for the command 376# Result: 377# Whatever returned by the subcommand 378# 379proc ::Plotchart::PlotHandler { type w command args } { 380 variable methodProc 381 382 if { [info exists methodProc($type,$command)] } { 383 if { [llength $methodProc($type,$command)] == 1 } { 384 eval $methodProc($type,$command) $w $args 385 } else { 386 eval $methodProc($type,$command)_$w $w $args 387 } 388 } else { 389 return -code error "No such method - $command" 390 } 391} 392 393# DrawMask -- 394# Draw the stuff that masks the data lines outside the graph 395# Arguments: 396# w Name of the canvas 397# Result: 398# None 399# Side effects: 400# Several polygons drawn in the background colour 401# 402proc ::Plotchart::DrawMask { w } { 403 variable scaling 404 variable config 405 406 set width [expr {[WidthCanvas $w] + 1}] 407 set height [expr {[HeightCanvas $w] + 1}] 408 set colour $config($w,background,outercolor) 409 set pxmin [expr {$scaling($w,pxmin)-1}] 410 set pxmax $scaling($w,pxmax) 411 set pymin [expr {$scaling($w,pymin)-1}] 412 set pymax $scaling($w,pymax) 413 $w create rectangle 0 0 $pxmin $height -fill $colour -outline $colour -tag mask 414 $w create rectangle 0 0 $width $pymin -fill $colour -outline $colour -tag mask 415 $w create rectangle 0 $pymax $width $height -fill $colour -outline $colour -tag mask 416 $w create rectangle $pxmax 0 $width $height -fill $colour -outline $colour -tag mask 417 418 $w lower mask 419} 420 421# DrawScrollMask -- 422# Draw the masking rectangles for a time or Gantt chart 423# Arguments: 424# w Name of the canvas 425# Result: 426# None 427# Side effects: 428# Several polygons drawn in the background colour, with appropriate 429# tags 430# 431proc ::Plotchart::DrawScrollMask { w } { 432 variable scaling 433 variable config 434 435 set width [expr {[WidthCanvas $w] + 1}] 436 set height [expr {[HeightCanvas $w] + 1}] 437 set colour $config($w,background,outercolor) 438 set pxmin [expr {$scaling($w,pxmin)-1}] 439 set pxmax $scaling($w,pxmax) 440 set pymin [expr {$scaling($w,pymin)-1}] 441 set pymax $scaling($w,pymax) 442 $w create rectangle 0 0 $pxmin $height -fill $colour -outline $colour -tag vertmask 443 $w create rectangle 0 0 $width $pymin -fill $colour -outline $colour -tag horizmask 444 $w create rectangle 0 $pymax $width $height -fill $colour -outline $colour -tag horizmask 445 $w create rectangle $pxmax 0 $width $height -fill $colour -outline $colour -tag vertmask 446 447 $w create rectangle 0 0 $pxmin $pymin -fill $colour -outline $colour -tag {topmask top} 448 $w create rectangle $pxmax 0 $width $pymin -fill $colour -outline $colour -tag {topmask top} 449 450 $w lower topmask 451 $w lower horizmask 452 $w lower vertmask 453} 454 455# DrawTitle -- 456# Draw the title 457# Arguments: 458# w Name of the canvas 459# title Title to appear above the graph 460# Result: 461# None 462# Side effects: 463# Text string drawn 464# 465proc ::Plotchart::DrawTitle { w title } { 466 variable scaling 467 variable config 468 469 set width [WidthCanvas $w] 470 #set width [$w cget -width] 471 set pymin $scaling($w,pymin) 472 473 $w create text [expr {$width/2}] 3 -text $title \ 474 -tags title -font $config($w,title,font) \ 475 -fill $config($w,title,textcolor) -anchor $config($w,title,anchor) 476} 477 478# DrawData -- 479# Draw the data in an XY-plot 480# Arguments: 481# w Name of the canvas 482# series Data series 483# xcrd Next x coordinate 484# ycrd Next y coordinate 485# Result: 486# None 487# Side effects: 488# New data drawn in canvas 489# 490proc ::Plotchart::DrawData { w series xcrd ycrd } { 491 variable data_series 492 variable scaling 493 494 # 495 # Check for missing values 496 # 497 if { $xcrd == "" || $ycrd == "" } { 498 unset data_series($w,$series,x) 499 return 500 } 501 502 # 503 # Draw the line piece 504 # 505 set colour "black" 506 if { [info exists data_series($w,$series,-colour)] } { 507 set colour $data_series($w,$series,-colour) 508 } 509 510 set type "line" 511 if { [info exists data_series($w,$series,-type)] } { 512 set type $data_series($w,$series,-type) 513 } 514 set filled "no" 515 if { [info exists data_series($w,$series,-filled)] } { 516 set filled $data_series($w,$series,-filled) 517 } 518 set fillcolour white 519 if { [info exists data_series($w,$series,-fillcolour)] } { 520 set fillcolour $data_series($w,$series,-fillcolour) 521 } 522 set width 1 523 if { [info exists data_series($w,$series,-width)] } { 524 set width $data_series($w,$series,-width) 525 } 526 527 foreach {pxcrd pycrd} [coordsToPixel $w $xcrd $ycrd] {break} 528 529 if { [info exists data_series($w,$series,x)] } { 530 set xold $data_series($w,$series,x) 531 set yold $data_series($w,$series,y) 532 foreach {pxold pyold} [coordsToPixel $w $xold $yold] {break} 533 534 if { $filled ne "no" } { 535 if { $filled eq "down" } { 536 set pym $scaling($w,pymax) 537 } else { 538 set pym $scaling($w,pymin) 539 } 540 $w create polygon $pxold $pym $pxold $pyold $pxcrd $pycrd $pxcrd $pym \ 541 -fill $fillcolour -outline {} -width $width -tag [list data data_$series] 542 } 543 544 if { $type == "line" || $type == "both" } { 545 $w create line $pxold $pyold $pxcrd $pycrd \ 546 -fill $colour -width $width -tag [list data data_$series] 547 } 548 } 549 550 if { $type == "symbol" || $type == "both" } { 551 set symbol "dot" 552 if { [info exists data_series($w,$series,-symbol)] } { 553 set symbol $data_series($w,$series,-symbol) 554 } 555 DrawSymbolPixel $w $series $pxcrd $pycrd $symbol $colour [list "data" data_$series] 556 } 557 558 $w lower data 559 560 set data_series($w,$series,x) $xcrd 561 set data_series($w,$series,y) $ycrd 562} 563 564# DrawStripData -- 565# Draw the data in a stripchart 566# Arguments: 567# w Name of the canvas 568# series Data series 569# xcrd Next x coordinate 570# ycrd Next y coordinate 571# Result: 572# None 573# Side effects: 574# New data drawn in canvas 575# 576proc ::Plotchart::DrawStripData { w series xcrd ycrd } { 577 variable data_series 578 variable scaling 579 580 # 581 # Check for missing values 582 # 583 if { $xcrd == "" || $ycrd == "" } { 584 unset data_series($w,$series,x) 585 return 586 } 587 588 if { $xcrd > $scaling($w,xmax) } { 589 set xdelt $scaling($w,xdelt) 590 set xmin $scaling($w,xmin) 591 set xmax $scaling($w,xmax) 592 593 set xminorg $xmin 594 while { $xmax < $xcrd } { 595 set xmin [expr {$xmin+$xdelt}] 596 set xmax [expr {$xmax+$xdelt}] 597 } 598 set ymin $scaling($w,ymin) 599 set ymax $scaling($w,ymax) 600 601 worldCoordinates $w $xmin $ymin $xmax $ymax 602 DrawXaxis $w $xmin $xmax $xdelt 603 604 foreach {pxminorg pyminorg} [coordsToPixel $w $xminorg $ymin] {break} 605 foreach {pxmin pymin} [coordsToPixel $w $xmin $ymin] {break} 606 $w move data [expr {$pxminorg-$pxmin+1}] 0 607 } 608 609 DrawData $w $series $xcrd $ycrd 610} 611 612# DrawLogYData -- 613# Draw the data in an X-logY-plot 614# Arguments: 615# w Name of the canvas 616# series Data series 617# xcrd Next x coordinate 618# ycrd Next y coordinate 619# Result: 620# None 621# Side effects: 622# New data drawn in canvas 623# 624proc ::Plotchart::DrawLogYData { w series xcrd ycrd } { 625 626 DrawData $w $series $xcrd [expr {log10($ycrd)}] 627} 628 629# DrawLogXData -- 630# Draw the data in an logX-Y-plot 631# Arguments: 632# w Name of the canvas 633# series Data series 634# xcrd Next x coordinate 635# ycrd Next y coordinate 636# Result: 637# None 638# Side effects: 639# New data drawn in canvas 640# 641proc ::Plotchart::DrawLogXData { w series xcrd ycrd } { 642 643 DrawData $w $series [expr {log10($xcrd)}] $ycrd 644} 645 646# DrawLogXLogYData -- 647# Draw the data in an logX-logY-plot 648# Arguments: 649# w Name of the canvas 650# series Data series 651# xcrd Next x coordinate 652# ycrd Next y coordinate 653# Result: 654# None 655# Side effects: 656# New data drawn in canvas 657# 658proc ::Plotchart::DrawLogXLogYData { w series xcrd ycrd } { 659 660 DrawData $w $series [expr {log10($xcrd)}] [expr {log10($ycrd)}] 661} 662 663# DrawInterval -- 664# Draw the data as an error interval in an XY-plot 665# Arguments: 666# w Name of the canvas 667# series Data series 668# xcrd X coordinate 669# ymin Minimum y coordinate 670# ymax Maximum y coordinate 671# ycentr Central y coordinate (optional) 672# Result: 673# None 674# Side effects: 675# New interval drawn in canvas 676# 677proc ::Plotchart::DrawInterval { w series xcrd ymin ymax {ycentr {}} } { 678 variable data_series 679 variable scaling 680 681 # 682 # Check for missing values 683 # 684 if { $xcrd == "" || $ymin == "" || $ymax == "" } { 685 return 686 } 687 688 # 689 # Draw the line piece 690 # 691 set colour "black" 692 if { [info exists data_series($w,$series,-colour)] } { 693 set colour $data_series($w,$series,-colour) 694 } 695 696 foreach {pxcrd pymin} [coordsToPixel $w $xcrd $ymin] {break} 697 foreach {pxcrd pymax} [coordsToPixel $w $xcrd $ymax] {break} 698 if { $ycentr != "" } { 699 foreach {pxcrd pycentr} [coordsToPixel $w $xcrd $ycentr] {break} 700 } 701 702 # 703 # Draw the I-shape (note the asymmetry!) 704 # 705 $w create line $pxcrd $pymin $pxcrd $pymax \ 706 -fill $colour -tag [list data data_$series] 707 $w create line [expr {$pxcrd-3}] $pymin [expr {$pxcrd+4}] $pymin \ 708 -fill $colour -tag [list data data_$series] 709 $w create line [expr {$pxcrd-3}] $pymax [expr {$pxcrd+4}] $pymax \ 710 -fill $colour -tag [list data data_$series] 711 712 if { $ycentr != "" } { 713 set symbol "dot" 714 if { [info exists data_series($w,$series,-symbol)] } { 715 set symbol $data_series($w,$series,-symbol) 716 } 717 DrawSymbolPixel $w $series $pxcrd $pycentr $symbol $colour [list data data_$series] 718 } 719 720 $w lower data 721} 722 723# DrawSymbolPixel -- 724# Draw a symbol in an xy-plot, polar plot or stripchart 725# Arguments: 726# w Name of the canvas 727# series Data series 728# pxcrd Next x (pixel) coordinate 729# pycrd Next y (pixel) coordinate 730# symbol What symbol to draw 731# colour What colour to use 732# tag What tag to use 733# Result: 734# None 735# Side effects: 736# New symbol drawn in canvas 737# 738proc ::Plotchart::DrawSymbolPixel { w series pxcrd pycrd symbol colour tag } { 739 variable data_series 740 variable scaling 741 742 set pxmin [expr {$pxcrd-4}] 743 set pxmax [expr {$pxcrd+4}] 744 set pymin [expr {$pycrd-4}] 745 set pymax [expr {$pycrd+4}] 746 747 switch -- $symbol { 748 "plus" { $w create line $pxmin $pycrd $pxmax $pycrd \ 749 $pxcrd $pycrd $pxcrd $pymin \ 750 $pxcrd $pymax \ 751 -fill $colour -tag $tag \ 752 -capstyle projecting 753 } 754 "cross" { $w create line $pxmin $pymin $pxmax $pymax \ 755 $pxcrd $pycrd $pxmax $pymin \ 756 $pxmin $pymax \ 757 -fill $colour -tag $tag \ 758 -capstyle projecting 759 } 760 "circle" { $w create oval $pxmin $pymin $pxmax $pymax \ 761 -outline $colour -tag $tag 762 } 763 "dot" { $w create oval $pxmin $pymin $pxmax $pymax \ 764 -outline $colour -fill $colour -tag $tag 765 } 766 "up" { $w create polygon $pxmin $pymax $pxmax $pymax \ 767 $pxcrd $pymin \ 768 -outline $colour -fill {} -tag $tag 769 } 770 "upfilled" { $w create polygon $pxmin $pymax $pxmax $pymax \ 771 $pxcrd $pymin \ 772 -outline $colour -fill $colour -tag $tag 773 } 774 "down" { $w create polygon $pxmin $pymin $pxmax $pymin \ 775 $pxcrd $pymax \ 776 -outline $colour -fill {} -tag $tag 777 } 778 "downfilled" { $w create polygon $pxmin $pymin $pxmax $pymin \ 779 $pxcrd $pymax \ 780 -outline $colour -fill $colour -tag $tag 781 } 782 } 783} 784 785# DrawTimeData -- 786# Draw the data in an TX-plot 787# Arguments: 788# w Name of the canvas 789# series Data series 790# time Next date/time value 791# xcrd Next x coordinate (vertical axis) 792# Result: 793# None 794# Side effects: 795# New data drawn in canvas 796# 797proc ::Plotchart::DrawTimeData { w series time xcrd } { 798 DrawData $w $series [clock scan $time] $xcrd 799} 800 801# DetermineMedian -- 802# Determine the median of a sorted list of values 803# Arguments: 804# values Sorted values 805# Result: 806# Median value 807# 808proc ::Plotchart::DetermineMedian { values } { 809 set length [llength $values] 810 811 if { $length == 1 } { 812 set median [lindex $values 0] 813 } elseif { $length % 2 == 1 } { 814 set median [lindex $values [expr {$length/2}]] 815 } else { 816 set median1 [lindex $values [expr {$length/2-1}]] 817 set median2 [lindex $values [expr {$length/2}]] 818 set median [expr {($median1 + $median2)/2.0}] 819 } 820 return $median 821} 822 823# DrawBoxWhiskers -- 824# Draw the data in an XY-plot as box-and-whiskers 825# Arguments: 826# w Name of the canvas 827# series Data series 828# xcrd Next x coordinate or a list of coordinates 829# ycrd Next y coordinate or a list of coordinates 830# Result: 831# None 832# Side effects: 833# New data drawn in canvas 834# Note: 835# We can do either a horizontal box (one y value) or 836# a vertical box (one x value). Not both 837# 838proc ::Plotchart::DrawBoxWhiskers { w series xcrd ycrd } { 839 variable data_series 840 variable scaling 841 842 # 843 # Check orientation 844 # 845 set type "?" 846 if { [llength $xcrd] > 1 && [llength $ycrd] == 1 } { 847 set type h 848 } 849 if { [llength $xcrd] == 1 && [llength $ycrd] > 1 } { 850 set type v 851 } 852 if { $type == "?" } { 853 return -code error "Use either a list of x values or a list of y values - not both" 854 } 855 856 # 857 # Determine the quartiles 858 # 859 if { $type == "h" } { 860 set data [lsort -real -increasing $xcrd] 861 } else { 862 set data [lsort -real -increasing $ycrd] 863 } 864 set length [llength $data] 865 if { $length % 2 == 0 } { 866 set lowerhalf [expr {($length-1)/2}] 867 set upperhalf [expr {($length+1)/2}] 868 } else { 869 set lowerhalf [expr {$length/2-1}] 870 set upperhalf [expr {$length/2+1}] 871 } 872 873 set quartile2 [DetermineMedian $data] 874 set quartile1 [DetermineMedian [lrange $data 0 $lowerhalf]] 875 set quartile3 [DetermineMedian [lrange $data $upperhalf end]] 876 877 set hspread [expr {$quartile3-$quartile1}] 878 879 set lower [expr {$quartile1-1.5*$hspread}] 880 set upper [expr {$quartile3+1.5*$hspread}] 881 set outlower [expr {$quartile1-3.0*$hspread}] 882 set outupper [expr {$quartile3+3.0*$hspread}] 883 884 set minimum {} 885 set maximum {} 886 foreach value $data { 887 if { $value >= $lower } { 888 if { $minimum == {} || $minimum > $value } { 889 set minimum $value 890 } 891 } 892 if { $value <= $upper } { 893 if { $maximum == {} || $maximum < $value } { 894 set maximum $value 895 } 896 } 897 } 898 899 # 900 # Draw the box and whiskers 901 # 902 set colour "black" 903 if { [info exists data_series($w,$series,-colour)] } { 904 set colour $data_series($w,$series,-colour) 905 } 906 set filled "no" 907 if { [info exists data_series($w,$series,-filled)] } { 908 set filled $data_series($w,$series,-filled) 909 } 910 set fillcolour white 911 if { [info exists data_series($w,$series,-fillcolour)] } { 912 set fillcolour $data_series($w,$series,-fillcolour) 913 } 914 set boxwidth 10 915 if { [info exists data_series($w,$series,-boxwidth)] } { 916 set boxwidth $data_series($w,$series,-boxwidth) 917 } 918 919 if { $type == "h" } { 920 foreach {pxcrdm pycrd1} [coordsToPixel $w $minimum $ycrd] {break} 921 foreach {pxcrd1 pycrd2} [coordsToPixel $w $quartile1 $ycrd] {break} 922 foreach {pxcrd2 pycrd2} [coordsToPixel $w $quartile2 $ycrd] {break} 923 foreach {pxcrd3 pycrd2} [coordsToPixel $w $quartile3 $ycrd] {break} 924 foreach {pxcrdM pycrd2} [coordsToPixel $w $maximum $ycrd] {break} 925 926 set pycrd0 [expr {$pycrd1-$boxwidth/2}] 927 set pycrd2 [expr {$pycrd1+$boxwidth/2}] 928 set pycrd0h [expr {$pycrd1-$boxwidth/4}] 929 set pycrd2h [expr {$pycrd1+$boxwidth/4}] 930 931 $w create line $pxcrdm $pycrd1 $pxcrd1 $pycrd1 \ 932 -fill $colour -tag [list data data_$series] 933 $w create line $pxcrdm $pycrd0h $pxcrdm $pycrd2h \ 934 -fill $colour -tag [list data data_$series] 935 $w create line $pxcrd3 $pycrd1 $pxcrdM $pycrd1 \ 936 -fill $colour -tag [list data data_$series] 937 $w create line $pxcrdM $pycrd0h $pxcrdM $pycrd2h \ 938 -fill $colour -tag [list data data_$series] 939 $w create rectangle $pxcrd1 $pycrd0 $pxcrd3 $pycrd2 \ 940 -outline $colour -fill $fillcolour -tag [list data data_$series] 941 $w create line $pxcrd2 $pycrd0 $pxcrd2 $pycrd2 -width 2 \ 942 -fill $colour -tag [list data data_$series] 943 944 foreach value $data { 945 if { $value < $outlower || $value > $outupper } { 946 foreach {px py} [coordsToPixel $w $value $ycrd] {break} 947 $w create text $px $py -text "*" -anchor c \ 948 -fill $colour -tag [list data data_$series] 949 continue 950 } 951 if { $value < $lower || $value > $upper } { 952 foreach {px py} [coordsToPixel $w $value $ycrd] {break} 953 $w create oval [expr {$px-2}] [expr {$py-2}] \ 954 [expr {$px+2}] [expr {$py+2}] \ 955 -fill $colour -tag [list data data_$series] 956 continue 957 } 958 } 959 960 } else { 961 foreach {pxcrd1 pycrdm} [coordsToPixel $w $xcrd $minimum ] {break} 962 foreach {pxcrd2 pycrd1} [coordsToPixel $w $xcrd $quartile1] {break} 963 foreach {pxcrd2 pycrd2} [coordsToPixel $w $xcrd $quartile2] {break} 964 foreach {pxcrd2 pycrd3} [coordsToPixel $w $xcrd $quartile3] {break} 965 foreach {pxcrd2 pycrdM} [coordsToPixel $w $xcrd $maximum ] {break} 966 967 set pxcrd0 [expr {$pxcrd1-$boxwidth/2}] 968 set pxcrd2 [expr {$pxcrd1+$boxwidth/2}] 969 set pxcrd0h [expr {$pxcrd1-$boxwidth/4}] 970 set pxcrd2h [expr {$pxcrd1+$boxwidth/4}] 971 972 $w create line $pxcrd1 $pycrdm $pxcrd1 $pycrd1 \ 973 -fill $colour -tag [list data data_$series] 974 $w create line $pxcrd0h $pycrdm $pxcrd2h $pycrdm \ 975 -fill $colour -tag [list data data_$series] 976 $w create line $pxcrd1 $pycrd3 $pxcrd1 $pycrdM \ 977 -fill $colour -tag [list data data_$series] 978 $w create line $pxcrd0h $pycrdM $pxcrd2h $pycrdM \ 979 -fill $colour -tag [list data data_$series] 980 $w create rectangle $pxcrd0 $pycrd1 $pxcrd2 $pycrd3 \ 981 -outline $colour -fill $fillcolour -tag [list data data_$series] 982 $w create line $pxcrd0 $pycrd2 $pxcrd2 $pycrd2 -width 2 \ 983 -fill $colour -tag [list data data_$series] 984 985 foreach value $data { 986 if { $value < $outlower || $value > $outupper } { 987 foreach {px py} [coordsToPixel $w $xcrd $value] {break} 988 $w create text $px $py -text "*" \ 989 -fill $colour -tag [list data data_$series] 990 continue 991 } 992 if { $value < $lower || $value > $upper } { 993 foreach {px py} [coordsToPixel $w $xcrd $value] {break} 994 $w create oval [expr {$px-3}] [expr {$py-3}] \ 995 [expr {$px+3}] [expr {$py+3}] \ 996 -fill $colour -tag [list data data_$series] 997 continue 998 } 999 } 1000 } 1001 1002 $w lower data 1003} 1004 1005# DrawBoxData -- 1006# Draw the data in a boxplot (y-axis consists of labels) 1007# Arguments: 1008# w Name of the canvas 1009# label Label on the y-axis to put the box on 1010# xcrd Next x coordinate or a list of coordinates 1011# Result: 1012# None 1013# Side effects: 1014# New data drawn in canvas 1015# 1016proc ::Plotchart::DrawBoxData { w label xcrd } { 1017 variable config 1018 variable scaling 1019 1020 set index [lsearch $config($w,axisnames) $label] 1021 if { $index == -1 } { 1022 return "Label $label not found on y-axis" 1023 } 1024 1025 set ycrd [expr {$index+0.5}] 1026 1027 DrawBoxWhiskers $w box $xcrd $ycrd 1028} 1029 1030# DrawPie -- 1031# Draw the pie 1032# Arguments: 1033# w Name of the canvas 1034# data Data series (pairs of label-value) 1035# Result: 1036# None 1037# Side effects: 1038# Pie filled 1039# 1040proc ::Plotchart::DrawPie { w data } { 1041 variable data_series 1042 variable scaling 1043 1044 set pxmin $scaling($w,pxmin) 1045 set pymin $scaling($w,pymin) 1046 set pxmax $scaling($w,pxmax) 1047 set pymax $scaling($w,pymax) 1048 1049 set colours $scaling(${w},colours) 1050 1051 if {[llength ${data}] == 2} { 1052 # use canvas create oval as arc does not fill with colour for a full circle 1053 set colour [lindex ${colours} 0] 1054 ${w} create oval ${pxmin} ${pymin} ${pxmax} ${pymax} -fill ${colour} 1055 # text looks nicer at 45 degree 1056 set rad [expr {45.0 * 3.1415926 / 180.0}] 1057 set xtext [expr {(${pxmin}+${pxmax}+cos(${rad})*(${pxmax}-${pxmin}+20))/2}] 1058 set ytext [expr {(${pymin}+${pymax}-sin(${rad})*(${pymax}-${pymin}+20))/2}] 1059 foreach {label value} ${data} { 1060 break 1061 } 1062 ${w} create text ${xtext} ${ytext} -text ${label} -anchor w 1063 set scaling($w,angles) {0 360} 1064 } else { 1065 # 1066 # Determine the scale for the values 1067 # (so we can draw the correct angles) 1068 # 1069 1070 set sum 0.0 1071 foreach {label value} $data { 1072 set sum [expr {$sum + $value}] 1073 } 1074 set factor [expr {360.0/$sum}] 1075 1076 # 1077 # Draw the line piece 1078 # 1079 set angle_bgn 0.0 1080 set angle_ext 0.0 1081 set sum 0.0 1082 1083 set idx 0 1084 set segment 0 1085 1086 array unset scaling ${w},angles 1087 array unset scaling ${w},extent 1088 set colours [CycleColours ${colours} [expr {[llength ${data}] / 2}]] 1089 1090 foreach {label value} $data { 1091 set colour [lindex $colours $idx] 1092 incr idx 1093 1094 if { $value == "" } { 1095 break 1096 } 1097 1098 set angle_bgn [expr {$sum * $factor}] 1099 set angle_ext [expr {$value * $factor}] 1100 lappend scaling(${w},angles) [expr {int(${angle_bgn})}] 1101 lappend scaling(${w},extent) [expr {int(${angle_ext})}] 1102 1103 $w create arc $pxmin $pymin $pxmax $pymax \ 1104 -start $angle_bgn -extent $angle_ext \ 1105 -fill $colour -style pieslice -tag segment_$segment 1106 1107 set rad [expr {($angle_bgn+0.5*$angle_ext)*3.1415926/180.0}] 1108 set xtext [expr {($pxmin+$pxmax+cos($rad)*($pxmax-$pxmin+20))/2}] 1109 set ytext [expr {($pymin+$pymax-sin($rad)*($pymax-$pymin+20))/2}] 1110 if { $xtext > ($pxmin+$pymax)/2 } { 1111 set dir w 1112 } else { 1113 set dir e 1114 } 1115 1116 $w create text $xtext $ytext -text $label -anchor $dir -tag segment_$segment 1117 1118 $w bind segment_$segment <ButtonPress-1> [list ::Plotchart::PieExplodeSegment $w $segment 1] 1119 1120 set sum [expr {$sum + $value}] 1121 incr segment 1122 } 1123 } 1124} 1125 1126# DrawPolarData -- 1127# Draw data given in polar coordinates 1128# Arguments: 1129# w Name of the canvas 1130# series Data series 1131# rad Next radius 1132# phi Next angle (in degrees) 1133# Result: 1134# None 1135# Side effects: 1136# Data drawn in canvas 1137# 1138proc ::Plotchart::DrawPolarData { w series rad phi } { 1139 variable torad 1140 set xcrd [expr {$rad*cos($phi*$torad)}] 1141 set ycrd [expr {$rad*sin($phi*$torad)}] 1142 1143 DrawData $w $series $xcrd $ycrd 1144} 1145 1146# DrawVertBarData -- 1147# Draw the vertical bars 1148# Arguments: 1149# w Name of the canvas 1150# series Data series 1151# ydata Series of y data 1152# colour The colour to use (optional) 1153# dir Direction if graded colours are used (see DrawGradientBackground) 1154# brightness Brighten (bright) or darken (dark) the colours 1155# Result: 1156# None 1157# Side effects: 1158# Data bars drawn in canvas 1159# 1160proc ::Plotchart::DrawVertBarData { w series ydata {colour black} {dir {}} {brightness bright}} { 1161 variable data_series 1162 variable scaling 1163 variable legend 1164 variable settings 1165 1166 # 1167 # Draw the bars 1168 # 1169 set x $scaling($w,xbase) 1170 1171 # 1172 # set the colours 1173 # 1174 if {[llength ${colour}]} { 1175 set colours ${colour} 1176 } elseif {[info exists scaling(${w},colours)]} { 1177 set colours $scaling(${w},colours) 1178 } else { 1179 set colours {} 1180 } 1181 set colours [CycleColours ${colours} [llength ${ydata}]] 1182 1183 # 1184 # Legend information 1185 # 1186 set legendcol [lindex $colours 0] 1187 set data_series($w,$series,-colour) $legendcol 1188 set data_series($w,$series,-type) rectangle 1189 if { [info exists legend($w,canvas)] } { 1190 set legendw $legend($w,canvas) 1191 $legendw itemconfigure $series -fill $legendcol 1192 } 1193 1194 set newbase {} 1195 1196 set idx 0 1197 foreach yvalue $ydata ybase $scaling($w,ybase) { 1198 set colour [lindex ${colours} ${idx}] 1199 incr idx 1200 1201 if { $yvalue == "" } { 1202 set yvalue 0.0 1203 } 1204 1205 set xnext [expr {$x+$scaling($w,barwidth)}] 1206 set y [expr {$yvalue+$ybase}] 1207 foreach {px1 py1} [coordsToPixel $w $x $ybase] {break} 1208 foreach {px2 py2} [coordsToPixel $w $xnext $y ] {break} 1209 1210 if { $dir == {} } { 1211 $w create rectangle $px1 $py1 $px2 $py2 \ 1212 -fill $colour -tag [list data data_$series] 1213 } else { 1214 if { $brightness == "dark" } { 1215 set intensity black 1216 } else { 1217 set intensity white 1218 } 1219 DrawGradientBackground $w $colour $dir $intensity [list $px1 $py1 $px2 $py2] 1220 } 1221 1222 if { $settings($w,showvalues) } { 1223 set pxtext [expr {($px1+$px2)/2.0}] 1224 set pytext [expr {$py2-5}] 1225 set text [format $settings($w,valueformat) $yvalue] 1226 if { $settings($w,valuefont) == "" } { 1227 $w create text $pxtext $pytext -text $text -anchor s \ 1228 -fill $settings($w,valuecolour) -tag [list data data_$series] 1229 } else { 1230 $w create text $pxtext $pytext -text $text -anchor s \ 1231 -fill $settings($w,valuecolour) -tag [list data data_$series] \ 1232 -font $settings($w,valuefont) 1233 } 1234 } 1235 1236 $w lower data 1237 1238 set x [expr {$x+1.0}] 1239 1240 lappend newbase $y 1241 } 1242 1243 # 1244 # Prepare for the next series 1245 # 1246 if { $scaling($w,stacked) } { 1247 set scaling($w,ybase) $newbase 1248 } 1249 1250 set scaling($w,xbase) [expr {$scaling($w,xbase)+$scaling($w,xshift)}] 1251} 1252 1253# DrawHorizBarData -- 1254# Draw the horizontal bars 1255# Arguments: 1256# w Name of the canvas 1257# series Data series 1258# xdata Series of x data 1259# colour The colour to use (optional) 1260# dir Direction if graded colours are used (see DrawGradientBackground) 1261# brightness Brighten (bright) or darken (dark) the colours 1262# Result: 1263# None 1264# Side effects: 1265# Data bars drawn in canvas 1266# 1267proc ::Plotchart::DrawHorizBarData { w series xdata {colour black} {dir {}} {brightness bright}} { 1268 variable data_series 1269 variable scaling 1270 variable legend 1271 variable settings 1272 1273 # 1274 # Draw the bars 1275 # 1276 set y $scaling($w,ybase) 1277 1278 # 1279 # set the colours 1280 # 1281 if {[llength ${colour}]} { 1282 set colours ${colour} 1283 } elseif {[info exists scaling(${w},colours)]} { 1284 set colours $scaling(${w},colours) 1285 } else { 1286 set colours {} 1287 } 1288 set colours [CycleColours ${colours} [llength ${xdata}]] 1289 1290 # 1291 # Legend information 1292 # 1293 set legendcol [lindex $colours 0] 1294 set data_series($w,$series,-colour) $legendcol 1295 if { [info exists legend($w,canvas)] } { 1296 set legendw $legend($w,canvas) 1297 $legendw itemconfigure $series -fill $legendcol 1298 } 1299 1300 set newbase {} 1301 1302 set idx 0 1303 foreach xvalue $xdata xbase $scaling($w,xbase) { 1304 set colour [lindex ${colours} ${idx}] 1305 incr idx 1306 1307 if { $xvalue == "" } { 1308 set xvalue 0.0 1309 } 1310 1311 set ynext [expr {$y+$scaling($w,barwidth)}] 1312 set x [expr {$xvalue+$xbase}] 1313 foreach {px1 py1} [coordsToPixel $w $xbase $y ] {break} 1314 foreach {px2 py2} [coordsToPixel $w $x $ynext] {break} 1315 1316 if { $dir == {} } { 1317 $w create rectangle $px1 $py1 $px2 $py2 \ 1318 -fill $colour -tag data 1319 } else { 1320 if { $brightness == "dark" } { 1321 set intensity black 1322 } else { 1323 set intensity white 1324 } 1325 DrawGradientBackground $w $colour $dir $intensity [list $px1 $py1 $px2 $py2] 1326 } 1327 1328 if { $settings($w,showvalues) } { 1329 set pytext [expr {($py1+$py2)/2.0}] 1330 set pxtext [expr {$px2+5}] 1331 set text [format $settings($w,valueformat) $xvalue] 1332 if { $settings($w,valuefont) == "" } { 1333 $w create text $pxtext $pytext -text $text -anchor w \ 1334 -fill $settings($w,valuecolour) -tag [list data data_$series] 1335 } else { 1336 $w create text $pxtext $pytext -text $text -anchor w \ 1337 -fill $settings($w,valuecolour) -tag [list data data_$series] \ 1338 -font $settings($w,valuefont) 1339 } 1340 } 1341 1342 $w lower data 1343 1344 set y [expr {$y+1.0}] 1345 1346 lappend newbase $x 1347 } 1348 1349 # 1350 # Prepare for the next series 1351 # 1352 if { $scaling($w,stacked) } { 1353 set scaling($w,xbase) $newbase 1354 } 1355 1356 set scaling($w,ybase) [expr {$scaling($w,ybase)+$scaling($w,yshift)}] 1357} 1358 1359# DrawHistogramData -- 1360# Draw the vertical bars for a histogram 1361# Arguments: 1362# w Name of the canvas 1363# series Data series 1364# xcrd X coordinate (for the righthand side of the bar) 1365# ycrd Y coordinate 1366# Result: 1367# None 1368# Side effects: 1369# Data bars drawn in canvas 1370# 1371proc ::Plotchart::DrawHistogramData { w series xcrd ycrd } { 1372 variable data_series 1373 variable scaling 1374 1375 # 1376 # Check for missing values (only y-value can be missing!) 1377 # 1378 if { $ycrd == "" } { 1379 set data_series($w,$series,x) $xcrd 1380 return 1381 } 1382 1383 # 1384 # Draw the bar 1385 # 1386 set colour "black" 1387 if { [info exists data_series($w,$series,-colour)] } { 1388 set colour $data_series($w,$series,-colour) 1389 } 1390 1391 foreach {pxcrd pycrd} [coordsToPixel $w $xcrd $ycrd] {break} 1392 1393 if { [info exists data_series($w,$series,x)] } { 1394 set xold $data_series($w,$series,x) 1395 } else { 1396 set xold $scaling($w,xmin) 1397 } 1398 set yold $scaling($w,ymin) 1399 foreach {pxold pyold} [coordsToPixel $w $xold $yold] {break} 1400 1401 $w create rectangle $pxold $pyold $pxcrd $pycrd \ 1402 -fill $colour -outline $colour -tag data 1403 $w lower data 1404 1405 set data_series($w,$series,x) $xcrd 1406} 1407 1408# DrawTimePeriod -- 1409# Draw a period 1410# Arguments: 1411# w Name of the canvas 1412# text Text to identify the "period" item 1413# time_begin Start time 1414# time_end Stop time 1415# colour The colour to use (optional) 1416# Result: 1417# None 1418# Side effects: 1419# Data bars drawn in canvas 1420# 1421proc ::Plotchart::DrawTimePeriod { w text time_begin time_end {colour black}} { 1422 variable data_series 1423 variable scaling 1424 1425 # 1426 # Draw the text first 1427 # 1428 set ytext [expr {$scaling($w,current)+0.5*$scaling($w,dy)}] 1429 foreach {x y} [coordsToPixel $w $scaling($w,xmin) $ytext] {break} 1430 1431 $w create text 5 $y -text $text -anchor w \ 1432 -tags [list vertscroll above item_[expr {int($scaling($w,current))}]] 1433 1434 # 1435 # Draw the bar to indicate the period 1436 # 1437 set xmin [clock scan $time_begin] 1438 set xmax [clock scan $time_end] 1439 set ybott [expr {$scaling($w,current)+$scaling($w,dy)}] 1440 1441 foreach {x1 y1} [coordsToPixel $w $xmin $scaling($w,current)] {break} 1442 foreach {x2 y2} [coordsToPixel $w $xmax $ybott ] {break} 1443 1444 $w create rectangle $x1 $y1 $x2 $y2 -fill $colour \ 1445 -tags [list vertscroll horizscroll below item_[expr {int($scaling($w,current))}]] 1446 1447 ReorderChartItems $w 1448 1449 set scaling($w,current) [expr {$scaling($w,current)-1.0}] 1450 1451 RescaleChart $w 1452} 1453 1454# DrawTimeVertLine -- 1455# Draw a vertical line with a label 1456# Arguments: 1457# w Name of the canvas 1458# text Text to identify the line 1459# time Time for which the line is drawn 1460# Result: 1461# None 1462# Side effects: 1463# Line drawn in canvas 1464# 1465proc ::Plotchart::DrawTimeVertLine { w text time {colour black}} { 1466 variable data_series 1467 variable scaling 1468 1469 # 1470 # Draw the text first 1471 # 1472 set xtime [clock scan $time] 1473 #set ytext [expr {$scaling($w,ymax)-0.5*$scaling($w,dy)}] 1474 set ytext $scaling($w,ymax) 1475 foreach {x y} [coordsToPixel $w $xtime $ytext] {break} 1476 set y [expr {$y-5}] 1477 1478 $w create text $x $y -text $text -anchor sw -tags {horizscroll timeline} 1479 1480 # 1481 # Draw the line 1482 # 1483 foreach {x1 y1} [coordsToPixel $w $xtime $scaling($w,ymin)] {break} 1484 foreach {x2 y2} [coordsToPixel $w $xtime $scaling($w,ymax)] {break} 1485 1486 $w create line $x1 $y1 $x2 $y2 -fill black -tags {horizscroll timeline tline} 1487 1488 $w raise topmask 1489} 1490 1491# DrawTimeMilestone -- 1492# Draw a "milestone" 1493# Arguments: 1494# w Name of the canvas 1495# text Text to identify the line 1496# time Time for which the milestone is drawn 1497# colour Optionally the colour 1498# Result: 1499# None 1500# Side effects: 1501# Line drawn in canvas 1502# 1503proc ::Plotchart::DrawTimeMilestone { w text time {colour black}} { 1504 variable data_series 1505 variable scaling 1506 1507 # 1508 # Draw the text first 1509 # 1510 set ytext [expr {$scaling($w,current)+0.5*$scaling($w,dy)}] 1511 foreach {x y} [coordsToPixel $w $scaling($w,xmin) $ytext] {break} 1512 1513 $w create text 5 $y -text $text -anchor w \ 1514 -tags [list vertscroll above item_[expr {int($scaling($w,current))}]] 1515 1516 # 1517 # Draw an upside-down triangle to indicate the time 1518 # 1519 set xcentre [clock scan $time] 1520 set ytop $scaling($w,current) 1521 set ybott [expr {$scaling($w,current)+0.8*$scaling($w,dy)}] 1522 1523 foreach {x1 y1} [coordsToPixel $w $xcentre $ybott] {break} 1524 foreach {x2 y2} [coordsToPixel $w $xcentre $ytop] {break} 1525 1526 set x2 [expr {$x1-0.4*($y1-$y2)}] 1527 set x3 [expr {$x1+0.4*($y1-$y2)}] 1528 set y3 $y2 1529 1530 $w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \ 1531 -tags [list vertscroll horizscroll below item_[expr {int($scaling($w,current))}]] 1532 1533 ReorderChartItems $w 1534 1535 set scaling($w,current) [expr {$scaling($w,current)-1.0}] 1536 1537 RescaleChart $w 1538} 1539 1540# ScaleItems -- 1541# Scale all items by a given factor 1542# Arguments: 1543# w Name of the canvas 1544# xcentre X-coordinate of centre 1545# ycentre Y-coordinate of centre 1546# factor The factor to scale them by 1547# Result: 1548# None 1549# Side effects: 1550# All items are scaled by the given factor and the 1551# world coordinates are adjusted. 1552# 1553proc ::Plotchart::ScaleItems { w xcentre ycentre factor } { 1554 variable scaling 1555 1556 $w scale all $xcentre $ycentre $factor $factor 1557 1558 foreach {xc yc} [pixelToCoords $w $xcentre $ycentre] {break} 1559 1560 set rfact [expr {1.0/$factor}] 1561 set scaling($w,xfactor) [expr {$scaling($w,xfactor)*$factor}] 1562 set scaling($w,yfactor) [expr {$scaling($w,yfactor)*$factor}] 1563 set scaling($w,xmin) [expr {(1.0-$rfact)*$xc+$rfact*$scaling($w,xmin)}] 1564 set scaling($w,xmax) [expr {(1.0-$rfact)*$xc+$rfact*$scaling($w,xmax)}] 1565 set scaling($w,ymin) [expr {(1.0-$rfact)*$yc+$rfact*$scaling($w,ymin)}] 1566 set scaling($w,ymax) [expr {(1.0-$rfact)*$yc+$rfact*$scaling($w,ymax)}] 1567} 1568 1569# MoveItems -- 1570# Move all items by a given vector 1571# Arguments: 1572# w Name of the canvas 1573# xmove X-coordinate of move vector 1574# ymove Y-coordinate of move vector 1575# Result: 1576# None 1577# Side effects: 1578# All items are moved by the given vector and the 1579# world coordinates are adjusted. 1580# 1581proc ::Plotchart::MoveItems { w xmove ymove } { 1582 variable scaling 1583 1584 $w move all $xmove $ymove 1585 1586 set dx [expr {$scaling($w,xfactor)*$xmove}] 1587 set dy [expr {$scaling($w,yfactor)*$ymove}] 1588 set scaling($w,xmin) [expr {$scaling($w,xmin)+$dx}] 1589 set scaling($w,xmax) [expr {$scaling($w,xmax)+$dx}] 1590 set scaling($w,ymin) [expr {$scaling($w,ymin)+$dy}] 1591 set scaling($w,ymax) [expr {$scaling($w,ymax)+$dy}] 1592} 1593 1594# DrawIsometricData -- 1595# Draw the data in an isometric plot 1596# Arguments: 1597# w Name of the canvas 1598# type Type of data 1599# args Coordinates and so on 1600# Result: 1601# None 1602# Side effects: 1603# New data drawn in canvas 1604# 1605proc ::Plotchart::DrawIsometricData { w type args } { 1606 variable data_series 1607 1608 # 1609 # What type of data? 1610 # 1611 if { $type == "rectangle" } { 1612 foreach {x1 y1 x2 y2 colour} [concat $args "black"] {break} 1613 foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break} 1614 foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break} 1615 $w create rectangle $px1 $py1 $px2 $py2 \ 1616 -outline $colour -tag data 1617 $w lower data 1618 } 1619 1620 if { $type == "filled-rectangle" } { 1621 foreach {x1 y1 x2 y2 colour} [concat $args "black"] {break} 1622 foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break} 1623 foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break} 1624 $w create rectangle $px1 $py1 $px2 $py2 \ 1625 -outline $colour -fill $colour -tag data 1626 $w lower data 1627 } 1628 1629 if { $type == "filled-circle" } { 1630 foreach {x1 y1 rad colour} [concat $args "black"] {break} 1631 set x2 [expr {$x1+$rad}] 1632 set y2 [expr {$y1+$rad}] 1633 set x1 [expr {$x1-$rad}] 1634 set y1 [expr {$y1-$rad}] 1635 foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break} 1636 foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break} 1637 $w create oval $px1 $py1 $px2 $py2 \ 1638 -outline $colour -fill $colour -tag data 1639 $w lower data 1640 } 1641 1642 if { $type == "circle" } { 1643 foreach {x1 y1 rad colour} [concat $args "black"] {break} 1644 set x2 [expr {$x1+$rad}] 1645 set y2 [expr {$y1+$rad}] 1646 set x1 [expr {$x1-$rad}] 1647 set y1 [expr {$y1-$rad}] 1648 foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break} 1649 foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break} 1650 $w create oval $px1 $py1 $px2 $py2 \ 1651 -outline $colour -tag data 1652 $w lower data 1653 } 1654 1655} 1656 1657# BackgroundColour -- 1658# Set the background colour or other aspects of the background 1659# Arguments: 1660# w Name of the canvas 1661# part Which part: axes or plot 1662# colour Colour to use (or if part is "image", name of the image) 1663# dir Direction of increasing whiteness (optional, for "gradient" 1664# brightness Brighten (bright) or darken (dark) the colours 1665# 1666# Result: 1667# None 1668# Side effect: 1669# Colour of the relevant part is changed 1670# 1671proc ::Plotchart::BackgroundColour { w part colour {dir {}} {brighten bright}} { 1672 if { $part == "axes" } { 1673 $w configure -highlightthickness 0 1674 $w itemconfigure mask -fill $colour -outline $colour 1675 } 1676 if { $part == "plot" } { 1677 $w configure -highlightthickness 0 1678 $w configure -background $colour 1679 } 1680 if { $part == "gradient" } { 1681 if { $brighten == "dark" } { 1682 set intensity black 1683 } else { 1684 set intensity white 1685 } 1686 DrawGradientBackground $w $colour $dir $intensity 1687 } 1688 if { $part == "image" } { 1689 DrawImageBackground $w $colour 1690 } 1691} 1692 1693# DrawRadialSpokes -- 1694# Draw the spokes of the radial chart 1695# Arguments: 1696# w Name of the canvas 1697# names Names of the spokes 1698# Result: 1699# None 1700# Side effects: 1701# Radial chart filled in 1702# 1703proc ::Plotchart::DrawRadialSpokes { w names } { 1704 variable settings 1705 variable scaling 1706 1707 set pxmin $scaling($w,pxmin) 1708 set pymin $scaling($w,pymin) 1709 set pxmax $scaling($w,pxmax) 1710 set pymax $scaling($w,pymax) 1711 1712 $w create oval $pxmin $pymin $pxmax $pymax -outline black 1713 1714 set dangle [expr {2.0 * 3.1415926 / [llength $names]}] 1715 set angle 0.0 1716 set xcentr [expr {($pxmin+$pxmax)/2.0}] 1717 set ycentr [expr {($pymin+$pymax)/2.0}] 1718 1719 foreach name $names { 1720 set xtext [expr {$xcentr+cos($angle)*($pxmax-$pxmin+20)/2}] 1721 set ytext [expr {$ycentr-sin($angle)*($pymax-$pymin+20)/2}] 1722 set xspoke [expr {$xcentr+cos($angle)*($pxmax-$pxmin)/2}] 1723 set yspoke [expr {$ycentr-sin($angle)*($pymax-$pymin)/2}] 1724 1725 if { cos($angle) >= 0.0 } { 1726 set anchor w 1727 } else { 1728 set anchor e 1729 } 1730 1731 if { abs($xspoke-$xcentr) < 2 } { 1732 set xspoke $xcentr 1733 } 1734 if { abs($yspoke-$ycentr) < 2 } { 1735 set yspoke $ycentr 1736 } 1737 1738 $w create text $xtext $ytext -text $name -anchor $anchor 1739 $w create line $xcentr $ycentr $xspoke $yspoke -fill black 1740 1741 set angle [expr {$angle+$dangle}] 1742 } 1743} 1744 1745# DrawRadial -- 1746# Draw the data for the radial chart 1747# Arguments: 1748# w Name of the canvas 1749# values Values for each spoke 1750# colour Colour of the line 1751# thickness Thickness of the line (optional) 1752# Result: 1753# None 1754# Side effects: 1755# New line drawn 1756# 1757proc ::Plotchart::DrawRadial { w values colour {thickness 1} } { 1758 variable data_series 1759 variable settings 1760 variable scaling 1761 1762 if { [llength $values] != $settings($w,number) } { 1763 return -code error "Incorrect number of data given - should be $settings($w,number)" 1764 } 1765 1766 set pxmin $scaling($w,pxmin) 1767 set pymin $scaling($w,pymin) 1768 set pxmax $scaling($w,pxmax) 1769 set pymax $scaling($w,pymax) 1770 1771 set dangle [expr {2.0 * 3.1415926 / [llength $values]}] 1772 set angle 0.0 1773 set xcentr [expr {($pxmin+$pxmax)/2.0}] 1774 set ycentr [expr {($pymin+$pymax)/2.0}] 1775 1776 set coords {} 1777 1778 if { ! [info exists data_series($w,base)] } { 1779 set data_series($w,base) {} 1780 foreach value $values { 1781 lappend data_series($w,base) 0.0 1782 } 1783 } 1784 1785 set newbase {} 1786 foreach value $values base $data_series($w,base) { 1787 if { $settings($w,style) != "lines" } { 1788 set value [expr {$value+$base}] 1789 } 1790 set factor [expr {$value/$settings($w,scale)}] 1791 set xspoke [expr {$xcentr+$factor*cos($angle)*($pxmax-$pxmin)/2}] 1792 set yspoke [expr {$ycentr-$factor*sin($angle)*($pymax-$pymin)/2}] 1793 1794 if { abs($xspoke-$xcentr) < 2 } { 1795 set xspoke $xcentr 1796 } 1797 if { abs($yspoke-$ycentr) < 2 } { 1798 set yspoke $ycentr 1799 } 1800 1801 lappend coords $xspoke $yspoke 1802 lappend newbase $value 1803 set angle [expr {$angle+$dangle}] 1804 } 1805 1806 set data_series($w,base) $newbase 1807 1808 if { $settings($w,style) == "filled" } { 1809 set fillcolour $colour 1810 } else { 1811 set fillcolour "" 1812 } 1813 1814 set id [$w create polygon $coords -outline $colour -width $thickness -fill $fillcolour -tags data] 1815 $w lower $id 1816} 1817 1818# DrawTrendLine -- 1819# Draw a trend line based on the given data in an XY-plot 1820# Arguments: 1821# w Name of the canvas 1822# series Data series 1823# xcrd Next x coordinate 1824# ycrd Next y coordinate 1825# Result: 1826# None 1827# Side effects: 1828# New/updated trend line drawn in canvas 1829# 1830proc ::Plotchart::DrawTrendLine { w series xcrd ycrd } { 1831 variable data_series 1832 variable scaling 1833 1834 # 1835 # Check for missing values 1836 # 1837 if { $xcrd == "" || $ycrd == "" } { 1838 return 1839 } 1840 1841 # 1842 # Compute the coefficients of the line 1843 # 1844 if { [info exists data_series($w,$series,xsum)] } { 1845 set nsum [expr {$data_series($w,$series,nsum) + 1.0}] 1846 set xsum [expr {$data_series($w,$series,xsum) + $xcrd}] 1847 set x2sum [expr {$data_series($w,$series,x2sum) + $xcrd*$xcrd}] 1848 set ysum [expr {$data_series($w,$series,ysum) + $ycrd}] 1849 set xysum [expr {$data_series($w,$series,xysum) + $ycrd*$xcrd}] 1850 } else { 1851 set nsum [expr {1.0}] 1852 set xsum [expr {$xcrd}] 1853 set x2sum [expr {$xcrd*$xcrd}] 1854 set ysum [expr {$ycrd}] 1855 set xysum [expr {$ycrd*$xcrd}] 1856 } 1857 1858 if { $nsum*$x2sum != $xsum*$xsum } { 1859 set a [expr {($nsum*$xysum-$xsum*$ysum)/($nsum*$x2sum - $xsum*$xsum)}] 1860 } else { 1861 set a 0.0 1862 } 1863 set b [expr {($ysum-$a*$xsum)/$nsum}] 1864 1865 set xmin $scaling($w,xmin) 1866 set xmax $scaling($w,xmax) 1867 1868 foreach {pxmin pymin} [coordsToPixel $w $xmin [expr {$a*$xmin+$b}]] {break} 1869 foreach {pxmax pymax} [coordsToPixel $w $xmax [expr {$a*$xmax+$b}]] {break} 1870 1871 # 1872 # Draw the actual line 1873 # 1874 set colour "black" 1875 if { [info exists data_series($w,$series,-colour)] } { 1876 set colour $data_series($w,$series,-colour) 1877 } 1878 1879 if { [info exists data_series($w,$series,trend)] } { 1880 $w coords $data_series($w,$series,trend) $pxmin $pymin $pxmax $pymax 1881 } else { 1882 set data_series($w,$series,trend) \ 1883 [$w create line $pxmin $pymin $pxmax $pymax -fill $colour -tag [list data data_$series]] 1884 } 1885 1886 $w lower data 1887 1888 set data_series($w,$series,nsum) $nsum 1889 set data_series($w,$series,xsum) $xsum 1890 set data_series($w,$series,x2sum) $x2sum 1891 set data_series($w,$series,ysum) $ysum 1892 set data_series($w,$series,xysum) $xysum 1893} 1894 1895# VectorConfigure -- 1896# Set configuration options for vectors 1897# Arguments: 1898# w Name of the canvas 1899# series Data series (identifier for vectors) 1900# args Pairs of configuration options: 1901# -scale|-colour|-centred|-type {cartesian|polar|nautical} 1902# Result: 1903# None 1904# Side effects: 1905# Configuration options are stored 1906# 1907proc ::Plotchart::VectorConfigure { w series args } { 1908 variable data_series 1909 variable scaling 1910 1911 foreach {option value} $args { 1912 switch -- $option { 1913 "-scale" { 1914 if { $value > 0.0 } { 1915 set scaling($w,$series,vectorscale) $value 1916 } else { 1917 return -code error "Scale factor must be positive" 1918 } 1919 } 1920 "-colour" - "-color" { 1921 set data_series($w,$series,vectorcolour) $value 1922 } 1923 "-centered" - "-centred" { 1924 set data_series($w,$series,vectorcentred) $value 1925 } 1926 "-type" { 1927 if { [lsearch {cartesian polar nautical} $value] >= 0 } { 1928 set data_series($w,$series,vectortype) $value 1929 } else { 1930 return -code error "Unknown vector components option: $value" 1931 } 1932 } 1933 default { 1934 return -code error "Unknown vector option: $option ($value)" 1935 } 1936 } 1937 } 1938} 1939 1940# DrawVector -- 1941# Draw a vector at the given coordinates with the given components 1942# Arguments: 1943# w Name of the canvas 1944# series Data series (identifier for the vectors) 1945# xcrd X coordinate of start or centre 1946# ycrd Y coordinate of start or centre 1947# ucmp X component or length 1948# vcmp Y component or angle 1949# Result: 1950# None 1951# Side effects: 1952# New arrow drawn in canvas 1953# 1954proc ::Plotchart::DrawVector { w series xcrd ycrd ucmp vcmp } { 1955 variable data_series 1956 variable scaling 1957 1958 # 1959 # Check for missing values 1960 # 1961 if { $xcrd == "" || $ycrd == "" } { 1962 return 1963 } 1964 # 1965 # Check for missing values 1966 # 1967 if { $ucmp == "" || $vcmp == "" } { 1968 return 1969 } 1970 1971 # 1972 # Get the options 1973 # 1974 set scalef 1.0 1975 set colour black 1976 set centred 0 1977 set type cartesian 1978 if { [info exists scaling($w,$series,vectorscale)] } { 1979 set scalef $scaling($w,$series,vectorscale) 1980 } 1981 if { [info exists data_series($w,$series,vectorcolour)] } { 1982 set colour $data_series($w,$series,vectorcolour) 1983 } 1984 if { [info exists data_series($w,$series,vectorcentred)] } { 1985 set centred $data_series($w,$series,vectorcentred) 1986 } 1987 if { [info exists data_series($w,$series,vectortype)] } { 1988 set type $data_series($w,$series,vectortype) 1989 } 1990 1991 # 1992 # Compute the coordinates of beginning and end of the arrow 1993 # 1994 switch -- $type { 1995 "polar" { 1996 set x1 [expr {$ucmp * cos( 3.1415926 * $vcmp / 180.0 ) }] 1997 set y1 [expr {$ucmp * sin( 3.1415926 * $vcmp / 180.0 ) }] 1998 set ucmp $x1 1999 set vcmp $y1 2000 } 2001 "nautical" { 2002 set x1 [expr {$ucmp * sin( 3.1415926 * $vcmp / 180.0 ) }] 2003 set y1 [expr {$ucmp * cos( 3.1415926 * $vcmp / 180.0 ) }] 2004 set ucmp $x1 2005 set vcmp $y1 2006 } 2007 } 2008 2009 set u1 [expr {$scalef * $ucmp}] 2010 set v1 [expr {$scalef * $vcmp}] 2011 2012 foreach {x1 y1} [coordsToPixel $w $xcrd $ycrd] {break} 2013 2014 if { $centred } { 2015 set x1 [expr {$x1 - 0.5 * $u1}] 2016 set y1 [expr {$y1 + 0.5 * $v1}] 2017 } 2018 2019 set x2 [expr {$x1 + $u1}] 2020 set y2 [expr {$y1 - $v1}] 2021 2022 # 2023 # Draw the arrow 2024 # 2025 $w create line $x1 $y1 $x2 $y2 -fill $colour -tag [list data data_$series] -arrow last 2026 $w lower data 2027} 2028 2029# DotConfigure -- 2030# Set configuration options for dots 2031# Arguments: 2032# w Name of the canvas 2033# series Data series (identifier for dots) 2034# args Pairs of configuration options: 2035# -radius|-colour|-classes {value colour ...}|-outline|-scalebyvalue| 2036# -scale 2037# Result: 2038# None 2039# Side effects: 2040# Configuration options are stored 2041# 2042proc ::Plotchart::DotConfigure { w series args } { 2043 variable data_series 2044 variable scaling 2045 2046 foreach {option value} $args { 2047 switch -- $option { 2048 "-scale" { 2049 if { $value > 0.0 } { 2050 set scaling($w,$series,dotscale) $value 2051 } else { 2052 return -code error "Scale factor must be positive" 2053 } 2054 } 2055 "-colour" - "-color" { 2056 set data_series($w,$series,dotcolour) $value 2057 } 2058 "-radius" { 2059 set data_series($w,$series,dotradius) $value 2060 } 2061 "-scalebyvalue" { 2062 set data_series($w,$series,dotscalebyvalue) $value 2063 } 2064 "-outline" { 2065 set data_series($w,$series,dotoutline) $value 2066 } 2067 "-classes" { 2068 set data_series($w,$series,dotclasses) $value 2069 } 2070 default { 2071 return -code error "Unknown dot option: $option ($value)" 2072 } 2073 } 2074 } 2075} 2076 2077# DrawDot -- 2078# Draw a dot at the given coordinates, size and colour based on the given value 2079# Arguments: 2080# w Name of the canvas 2081# series Data series (identifier for the vectors) 2082# xcrd X coordinate of start or centre 2083# ycrd Y coordinate of start or centre 2084# value Value to be used 2085# Result: 2086# None 2087# Side effects: 2088# New oval drawn in canvas 2089# 2090proc ::Plotchart::DrawDot { w series xcrd ycrd value } { 2091 variable data_series 2092 variable scaling 2093 2094 # 2095 # Check for missing values 2096 # 2097 if { $xcrd == "" || $ycrd == "" || $value == "" } { 2098 return 2099 } 2100 2101 # 2102 # Get the options 2103 # 2104 set scalef 1.0 2105 set colour black 2106 set usevalue 1 2107 set outline black 2108 set radius 3 2109 set classes {} 2110 if { [info exists scaling($w,$series,dotscale)] } { 2111 set scalef $scaling($w,$series,dotscale) 2112 } 2113 if { [info exists data_series($w,$series,dotcolour)] } { 2114 set colour $data_series($w,$series,dotcolour) 2115 } 2116 if { [info exists data_series($w,$series,dotoutline)] } { 2117 set outline {} 2118 if { $data_series($w,$series,dotoutline) } { 2119 set outline black 2120 } 2121 } 2122 if { [info exists data_series($w,$series,dotradius)] } { 2123 set radius $data_series($w,$series,dotradius) 2124 } 2125 if { [info exists data_series($w,$series,dotclasses)] } { 2126 set classes $data_series($w,$series,dotclasses) 2127 } 2128 if { [info exists data_series($w,$series,dotscalebyvalue)] } { 2129 set usevalue $data_series($w,$series,dotscalebyvalue) 2130 } 2131 2132 # 2133 # Compute the radius and the colour 2134 # 2135 if { $usevalue } { 2136 set radius [expr {$scalef * $value}] 2137 } 2138 if { $classes != {} } { 2139 foreach {limit col} $classes { 2140 if { $value < $limit } { 2141 set colour $col 2142 break 2143 } 2144 } 2145 } 2146 2147 foreach {x y} [coordsToPixel $w $xcrd $ycrd] {break} 2148 2149 set x1 [expr {$x - $radius}] 2150 set y1 [expr {$y - $radius}] 2151 set x2 [expr {$x + $radius}] 2152 set y2 [expr {$y + $radius}] 2153 2154 # 2155 # Draw the oval 2156 # 2157 $w create oval $x1 $y1 $x2 $y2 -fill $colour -tag [list data data_$series] -outline $outline 2158 $w lower data 2159} 2160 2161# DrawRchart -- 2162# Draw data together with two horizontal lines representing the 2163# expected range 2164# Arguments: 2165# w Name of the canvas 2166# series Data series 2167# xcrd X coordinate of the data point 2168# ycrd Y coordinate of the data point 2169# Result: 2170# None 2171# Side effects: 2172# New data point drawn, lines updated 2173# 2174proc ::Plotchart::DrawRchart { w series xcrd ycrd } { 2175 variable data_series 2176 variable scaling 2177 2178 # 2179 # Check for missing values 2180 # 2181 if { $xcrd == "" || $ycrd == "" } { 2182 return 2183 } 2184 2185 # 2186 # In any case, draw the data point 2187 # 2188 DrawData $w $series $xcrd $ycrd 2189 2190 # 2191 # Compute the expected range 2192 # 2193 if { ! [info exists data_series($w,$series,rchart)] } { 2194 set data_series($w,$series,rchart) $ycrd 2195 } else { 2196 lappend data_series($w,$series,rchart) $ycrd 2197 2198 if { [llength $data_series($w,$series,rchart)] < 2 } { 2199 return 2200 } 2201 2202 set filtered $data_series($w,$series,rchart) 2203 set outside 1 2204 while { $outside } { 2205 set data $filtered 2206 foreach {ymin ymax} [RchartValues $data] {break} 2207 set filtered {} 2208 set outside 0 2209 foreach y $data { 2210 if { $y < $ymin || $y > $ymax } { 2211 set outside 1 2212 } else { 2213 lappend filtered $y 2214 } 2215 } 2216 } 2217 2218 # 2219 # Draw the limit lines 2220 # 2221 if { [info exists data_series($w,$series,rchartlimits)] } { 2222 eval $w delete $data_series($w,$series,rchartlimits) 2223 } 2224 2225 set colour "black" 2226 if { [info exists data_series($w,$series,-colour)] } { 2227 set colour $data_series($w,$series,-colour) 2228 } 2229 2230 set xmin $scaling($w,xmin) 2231 set xmax $scaling($w,xmax) 2232 2233 foreach {pxmin pymin} [coordsToPixel $w $xmin $ymin] {break} 2234 foreach {pxmax pymax} [coordsToPixel $w $xmax $ymax] {break} 2235 2236 2237 set data_series($w,$series,rchartlimits) [list \ 2238 [$w create line $pxmin $pymin $pxmax $pymin -fill $colour -tag [list data data_$series]] \ 2239 [$w create line $pxmin $pymax $pxmax $pymax -fill $colour -tag [list data data_$series]] \ 2240 ] 2241 } 2242} 2243 2244# RchartValues -- 2245# Compute the expected range for a series of data 2246# Arguments: 2247# data Data to be examined 2248# Result: 2249# Expected minimum and maximum 2250# 2251proc ::Plotchart::RchartValues { data } { 2252 set sum 0.0 2253 set sum2 0.0 2254 set ndata [llength $data] 2255 2256 if { $ndata <= 1 } { 2257 return [list $data $data] 2258 } 2259 2260 foreach v $data { 2261 set sum [expr {$sum + $v}] 2262 set sum2 [expr {$sum2 + $v*$v}] 2263 } 2264 2265 if { $ndata < 2 } { 2266 return [list $v $v] 2267 } 2268 2269 set variance [expr {($sum2 - $sum*$sum/double($ndata))/($ndata-1.0)}] 2270 if { $variance < 0.0 } { 2271 set variance 0.0 2272 } 2273 2274 set vmean [expr {$sum/$ndata}] 2275 set stdev [expr {sqrt($variance)}] 2276 set vmin [expr {$vmean - 3.0 * $stdev}] 2277 set vmax [expr {$vmean + 3.0 * $stdev}] 2278 2279 return [list $vmin $vmax] 2280} 2281 2282# ReorderChartItems -- 2283# Rearrange the drawing order of time and Gantt chart items 2284# Arguments: 2285# w Canvas widget containing them 2286# Result: 2287# None 2288# 2289proc ::Plotchart::ReorderChartItems { w } { 2290 2291 $w lower above 2292 $w lower vertmask 2293 $w lower tline 2294 $w lower below 2295 $w lower lowest 2296 2297} 2298 2299# RescaleChart -- 2300# Reset the scaling of the scrollbar(s) for time and Gantt charts 2301# Arguments: 2302# w Canvas widget containing them 2303# Result: 2304# None 2305# Note: 2306# To be called after scaling($w,current) has been updated 2307# or a new time line has been added 2308# 2309proc ::Plotchart::RescaleChart { w } { 2310 variable scaling 2311 2312 if { [info exists scaling($w,vscroll)] } { 2313 if { $scaling($w,current) >= 0.0 } { 2314 set scaling($w,theight) $scaling($w,ymax) 2315 $scaling($w,vscroll) set 0.0 1.0 2316 } else { 2317 set scaling($w,theight) [expr {$scaling($w,ymax)-$scaling($w,current)}] 2318 $scaling($w,vscroll) set $scaling($w,curpos) \ 2319 [expr {$scaling($w,curpos) + $scaling($w,ymax)/$scaling($w,theight)}] 2320 } 2321 } 2322 2323 if { [info exists scaling($w,hscroll)] } { 2324 foreach {xmin dummy xmax} [$w bbox $w horizscroll] {break} 2325 set scaling($w,twidth) [expr {$xmax-$xmin}] 2326 if { $scaling($w,twidth) < $scaling($w,pxmax)-$scaling($w,pxmin) } { 2327 $scaling($w,hscroll) set 0.0 1.0 2328 } else { 2329 $scaling($w,hscroll) set $scaling($w,curhpos) \ 2330 [expr {$scaling($w,curhpos) + \ 2331 ($scaling($w,pxmax)-$scaling($w,pxmin)) \ 2332 /double($scaling($w,twidth))}] 2333 } 2334 } 2335} 2336 2337# ConnectVertScrollbar -- 2338# Connect a vertical scroll bar to the chart 2339# Arguments: 2340# w Canvas widget containing them 2341# scrollbar Scroll bar in question 2342# Result: 2343# None 2344# 2345proc ::Plotchart::ConnectVertScrollbar { w scrollbar } { 2346 variable scaling 2347 2348 $scrollbar configure -command [list ::Plotchart::VertScrollChart $w] 2349 bind $w <4> [list ::Plotchart::VertScrollChart $w scroll -1 units] 2350 bind $w <5> [list ::Plotchart::VertScrollChart $w scroll 1 units] 2351 bind $w <MouseWheel> [list ::Plotchart::VertScrollChart $w scroll %D wheel] 2352 set scaling($w,vscroll) $scrollbar 2353 2354 RescaleChart $w 2355} 2356 2357# ConnectHorizScrollbar -- 2358# Connect a horizontal scroll bar to the chart 2359# Arguments: 2360# w Canvas widget containing them 2361# scrollbar Scroll bar in question 2362# Result: 2363# None 2364# 2365proc ::Plotchart::ConnectHorizScrollbar { w scrollbar } { 2366 variable scaling 2367 2368 $scrollbar configure -command [list ::Plotchart::HorizScrollChart $w] 2369 set scaling($w,hscroll) $scrollbar 2370 2371 RescaleChart $w 2372} 2373 2374# VertScrollChart -- 2375# Scroll a chart using the vertical scroll bar 2376# Arguments: 2377# w Canvas widget containing them 2378# operation Operation to respond to 2379# number Number representing the size of the displacement 2380# unit Unit of displacement 2381# Result: 2382# None 2383# 2384proc ::Plotchart::!VertScrollChart { w operation number {unit {}}} { 2385 variable scaling 2386 2387 set pixheight [expr {$scaling($w,pymax)-$scaling($w,pymin)}] 2388 set height [expr {$pixheight*$scaling($w,theight)/$scaling($w,ymax)}] 2389 2390 switch -- $operation { 2391 "moveto" { 2392 set dy [expr {$height*($scaling($w,curpos)-$number)}] 2393 set scaling($w,curpos) $number 2394 } 2395 "scroll" { 2396 if { $unit == "units" } { 2397 set dy [expr {-$number*$height/$scaling($w,theight)}] 2398 set newpos [expr {$scaling($w,curpos) + $number/$scaling($w,theight)}] 2399 } else { 2400 set dy [expr {-$number*$pixheight}] 2401 set newpos [expr {$scaling($w,curpos) + $number*$scaling($w,ymax)/$scaling($w,theight)}] 2402 } 2403 2404 # TODO: guard against scrolling too far 2405 #if { $newpos < 0.0 } { 2406 # set newpos 0.0 2407 # set dy [expr {$...}] 2408 #} 2409 # 2410 #if { $newpos > 1.0 } { 2411 # set newpos 1.0 2412 # set dy [expr {$...}] 2413 #} 2414 set scaling($w,curpos) $newpos 2415 } 2416 } 2417 2418 # 2419 # TODO: limit the position between 0 and 1 2420 # 2421 2422 $w move vertscroll 0 $dy 2423 2424 RescaleChart $w 2425} 2426proc ::Plotchart::VertScrollChart { w operation number {unit {}}} { 2427 variable scaling 2428 2429 # Get the height of the scrolling region and the current position of the slider 2430 set height [expr {$scaling($w,pymax)-$scaling($w,pymin)}] 2431 foreach {ts bs} [$scaling($w,vscroll) get] {break} 2432 2433 if { $unit == "wheel" } { 2434 set operation "scroll" 2435 set unit "units" 2436 set number [expr {$number>0? 1 : -1}] 2437 } 2438 2439 switch -- $operation { 2440 "moveto" { 2441 # No scrolling if we are already at the top or bottom 2442 if { $number < 0.0 } { 2443 set number 0.0 2444 } 2445 if { $number+($bs-$ts) > 1.0 } { 2446 set number [expr {1.0-($bs-$ts)}] 2447 } 2448 set dy [expr {$height*($scaling($w,curpos)-$number)/($bs-$ts)}] 2449 set scaling($w,curpos) $number 2450 $w move vertscroll 0 $dy 2451 } 2452 "scroll" { 2453 # Handle "units" and "pages" the same 2454 2455 # No scrolling if we are at the top or bottom 2456 if {$number == -1 && $ts == 0.0} { 2457 return 2458 } 2459 2460 if {$number == 1 && $bs == 1.0} { 2461 return 2462 } 2463 2464 # Scroll 1 unit in coordinate space, converted to pixel space 2465 foreach {x1 y1} [coordsToPixel $w 0 0.0] {break} 2466 foreach {x2 y2} [coordsToPixel $w 0 1.0] {break} 2467 2468 # This is the amount to scroll based on the current height 2469 set amt [expr {$number*($y2-$y1)/$height}] 2470 2471 # Handle boundary conditions, don't want to scroll too far off 2472 # the top or bottom. 2473 if {$number == 1 && $bs-$amt > 1.0} { 2474 set amt [expr {$bs-1.0}] 2475 } elseif {$number == -1 && $ts-$amt < 0.0} { 2476 set amt $ts 2477 } 2478 2479 # Set the scrolling parameters and scroll 2480 set dy [expr {$height*($scaling($w,curpos)-($ts-$amt))/($bs-$ts)}] 2481 set scaling($w,curpos) [expr {$ts-$amt}] 2482 $w move vertscroll 0 $dy 2483 } 2484 } 2485 2486 RescaleChart $w 2487} 2488 2489# HorizScrollChart -- 2490# Scroll a chart using the horizontal scroll bar 2491# Arguments: 2492# w Canvas widget containing them 2493# operation Operation to respond to 2494# number Number representing the size of the displacement 2495# unit Unit of displacement 2496# Result: 2497# None 2498# 2499proc ::Plotchart::HorizScrollChart { w operation number {unit {}}} { 2500 variable scaling 2501 2502 # Get the width of the scrolling region and the current position of the slider 2503 set width [expr {double($scaling($w,pxmax)-$scaling($w,pxmin))}] 2504 foreach {ts bs} [$scaling($w,hscroll) get] {break} 2505 2506 switch -- $operation { 2507 "moveto" { 2508 # No scrolling if we are already at the top or bottom 2509 if { $number < 0.0 } { 2510 set number 0.0 2511 } 2512 if { $number+($bs-$ts) > 1.0 } { 2513 set number [expr {1.0-($bs-$ts)}] 2514 } 2515 set dx [expr {$width*($scaling($w,curhpos)-$number)/($bs-$ts)}] 2516 set scaling($w,curhpos) $number 2517 $w move horizscroll $dx 0 2518 } 2519 "scroll" { 2520 # Handle "units" and "pages" the same 2521 2522 # No scrolling if we are at the top or bottom 2523 if {$number == -1 && $ts == 0.0} { 2524 return 2525 } 2526 2527 if {$number == 1 && $bs == 1.0} { 2528 return 2529 } 2530 2531 # Scroll 1 unit in coordinate space, converted to pixel space 2532 set dx [expr {0.1*($scaling($w,xmax)-$scaling($w,xmin))}] 2533 foreach {x1 y1} [coordsToPixel $w 0 0.0] {break} 2534 foreach {x2 y2} [coordsToPixel $w $dx 0.0] {break} 2535 2536 # This is the amount to scroll based on the current width 2537 set amt [expr {$number*($x2-$x1)/$width}] 2538 2539 # Handle boundary conditions, don't want to scroll too far off 2540 # the left or the right 2541 if {$number == 1 && $bs-$amt > 1.0} { 2542 set amt [expr {$bs-1.0}] 2543 } elseif {$number == -1 && $ts-$amt < 0.0} { 2544 set amt $ts 2545 } 2546 2547 # Set the scrolling parameters and scroll 2548 set dx [expr {$width*($scaling($w,curhpos)-($ts-$amt))/($bs-$ts)}] 2549 set scaling($w,curhpos) [expr {$ts-$amt}] 2550 $w move horizscroll $dx 0 2551 } 2552 } 2553 2554 RescaleChart $w 2555} 2556 2557# DrawWindRoseData -- 2558# Draw the data for each sector 2559# Arguments: 2560# w Name of the canvas 2561# data List of "sectors" data 2562# colour Colour to use 2563# Result: 2564# None 2565# Side effects: 2566# Data added to the wind rose 2567# 2568proc ::Plotchart::DrawWindRoseData { w data colour } { 2569 2570 variable data_series 2571 2572 set start_angle $data_series($w,start_angle) 2573 set increment $data_series($w,increment_angle) 2574 set width_sector $data_series($w,d_angle) 2575 2576 set new_cumulative {} 2577 2578 foreach value $data cumulative_radius $data_series($w,cumulative_radius) { 2579 set radius [expr {$value + $cumulative_radius}] 2580 2581 foreach {xright ytop} [polarToPixel $w [expr {$radius*sqrt(2.0)}] 45.0] {break} 2582 foreach {xleft ybottom} [polarToPixel $w [expr {$radius*sqrt(2.0)}] 225.0] {break} 2583 2584 $w create arc $xleft $ytop $xright $ybottom -style pie -fill $colour \ 2585 -tag data_$data_series($w,count_data) -start $start_angle -extent $width_sector 2586 2587 lappend new_cumulative $radius 2588 2589 set start_angle [expr {$start_angle - $increment}] 2590 } 2591 2592 $w lower data_$data_series($w,count_data) 2593 2594 set data_series($w,cumulative_radius) $new_cumulative 2595 incr data_series($w,count_data) 2596} 2597 2598# DrawYband -- 2599# Draw a vertical grey band in a plot 2600# Arguments: 2601# w Name of the canvas 2602# xmin Lower bound of the band 2603# xmax Upper bound of the band 2604# Result: 2605# None 2606# Side effects: 2607# Horizontal band drawn in canvas 2608# 2609proc ::Plotchart::DrawYband { w xmin xmax } { 2610 variable scaling 2611 2612 2613 foreach {xp1 yp1} [coordsToPixel $w $xmin $scaling($w,ymin)] {break} 2614 foreach {xp2 yp2} [coordsToPixel $w $xmax $scaling($w,ymax)] {break} 2615 2616 $w create rectangle $xp1 $yp1 $xp2 $yp2 -fill grey70 -outline grey70 -tag band 2617 2618 $w lower band ;# TODO: also in "plot" method 2619} 2620 2621# DrawXband -- 2622# Draw a horizontal grey band in a plot 2623# Arguments: 2624# w Name of the canvas 2625# ymin Lower bound of the band 2626# ymax Upper bound of the band 2627# Result: 2628# None 2629# Side effects: 2630# Horizontal band drawn in canvas 2631# 2632proc ::Plotchart::DrawXband { w ymin ymax } { 2633 variable scaling 2634 2635 2636 foreach {xp1 yp1} [coordsToPixel $w $scaling($w,xmin) $ymin] {break} 2637 foreach {xp2 yp2} [coordsToPixel $w $scaling($w,xmax) $ymax] {break} 2638 2639 $w create rectangle $xp1 $yp1 $xp2 $yp2 -fill grey70 -outline grey70 -tag band 2640 2641 $w lower band ;# TODO: also in "plot" method 2642} 2643 2644# DrawLabelDot -- 2645# Draw a label and a symbol (dot) in a plot 2646# Arguments: 2647# w Name of the canvas 2648# x X coordinate of the dot 2649# y Y coordinate of the dot 2650# text Text to be shown 2651# orient (Optional) orientation of the text wrt the dot 2652# (w, e, n, s) 2653# 2654# Result: 2655# None 2656# Side effects: 2657# Label and dot drawn in canvas 2658# Note: 2659# The routine uses the data series name "labeldot" to derive 2660# the properties 2661# 2662proc ::Plotchart::DrawLabelDot { w x y text {orient w} } { 2663 variable scaling 2664 2665 foreach {xp yp} [coordsToPixel $w $x $y] {break} 2666 2667 switch -- [string tolower $orient] { 2668 "w" { 2669 set xp [expr {$xp - 5}] 2670 set anchor e 2671 } 2672 "e" { 2673 set xp [expr {$xp + 10}] 2674 set anchor w 2675 } 2676 "s" { 2677 set yp [expr {$yp + 5}] 2678 set anchor n 2679 } 2680 "n" { 2681 set yp [expr {$yp - 5}] 2682 set anchor s 2683 } 2684 default { 2685 set xp [expr {$xp - 5}] 2686 set anchor w 2687 } 2688 } 2689 2690 $w create text $xp $yp -text $text -fill grey -tag data -anchor $anchor 2691 DrawData $w labeldot $x $y 2692} 2693 2694# DrawLabelDotPolar -- 2695# Draw a label and a symbol (dot) in a polar plot 2696# Arguments: 2697# w Name of the canvas 2698# rad Radial coordinate of the dot 2699# angle Tangential coordinate of the dot 2700# text Text to be shown 2701# orient (Optional) orientation of the text wrt the dot 2702# (w, e, n, s) 2703# 2704# Result: 2705# None 2706# Side effects: 2707# Label and dot drawn in canvas 2708# Note: 2709# The routine uses the data series name "labeldot" to derive 2710# the properties 2711# 2712proc ::Plotchart::DrawLabelDotPolar { w rad angle text {orient w} } { 2713 variable torad 2714 2715 set xcrd [expr {$rad*cos($angle*$torad)}] 2716 set ycrd [expr {$rad*sin($angle*$torad)}] 2717 2718 DrawLabelDot $w $xcrd $ycrd $text $orient 2719} 2720 2721# ConfigBar -- 2722# Configuration options for vertical and horizontal barcharts 2723# Arguments: 2724# w Name of the canvas 2725# args List of arguments 2726# Result: 2727# None 2728# Side effects: 2729# Items that are already visible will NOT be changed to the new look 2730# 2731proc ::Plotchart::ConfigBar { w args } { 2732 variable settings 2733 2734 foreach {option value} $args { 2735 set option [string range $option 1 end] 2736 if { [lsearch {showvalues valuefont valuecolour valuecolor valueformat} \ 2737 $option] >= 0} { 2738 if { $option == "valuecolor" } { 2739 set option "valuecolour" 2740 } 2741 set settings($w,$option) $value 2742 } else { 2743 return -code error "Unknown barchart option: -$option" 2744 } 2745 } 2746} 2747 2748# DrawFunction -- 2749# Draw a function f(x) in an XY-plot 2750# Arguments: 2751# w Name of the canvas 2752# series Data series (for the colour) 2753# xargs List of arguments to the (anonymous) function 2754# function Function expression 2755# args All parameters in the expression 2756# (and possibly the option -samples x) 2757# Result: 2758# None 2759# Side effects: 2760# New data drawn in canvas 2761# 2762# Note: 2763# This method requires Tcl 8.5 2764# 2765# TODO: 2766# Check for numerical problems! 2767# 2768proc ::Plotchart::DrawFunction { w series xargs function args } { 2769 variable data_series 2770 variable scaling 2771 2772 # 2773 # Check the number of arguments 2774 # 2775 if { [llength $xargs] != [llength $args] + 1 && 2776 [llength $xargs] + 2 != [llength $args] + 1 } { 2777 return -code error "plotfunc: number of (extra) arguments does not match the list of variables" 2778 } 2779 2780 # 2781 # Determine the number of samples 2782 # 2783 set number 50 2784 if { [llength $xargs] + 2 == [llength $args] + 1 } { 2785 if { [lindex $args end-1] != "-samples" } { 2786 return -code error "plotfunc: unknown option - [lindex $args end-1]" 2787 } 2788 if { ! [string is integer [lindex $args end]] } { 2789 return -code error "plotfunc: number of samples must be an integer - is instead \"[lindex $args end]\"" 2790 } 2791 set number [lindex $args end] 2792 set args [lrange $args 0 end-2] 2793 } 2794 2795 # 2796 # Get the caller's namespace 2797 # 2798 set namespace [uplevel 2 {namespace current}] 2799 2800 # 2801 # The actual drawing 2802 # 2803 set colour black 2804 if { [info exists data_series($w,$series,-colour)] } { 2805 set colour $data_series($w,$series,-colour) 2806 } 2807 2808 set xmin $scaling($w,xmin) 2809 set dx [expr {($scaling($w,xmax) - $xmin) / ($number - 1.0)}] 2810 2811 set coords {} 2812 set lambda [string map [list XARGS $xargs FUNCTION $function NS $namespace] {{XARGS} {expr {FUNCTION}} NS}] 2813 2814 for { set i 0 } { $i < $number } { incr i } { 2815 set x [expr {$xmin + $dx*$i}] 2816 2817 if { [catch { 2818 set y [apply $lambda $x {*}$args] 2819 2820 foreach {pxcrd pycrd} [coordsToPixel $w $x $y] {break} 2821 2822 lappend coords $pxcrd $pycrd 2823 } msg] } { 2824 if { [llength $coords] > 2 } { 2825 $w create line $coords -fill $colour -smooth 1 -tag [list data data_$series] 2826 set coords {} 2827 } 2828 } 2829 2830 } 2831 if { [llength $coords] > 2 } { 2832 $w create line $coords -fill $colour -smooth 1 -tag [list data data_$series] 2833 } 2834 2835 $w lower data 2836} 2837