Menu
▾
▴
[Nscldaq-cvscommits] SF.net SVN: nscldaq:[3900] branches
|
From: <ro...@us...> - 2014-09-25 19:32:54
|
Revision: 3900
http://sourceforge.net/p/nscldaq/code/3900
Author: ron-fox
Date: 2014-09-25 19:32:40 +0000 (Thu, 25 Sep 2014)
Log Message:
-----------
Branch for nonblocking ring selector development.
Added Paths:
-----------
branches/nscldaq-11.0-rc14/
branches/nscldaq-11.0-rc14/base/
branches/nscldaq-11.0-rc14/base/Makefile.am
branches/nscldaq-11.0-rc14/base/plotchart/pkgIndex.tcl
branches/nscldaq-11.0-rc14/base/plotchart/plotaxis.tcl
branches/nscldaq-11.0-rc14/base/plotchart/plotchart.tcl
branches/nscldaq-11.0-rc14/base/plotchart/plotpriv.tcl
branches/nscldaq-11.0-rc14/base/plotchart/xyplot.tcl
branches/nscldaq-11.0-rc14/base/plotcontainer/
branches/nscldaq-11.0-rc14/base/thread/
branches/nscldaq-11.0-rc14/configure.ac
branches/nscldaq-11.0-rc14/daq/
branches/nscldaq-11.0-rc14/daq/eventbuilder/offlineorderer/runprocessor.test
branches/nscldaq-11.0-rc14/daq/eventbuilder/ringsource/Makefile.am
branches/nscldaq-11.0-rc14/daq/format/CDataFormatItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CDataFormatItem.h
branches/nscldaq-11.0-rc14/daq/format/CPhysicsEventItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingFragmentItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingPhysicsEventCountItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingPhysicsEventCountItem.h
branches/nscldaq-11.0-rc14/daq/format/CRingScalerItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingScalerItem.h
branches/nscldaq-11.0-rc14/daq/format/CRingStateChangeItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingTextItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingTextItem.h
branches/nscldaq-11.0-rc14/daq/format/dataformattests.cpp
branches/nscldaq-11.0-rc14/usb/
branches/nscldaq-11.0-rc14/usb/ccusb/devices/CConfigurableObject.cpp
branches/nscldaq-11.0-rc14/usb/ccusb/router/COutputThread.cpp
branches/nscldaq-11.0-rc14/usb/vmusb/devices/CConfigurableObject.cpp
branches/nscldaq-11.0-rc14/usb/vmusb/vmusbReadout.xml
branches/nscldaq-11.0-rc14/utilities/
branches/nscldaq-11.0-rc14/utilities/Makefile.am
branches/nscldaq-11.0-rc14/utilities/newscaler/Asserts.h
branches/nscldaq-11.0-rc14/utilities/newscaler/CTclRingCommand.cpp
branches/nscldaq-11.0-rc14/utilities/newscaler/CTclRingCommand.h
branches/nscldaq-11.0-rc14/utilities/newscaler/Makefile.am
branches/nscldaq-11.0-rc14/utilities/newscaler/ScalerDisplay.tcl.in
branches/nscldaq-11.0-rc14/utilities/newscaler/TestRunner.cpp
branches/nscldaq-11.0-rc14/utilities/newscaler/amber.gif
branches/nscldaq-11.0-rc14/utilities/newscaler/channel.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/channel.test
branches/nscldaq-11.0-rc14/utilities/newscaler/channelcmd.test
branches/nscldaq-11.0-rc14/utilities/newscaler/emptyModel.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/emptyModel.test
branches/nscldaq-11.0-rc14/utilities/newscaler/green.gif
branches/nscldaq-11.0-rc14/utilities/newscaler/header.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/nameMap.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/nameMap.test
branches/nscldaq-11.0-rc14/utilities/newscaler/page.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/pagetest.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/ratioModel.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/ratioModel.test
branches/nscldaq-11.0-rc14/utilities/newscaler/red.gif
branches/nscldaq-11.0-rc14/utilities/newscaler/reports.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/ringTests.cpp
branches/nscldaq-11.0-rc14/utilities/newscaler/scalerUtil.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/scalerconfig.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/scalerdisplay.xml
branches/nscldaq-11.0-rc14/utilities/newscaler/scalermain.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/singleModel.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/singleModel.test
branches/nscldaq-11.0-rc14/utilities/newscaler/stripparam.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/stripparam.test
branches/nscldaq-11.0-rc14/utilities/newscaler/stripratio.tcl
branches/nscldaq-11.0-rc14/utilities/newscaler/stripratio.test
branches/nscldaq-11.0-rc14/utilities/newscaler/tclringcommand.xml
branches/nscldaq-11.0-rc14/utilities/scalerdisplay/scalerdisplay.xml.old
Removed Paths:
-------------
branches/nscldaq-11.0-rc14/base/
branches/nscldaq-11.0-rc14/base/Makefile.am
branches/nscldaq-11.0-rc14/base/plotchart/pkgIndex.tcl
branches/nscldaq-11.0-rc14/base/plotchart/plotaxis.tcl
branches/nscldaq-11.0-rc14/base/plotchart/plotchart.tcl
branches/nscldaq-11.0-rc14/base/plotchart/plotpriv.tcl
branches/nscldaq-11.0-rc14/base/plotchart/xyplot.tcl
branches/nscldaq-11.0-rc14/base/thread/
branches/nscldaq-11.0-rc14/configure.ac
branches/nscldaq-11.0-rc14/daq/
branches/nscldaq-11.0-rc14/daq/eventbuilder/offlineorderer/runprocessor.test
branches/nscldaq-11.0-rc14/daq/eventbuilder/ringsource/Makefile.am
branches/nscldaq-11.0-rc14/daq/format/CDataFormatItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CDataFormatItem.h
branches/nscldaq-11.0-rc14/daq/format/CPhysicsEventItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingFragmentItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingPhysicsEventCountItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingPhysicsEventCountItem.h
branches/nscldaq-11.0-rc14/daq/format/CRingScalerItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingScalerItem.h
branches/nscldaq-11.0-rc14/daq/format/CRingStateChangeItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingTextItem.cpp
branches/nscldaq-11.0-rc14/daq/format/CRingTextItem.h
branches/nscldaq-11.0-rc14/daq/format/dataformattests.cpp
branches/nscldaq-11.0-rc14/usb/
branches/nscldaq-11.0-rc14/usb/ccusb/devices/CConfigurableObject.cpp
branches/nscldaq-11.0-rc14/usb/ccusb/router/COutputThread.cpp
branches/nscldaq-11.0-rc14/usb/vmusb/devices/CConfigurableObject.cpp
branches/nscldaq-11.0-rc14/usb/vmusb/vmusbReadout.xml
branches/nscldaq-11.0-rc14/utilities/
branches/nscldaq-11.0-rc14/utilities/Makefile.am
branches/nscldaq-11.0-rc14/utilities/newscaler/Makefile.am
branches/nscldaq-11.0-rc14/utilities/scalerdisplay/scalerdisplay.xml
Index: branches/nscldaq-11.0-rc14
===================================================================
--- branches/nscldaq-11.0-development 2014-09-25 17:14:08 UTC (rev 3892)
+++ branches/nscldaq-11.0-rc14 2014-09-25 19:32:40 UTC (rev 3900)
Property changes on: branches/nscldaq-11.0-rc14
___________________________________________________________________
Added: svn:mergeinfo
## -0,0 +1,13 ##
+/branches/hira-sisstuff:2744-2997
+/branches/nextgen-ccusb-feature:2631-2641
+/branches/nextgen-ccusb-userdrivers-feature:2644-2659
+/branches/nextgen-vmusb-userdrivers-feature:2665-2711
+/branches/nscldaq-10.1-004-development:2714-2742
+/branches/nscldaq-10.2-001-development:2931-2998
+/branches/nscldaq-10.2-development:2749-2997
+/branches/nscldaq-11.0-filter-development:3275-3450
+/branches/nscldaq-11.0-rc12-development:3723-3888
+/branches/vmusbremote-development:2803
+/tags/hira-sisstuff-pre-merge:2893-2918
+/tags/vmusbremote-working:2804-2816
+/trunk/nextgen:3002-3154
\ No newline at end of property
Deleted: branches/nscldaq-11.0-rc14/base/Makefile.am
===================================================================
--- branches/nscldaq-11.0-development/base/Makefile.am 2014-09-25 16:16:14 UTC (rev 3891)
+++ branches/nscldaq-11.0-rc14/base/Makefile.am 2014-09-25 19:32:40 UTC (rev 3900)
@@ -1,3 +0,0 @@
-SUBDIRS = os CopyrightTools cvt uri thread headers tclwidgets \
- security tcpip plotchart bltsubst
-
Copied: branches/nscldaq-11.0-rc14/base/Makefile.am (from rev 3892, branches/nscldaq-11.0-development/base/Makefile.am)
===================================================================
--- branches/nscldaq-11.0-rc14/base/Makefile.am (rev 0)
+++ branches/nscldaq-11.0-rc14/base/Makefile.am 2014-09-25 19:32:40 UTC (rev 3900)
@@ -0,0 +1,3 @@
+SUBDIRS = os CopyrightTools cvt uri thread headers tclwidgets \
+ security tcpip plotchart bltsubst plotcontainer
+
Deleted: branches/nscldaq-11.0-rc14/base/plotchart/pkgIndex.tcl
===================================================================
--- branches/nscldaq-11.0-development/base/plotchart/pkgIndex.tcl 2014-09-25 16:16:14 UTC (rev 3891)
+++ branches/nscldaq-11.0-rc14/base/plotchart/pkgIndex.tcl 2014-09-25 19:32:40 UTC (rev 3900)
@@ -1,13 +0,0 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-package ifneeded plotanim 0.2 [list source [file join $dir plotanim.tcl]]
-package ifneeded Plotchart 2.0.1 [list source [file join $dir plotchart.tcl]]
-package ifneeded xyplot 1.0.1 [list source [file join $dir xyplot.tcl]]
\ No newline at end of file
Copied: branches/nscldaq-11.0-rc14/base/plotchart/pkgIndex.tcl (from rev 3892, branches/nscldaq-11.0-development/base/plotchart/pkgIndex.tcl)
===================================================================
--- branches/nscldaq-11.0-rc14/base/plotchart/pkgIndex.tcl (rev 0)
+++ branches/nscldaq-11.0-rc14/base/plotchart/pkgIndex.tcl 2014-09-25 19:32:40 UTC (rev 3900)
@@ -0,0 +1,13 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded plotanim 0.2 [list source [file join $dir plotanim.tcl]]
+package ifneeded Plotchart 3.0 [list source [file join $dir plotchart.tcl]]
+package ifneeded xyplot 1.0.1 [list source [file join $dir xyplot.tcl]]
\ No newline at end of file
Deleted: branches/nscldaq-11.0-rc14/base/plotchart/plotaxis.tcl
===================================================================
--- branches/nscldaq-11.0-development/base/plotchart/plotaxis.tcl 2014-09-25 16:16:14 UTC (rev 3891)
+++ branches/nscldaq-11.0-rc14/base/plotchart/plotaxis.tcl 2014-09-25 19:32:40 UTC (rev 3900)
@@ -1,1699 +0,0 @@
-# plotaxis.tcl --
-# Facilities to draw simple plots in a dedicated canvas
-#
-# Note:
-# This source file contains the functions for drawing the axes
-# and the legend. It is the companion of "plotchart.tcl"
-#
-
-# FormatNumber --
-# Format a number (either as double or as integer)
-# Arguments:
-# format Format string
-# number Number to be formatted
-# Result:
-# String containing the formatted number
-# Note:
-# This procedure tries to format the string as a double first,
-# but to allow formats like %x, it also tries it that way.
-#
-proc ::Plotchart::FormatNumber { format number } {
-
- if { [catch {
- set string [format $format $number]
- } msg1] } {
- if { [catch {
- set string [format $format [expr {int($number)}]]
- } msg2] } {
- set string [format $format $number] ;# To get the original message
- }
- }
-
- return $string
-}
-
-# Ceil, Floor --
-# Compute ceil and floor in an absolute sense
-#
-# Arguments:
-# value Extreme value to "round"
-# step Step to use for rounding
-#
-proc ::Plotchart::Floor {value step} {
-
- if { $step eq "" } {
- return $value
- }
-
- if { $value > 0.0 } {
- set result [expr {floor(($value+0.0)/$step) * $step}]
- } else {
- set result [expr {ceil(($value+0.0)/$step) * $step}]
- }
-
- return $result
-}
-proc ::Plotchart::Ceil {value step} {
-
- if { $step eq "" } {
- return $value
- }
-
- if { $value > 0.0 } {
- set result [expr {ceil(($value+0.0)/$step) * $step}]
- } else {
- set result [expr {floor(($value+0.0)/$step) * $step}]
- }
-
- return $result
-}
-
-# DrawYaxis --
-# Draw the y-axis
-# Arguments:
-# w Name of the canvas
-# ymin Minimum y coordinate
-# ymax Maximum y coordinate
-# ystep Step size
-# args Options (currently: -ylabels list)
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawYaxis { w ymin ymax ydelt args} {
- variable scaling
- variable config
-
- set scaling($w,ydelt) $ydelt
-
- $w delete "yaxis && $w"
-
- set linecolor $config($w,leftaxis,color)
- set textcolor $config($w,leftaxis,textcolor)
- set textfont $config($w,leftaxis,font)
- set ticklength $config($w,leftaxis,ticklength)
- set thickness $config($w,leftaxis,thickness)
- set labeloffset $config($w,leftaxis,labeloffset)
- set offtick [expr {($ticklength > 0)? $ticklength+$labeloffset : $labeloffset}]
-
- if { $config($w,leftaxis,showaxle) } {
- $w create line $scaling($w,pxmin) $scaling($w,pymin) \
- $scaling($w,pxmin) $scaling($w,pymax) \
- -fill $linecolor -tag [list yaxis $w] -width $thickness
- }
-
- set format $config($w,leftaxis,format)
- if { [info exists scaling($w,-format,y)] } {
- set format $scaling($w,-format,y)
- }
-
- if { $ymax > $ymin } {
- set y [Ceil $ymin $ydelt]
- set ym [Floor $ymax $ydelt]
- set yt $y
- } else {
- set y [Floor $ymax $ydelt]
- set ym [Ceil $ymin $ydelt]
- set yt $ym
- }
-
- set scaling($w,yaxis) {}
-
- set ys {}
- set yts {}
- set ybackup {}
- set numeric 1
-
- if { $ydelt eq {} } {
-
- foreach {arg val} $args {
- switch -exact -- $arg {
- -ylabels {
- set ys $val
- set ydbackup [expr {($scaling($w,ymax)-$scaling($w,ymin))/([llength $val]-1.0)}]
- set yb $scaling($w,ymin)
-
- foreach yval $val {
- if { [string is double $yval] } {
- lappend yts [expr {$yval+0.0}]
- } else {
- set numeric 0
- lappend yts $yval
- }
- lappend ybackup $yb
- set yb [expr {$yb + $ydbackup}]
- }
-
- set scaling($w,ydelt) $ys
- }
- default {
- error "Argument $arg not recognized"
- }
- }
- }
- } else {
- set scaling($w,ydelt) $ydelt
- while { $y < $ym+0.0001*abs($ydelt) } {
- lappend ys $y
- lappend yts $yt
- set y [expr {$y+abs($ydelt)}]
- set yt [expr {$yt+$ydelt}]
- if { abs($y) < 0.5*abs($ydelt) } {
- set yt 0.0
- }
- }
- set dyminor [expr {$ydelt/($config($w,leftaxis,minorticks)+1.0)}]
- }
-
- foreach y $ys yt $yts yb $ybackup {
-
- if { $numeric } {
- foreach {xcrd ycrd} [coordsToPixel $w $scaling($w,xmin) $yt] {break}
- } else {
- foreach {xcrd ycrd} [coordsToPixel $w $scaling($w,xmin) $yb] {break}
- }
- set xcrd2 [expr {$xcrd-$ticklength}]
- set xcrd3 [expr {$xcrd-$offtick}]
-
- if { $ycrd >= $scaling($w,pymin)-1 && $ycrd <= $scaling($w,pymax)+1 } {
- lappend scaling($w,yaxis) $ycrd
-
- #
- # Use the default format %.12g - this is equivalent to setting
- # tcl_precision to 12 - to solve overly precise labels in Tcl 8.5
- #
- if { [string is double $yt] } {
- set ylabel [format "%.12g" $yt]
- if { $format != "" } {
- set ylabel [FormatNumber $format $y]
- }
- } else {
- set ylabel $yt
- }
- $w create line $xcrd2 $ycrd $xcrd $ycrd -tag [list yaxis $w] -fill $linecolor
-
- if { $config($w,leftaxis,shownumbers) } {
- $w create text $xcrd3 $ycrd -text $ylabel -tag [list yaxis $w] -anchor e \
- -fill $textcolor -font $textfont
- }
-
- if { $ydelt != {} && $numeric && $yt < $ym } {
- for {set i 1} {$i <= $config($w,leftaxis,minorticks)} {incr i} {
- set xcrd4 [expr {$xcrd-$ticklength*0.6}]
- set yminor [expr {$yt + $i * $dyminor}]
- foreach {xcrd ycrd4} [coordsToPixel $w $scaling($w,xmin) $yminor] {break}
- $w create line $xcrd4 $ycrd4 $xcrd $ycrd4 -tag [list yaxis $w] -fill $linecolor
- }
- }
- }
- }
-}
-
-# DrawRightaxis --
-# Draw the y-axis on the right-hand side
-# Arguments:
-# w Name of the canvas
-# ymin Minimum y coordinate
-# ymax Maximum y coordinate
-# ystep Step size
-# args Options (currently: -ylabels list)
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawRightaxis { w ymin ymax ydelt args } {
- variable scaling
- variable config
-
- set scaling($w,ydelt) $ydelt
-
- $w delete "raxis && $w"
-
- set linecolor $config($w,rightaxis,color)
- set textcolor $config($w,rightaxis,textcolor)
- set textfont $config($w,rightaxis,font)
- set thickness $config($w,rightaxis,thickness)
- set ticklength $config($w,rightaxis,ticklength)
- set labeloffset $config($w,leftaxis,labeloffset)
- set offtick [expr {($ticklength > 0)? $ticklength+$labeloffset : $labeloffset}]
-
- if { $config($w,rightaxis,showaxle) } {
- $w create line $scaling($w,pxmax) $scaling($w,pymin) \
- $scaling($w,pxmax) $scaling($w,pymax) \
- -fill $linecolor -tag [list raxis $w] -width $thickness
- }
-
- set format $config($w,rightaxis,format)
- if { [info exists scaling($w,-format,y)] } {
- set format $scaling($w,-format,y)
- }
-
- if { $ymax > $ymin } {
- set y [Ceil $ymin $ydelt]
- set ym [Floor $ymax $ydelt]
- set yt $y
- } else {
- set y [Floor $ymax $ydelt]
- set ym [Ceil $ymin $ydelt]
- set yt $ym
- }
-
- set scaling($w,yaxis) {}
-
- set ys {}
- set yts {}
- set ybackup {}
- set numeric 1
-
- if { $ydelt eq {} } {
-
- foreach {arg val} $args {
- switch -exact -- $arg {
- -ylabels {
- set ys $val
- set ydbackup [expr {($scaling($w,ymax)-$scaling($w,ymin))/([llength $val]-1.0)}]
- set yb $scaling($w,ymin)
-
- foreach yval $val {
- if { [string is double $yval] } {
- lappend yts [expr {$yval+0.0}]
- } else {
- set numeric 0
- lappend yts $yval
- }
- lappend ybackup $yb
- set yb [expr {$yb + $ydbackup}]
- }
-
- set scaling($w,ydelt) $ys
- }
- default {
- error "Argument $arg not recognized"
- }
- }
- }
- } else {
- set scaling($w,ydelt) $ydelt
- while { $y < $ym+0.0001*abs($ydelt) } {
- lappend ys $y
- lappend yts $yt
- set y [expr {$y+abs($ydelt)}]
- set yt [expr {$yt+$ydelt}]
- if { abs($y) < 0.5*abs($ydelt) } {
- set yt 0.0
- }
- }
- set dyminor [expr {$ydelt/($config($w,rightaxis,minorticks)+1.0)}]
- }
-
-
- foreach y $ys yt $yts yb $ybackup {
-
- if { $numeric } {
- foreach {xcrd ycrd} [coordsToPixel $w $scaling($w,xmax) $yt] {break}
- } else {
- foreach {xcrd ycrd} [coordsToPixel $w $scaling($w,xmax) $yb] {break}
- }
- set xcrd2 [expr {$xcrd+$ticklength}]
- set xcrd3 [expr {$xcrd+$offtick}]
-
- if { $ycrd >= $scaling($w,pymin)-1 && $ycrd <= $scaling($w,pymax)+1 } {
- lappend scaling($w,yaxis) $ycrd
-
- #
- # Use the default format %.12g - this is equivalent to setting
- # tcl_precision to 12 - to solve overly precise labels in Tcl 8.5
- #
- if { [string is double $yt] } {
- set ylabel [format "%.12g" $yt]
- if { $format != "" } {
- set ylabel [FormatNumber $format $y]
- }
- } else {
- set ylabel $yt
- }
- $w create line $xcrd2 $ycrd $xcrd $ycrd -tag [list raxis $w] -fill $linecolor
-
- if { $config($w,leftaxis,shownumbers) } {
- $w create text $xcrd3 $ycrd -text $ylabel -tag [list raxis $w] -anchor w \
- -fill $textcolor -font $textfont
- }
-
- if { $ydelt != {} && $numeric && $yt < $ym } {
- for {set i 1} {$i <= $config($w,rightaxis,minorticks)} {incr i} {
- set xcrd4 [expr {$xcrd+$ticklength*0.6}]
- set yminor [expr {$yt + $i * $dyminor}]
- foreach {xcrd ycrd4} [coordsToPixel $w $scaling($w,xmax) $yminor] {break}
- $w create line $xcrd4 $ycrd4 $xcrd $ycrd4 -tag [list raxis $w] -fill $linecolor
- }
- }
- }
- }
-}
-
-# DrawLogYaxis --
-# Draw the logarithmic y-axis
-# Arguments:
-# w Name of the canvas
-# ymin Minimum y coordinate
-# ymax Maximum y coordinate
-# ystep Step size
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawLogYaxis { w ymin ymax ydelt } {
- variable scaling
- variable config
-
- set scaling($w,ydelt) $ydelt
-
- $w delete "yaxis && $w"
-
- set linecolor $config($w,leftaxis,color)
- set textcolor $config($w,leftaxis,textcolor)
- set textfont $config($w,leftaxis,font)
- set thickness $config($w,leftaxis,thickness)
- set ticklength $config($w,leftaxis,ticklength)
- set labeloffset $config($w,leftaxis,labeloffset)
- set offtick [expr {($ticklength > 0)? $ticklength+$labeloffset : $labeloffset}]
-
- if { $config($w,leftaxis,showaxle) } {
- $w create line $scaling($w,pxmin) $scaling($w,pymin) \
- $scaling($w,pxmin) $scaling($w,pymax) \
- -fill $linecolor -tag [list yaxis $w] -width $thickness
- }
-
- set format $config($w,leftaxis,format)
- if { [info exists scaling($w,-format,y)] } {
- set format $scaling($w,-format,y)
- }
-
- set scaling($w,yaxis) {}
-
- set y [expr {pow(10.0,floor(log10($ymin)))}]
- set ylogmax [expr {pow(10.0,ceil(log10($ymax)))+0.1}]
-
- while { $y < $ylogmax } {
-
- #
- # Labels and tickmarks
- #
- foreach factor {1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0} {
- set yt [expr {$y*$factor}]
- if { $yt < $ymin } continue
- if { $yt > $ymax } break
-
- foreach {xcrd ycrd} [coordsToPixel $w $scaling($w,xmin) [expr {log10($yt)}]] {break}
- set xcrd2 [expr {$xcrd-$ticklength}]
- set xcrd3 [expr {$xcrd-$offtick}]
-
- lappend scaling($w,yaxis) $ycrd
-
- #
- # Use the default format %.12g - this is equivalent to setting
- # tcl_precision to 12 - to solve overly precise labels in Tcl 8.5
- #
- set ylabel [format "%.12g" $y]
- if { $format != "" } {
- set ylabel [FormatNumber $format $y]
- }
- $w create line $xcrd2 $ycrd $xcrd $ycrd -tag yaxis -fill $linecolor
- if { $factor == 1.0 && $config($w,leftaxis,showaxle) } {
- $w create text $xcrd3 $ycrd -text $ylabel -tag [list yaxis $w] -anchor e \
- -fill $textcolor -font $textfont
- }
- }
- set y [expr {10.0*$y}]
- }
-
- set scaling($w,ydelt) $ydelt
-}
-
-# DrawXaxis --
-# Draw the x-axis
-# Arguments:
-# w Name of the canvas
-# xmin Minimum x coordinate
-# xmax Maximum x coordinate
-# xstep Step size
-# args Options (currently: -xlabels list)
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawXaxis { w xmin xmax xdelt args } {
- variable scaling
- variable config
-
- $w delete "xaxis && $w"
-
- set linecolor $config($w,bottomaxis,color)
- set textcolor $config($w,bottomaxis,textcolor)
- set textfont $config($w,bottomaxis,font)
- set thickness $config($w,bottomaxis,thickness)
- set ticklength $config($w,bottomaxis,ticklength)
- set labeloffset $config($w,leftaxis,labeloffset)
- set offtick [expr {($ticklength > 0)? $ticklength+$labeloffset : $labeloffset}]
-
- if { $config($w,bottomaxis,showaxle) } {
- $w create line $scaling($w,pxmin) $scaling($w,pymax) \
- $scaling($w,pxmax) $scaling($w,pymax) \
- -fill $linecolor -tag [list xaxis $w] -width $thickness
- }
-
- set format $config($w,bottomaxis,format)
- if { [info exists scaling($w,-format,x)] } {
- set format $scaling($w,-format,x)
- }
-
- if { $xmax > $xmin } {
- set x [Ceil $xmin $xdelt]
- set xm [Floor $xmax $xdelt]
- set xt $x
- } else {
- set x [Floor $xmax $xdelt]
- set xm [Ceil $xmin $xdelt]
- set xt $xm
- }
-
- set scaling($w,xaxis) {}
-
- set xs {}
- set xts {}
- set xbackup {}
- set numeric 1
-
- if { $xdelt eq {} } {
- set numeric 1
-
- foreach {arg val} $args {
- switch -exact -- $arg {
- -xlabels {
- set xs $val
- set xdbackup [expr {($scaling($w,xmax)-$scaling($w,xmin))/([llength $val]-1.0)}]
- set xb $scaling($w,xmin)
-
- foreach xval $val {
- if { [string is double $xval] } {
- lappend xts [expr {$xval+0.0}]
- } else {
- set numeric 0
- lappend xts $xval
- }
- lappend xbackup $xb
- set xb [expr {$xb + $xdbackup}]
- }
-
- set scaling($w,xdelt) $xs
-
- }
- default {
- error "Argument $arg not recognized"
- }
- }
- }
- } else {
- set scaling($w,xdelt) $xdelt
- while { $x < $xm+0.5*abs($xdelt) } {
- lappend xs $x
- lappend xts $xt
- lappend xbackup $xt
- set x [expr {$x+abs($xdelt)}]
- set xt [expr {$xt+$xdelt}]
- if { abs($x) < 0.5*abs($xdelt) } {
- set xt 0.0
- }
- }
- set dxminor [expr {$xdelt/($config($w,bottomaxis,minorticks)+1.0)}]
- }
- foreach x $xs xt $xts xb $xbackup {
-
- if { $numeric } {
- foreach {xcrd ycrd} [coordsToPixel $w $xt $scaling($w,ymin)] {break}
- } else {
- foreach {xcrd ycrd} [coordsToPixel $w $xb $scaling($w,ymin)] {break}
- }
- set ycrd2 [expr {$ycrd+$ticklength}]
- set ycrd3 [expr {$ycrd+$offtick}]
-
- if { $xcrd >= $scaling($w,pxmin)-1 && $xcrd <= $scaling($w,pxmax)+1 } {
- lappend scaling($w,xaxis) $xcrd
-
- #
- # Use the default format %.12g - this is equivalent to setting
- # tcl_precision to 12 - to solve overly precise labels in Tcl 8.5
- #
- if { [string is double $xt] } {
- set xlabel [format "%.12g" $xt]
- if { $format != "" } {
- set xlabel [FormatNumber $format $xt]
- }
- } else {
- set xlabel $xt
- }
-
- $w create line $xcrd $ycrd2 $xcrd $ycrd -tag [list xaxis $w] -fill $linecolor
-
- if { $config($w,bottomaxis,shownumbers) } {
- $w create text $xcrd $ycrd3 -text $xlabel -tag [list xaxis $w] -anchor n \
- -fill $textcolor -font $textfont
- }
-
- if { $xdelt != {} && $numeric && $xt < $xm } {
- for {set i 1} {$i <= $config($w,bottomaxis,minorticks)} {incr i} {
- set ycrd4 [expr {$ycrd+$ticklength*0.6}]
- set xminor [expr {$xt + $i * $dxminor}]
- foreach {xcrd4 ycrd} [coordsToPixel $w $xminor $scaling($w,ymin)] {break}
- $w create line $xcrd4 $ycrd4 $xcrd4 $ycrd -tag [list xaxis $w] -fill $linecolor
- }
- }
- }
- }
-}
-
-# DrawLogXaxis --
-# Draw the logarithmic x-axis
-# Arguments:
-# w Name of the canvas
-# xmin Minimum x coordinate
-# xmax Maximum x coordinate
-# xstep Step size
-# args Options (currently: -xlabels list)
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawLogXaxis { w xmin xmax xdelt args } {
- variable scaling
- variable config
-
- $w delete "xaxis && $w"
-
- set linecolor $config($w,bottomaxis,color)
- set textcolor $config($w,bottomaxis,textcolor)
- set textfont $config($w,bottomaxis,font)
- set thickness $config($w,bottomaxis,thickness)
- set ticklength $config($w,bottomaxis,ticklength)
- set labeloffset $config($w,leftaxis,labeloffset)
- set offtick [expr {($ticklength > 0)? $ticklength+$labeloffset : $labeloffset}]
-
- if { $config($w,bottomaxis,showaxle) } {
- $w create line $scaling($w,pxmin) $scaling($w,pymax) \
- $scaling($w,pxmax) $scaling($w,pymax) \
- -fill $linecolor -tag [list xaxis $w] -width $thickness
- }
-
- set format $config($w,bottomaxis,format)
- if { [info exists scaling($w,-format,x)] } {
- set format $scaling($w,-format,x)
- }
-
- set scaling($w,xaxis) {}
-
- set x [expr {pow(10.0,floor(log10($xmin)))}]
- set xlogmax [expr {pow(10.0,ceil(log10($xmax)))+0.1}]
-
- while { $x < $xlogmax } {
- #
- # Labels and tickmarks
- #
- foreach factor {1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0} {
- set xt [expr {$x*$factor}]
- if { $xt < $xmin } continue
- if { $xt > $xmax } break
-
- foreach {xcrd ycrd} [coordsToPixel $w [expr {log10($xt)}] $scaling($w,ymin)] {break}
- set ycrd2 [expr {$ycrd+$ticklength}]
- set ycrd3 [expr {$ycrd+$offtick}]
-
- if {($xcrd >= $scaling($w,pxmin)) && ($xcrd <= $scaling($w,pxmax))} {
- lappend scaling($w,xaxis) $xcrd
-
- #
- # Use the default format %.12g - this is equivalent to setting
- # tcl_precision to 12 - to solve overly precise labels in Tcl 8.5
- #
- set xlabel [format "%.12g" $xt]
- if { $format != "" } {
- set xlabel [FormatNumber $format $xt]
- }
- $w create line $xcrd $ycrd2 $xcrd $ycrd -tag [list xaxis $w] -fill $linecolor
- if { $factor == 1.0 && $config($w,bottomaxis,shownumbers) } {
- $w create text $xcrd $ycrd3 -text $xlabel -tag [list xaxis $w] -anchor n \
- -fill $textcolor -font $textfont
- }
- }
- }
- set x [expr {10.0*$x}]
- }
-
- set scaling($w,xdelt) $xdelt
-}
-
-# DrawXtext --
-# Draw text to the x-axis
-# Arguments:
-# w Name of the canvas
-# args Text to be drawn (more than one argument if rendering in on)
-# Result:
-# None
-# Side effects:
-# Text drawn in canvas
-#
-proc ::Plotchart::DrawXtext { w args } {
- variable scaling
- variable config
-
- set textcolor $config($w,bottomaxis,textcolor)
- set textfont $config($w,bottomaxis,font)
-
- set xt [expr {($scaling($w,pxmin)+$scaling($w,pxmax))/2}]
- set yt [expr {$scaling($w,pymax)+$config($w,font,char_height)+4}]
-
- $w delete "xtext && $w"
- if {$config($w,bottomaxis,render) eq "simple"} {
- $w create text $xt $yt -text [lindex $args 0] -fill $textcolor -anchor n -font $textfont -tags [list xtext $w]
- } elseif {$config($w,bottomaxis,render) eq "text"} {
- RenderText $w $xt $yt -text $args -anchor n -font $textfont -tags [list xtext $w] \
- -fill $textcolor
- }
-}
-
-# DrawYtext --
-# Draw text to the y-axis
-# Arguments:
-# w Name of the canvas
-# text Text to be drawn
-# Result:
-# None
-# Side effects:
-# Text drawn in canvas
-#
-proc ::Plotchart::DrawYtext { w text } {
- variable scaling
- variable config
-
-
- if { [string match "r*" $w] == 0 } {
- set textcolor $config($w,leftaxis,textcolor)
- set textfont $config($w,leftaxis,font)
- set xt $scaling($w,pxmin)
- set anchor se
- } else {
- set textcolor $config($w,rightaxis,textcolor)
- set textfont $config($w,rightaxis,font)
- set xt $scaling($w,pxmax)
- set anchor sw
- }
- set yt [expr {$scaling($w,pymin)-$config($w,font,char_height)/2}]
-
- $w delete "ytext && $w"
- $w create text $xt $yt -text $text -fill $textcolor -anchor $anchor -font $textfont -tags [list ytext $w]
-}
-
-# DrawVtext --
-# Draw vertical text to the y-axis
-# Arguments:
-# w Name of the canvas
-# text Text to be drawn
-# Result:
-# None
-# Side effects:
-# Text drawn in canvas
-# Note:
-# This requires Tk 8.6 or later
-#
-proc ::Plotchart::DrawVtext { w text } {
- variable scaling
- variable config
-
- if { [package vsatisfies [package present Tk] 8.6] } {
- set bbox [$w bbox yaxis]
- set xt [expr {[lindex $bbox 0] - $config($w,leftaxis,vtextoffset)}]
- set yt [expr {($scaling($w,pymin) + $scaling($w,pymax)) / 2}]
-
- $w delete "vtext && $w"
- $w create text $xt $yt -text $text -fill black -anchor s -angle 90 -tags [list vtext $w] \
- -font $config($w,leftaxis,font) -fill $config($w,leftaxis,textcolor)
- }
-}
-
-# DrawPolarAxes --
-# Draw thw two polar axes
-# Arguments:
-# w Name of the canvas
-# rad_max Maximum radius
-# rad_step Step in radius
-# Result:
-# None
-# Side effects:
-# Axes drawn in canvas
-#
-proc ::Plotchart::DrawPolarAxes { w rad_max rad_step } {
- variable config
-
- set linecolor $config($w,axis,color)
- set textcolor $config($w,axis,textcolor)
- set textfont $config($w,axis,font)
- set thickness $config($w,axis,thickness)
- set bgcolor $config($w,background,innercolor)
-
- #
- # Draw the spikes
- #
- set angle 0.0
-
- foreach {xcentre ycentre} [polarToPixel $w 0.0 0.0] {break}
-
- while { $angle < 360.0 } {
- foreach {xcrd ycrd} [polarToPixel $w $rad_max $angle] {break}
- foreach {xtxt ytxt} [polarToPixel $w [expr {1.05*$rad_max}] $angle] {break}
- $w create line $xcentre $ycentre $xcrd $ycrd -fill $linecolor -width $thickness
- if { $xcrd > $xcentre } {
- set dir w
- } else {
- set dir e
- }
- $w create text $xtxt $ytxt -text $angle -anchor $dir -fill $textcolor -font $textfont -tags [list polar $w]
-
- set angle [expr {$angle+30}]
- }
-
- #
- # Draw the concentric circles
- #
- set rad $rad_step
-
- while { $rad < $rad_max+0.5*$rad_step } {
- foreach {xright ytxt} [polarToPixel $w $rad 0.0] {break}
- foreach {xleft ycrd} [polarToPixel $w $rad 180.0] {break}
- foreach {xcrd ytop} [polarToPixel $w $rad 90.0] {break}
- foreach {xcrd ybottom} [polarToPixel $w $rad 270.0] {break}
-
- set oval [$w create oval $xleft $ytop $xright $ybottom -outline $linecolor -width $thickness -fill {} \
- -tags [list polar $w]]
- $w lower $oval
-
- $w create text $xright [expr {$ytxt+3}] -text $rad -anchor n -fill $textcolor -font $textfont -tags [list polar $w]
-
- set rad [expr {$rad+$rad_step}]
- }
-}
-
-# DrawXlabels --
-# Draw the labels to an x-axis (barchart)
-# Arguments:
-# w Name of the canvas
-# xlabels List of labels
-# noseries Number of series or "stacked"
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawXlabels { w xlabels noseries } {
- variable scaling
- variable config
-
- set linecolor $config($w,bottomaxis,color)
- set textcolor $config($w,bottomaxis,textcolor)
- set textfont $config($w,bottomaxis,font)
- set thickness $config($w,bottomaxis,thickness)
-
- $w delete "xaxis && $w"
-
- $w create line $scaling($w,pxmin) $scaling($w,pymax) \
- $scaling($w,pxmax) $scaling($w,pymax) \
- -fill $linecolor -width $thickness -tag [list xaxis $w]
-
- if { $noseries eq "stacked" } {
- set x 1.0
- } else {
- set x 1.0
- #set x [expr {0.5 + int($noseries)/(2.0*$noseries)}]
- }
- set scaling($w,ybase) {}
- foreach label $xlabels {
- foreach {xcrd ycrd} [coordsToPixel $w $x $scaling($w,ymin)] {break}
- set ycrd [expr {$ycrd+2}]
- $w create text $xcrd $ycrd -text $label -tag [list xaxis $w] -anchor n \
- -fill $textcolor -font $textfont
- set x [expr {$x+1.0}]
-
- lappend scaling($w,ybase) 0.0
- }
-
- if { $noseries != "stacked" } {
- set scaling($w,stacked) 0
- set scaling($w,xshift) [expr {$config($w,bar,barwidth)/$noseries}]
- set scaling($w,barwidth) [expr {$config($w,bar,barwidth)/$noseries}]
- set scaling($w,xbase) [expr {1.0 - $config($w,bar,barwidth)/2.0}]
- } else {
- set scaling($w,stacked) 1
- set scaling($w,xshift) 0.0
- set scaling($w,barwidth) $config($w,bar,barwidth)
- set scaling($w,xbase) [expr {1.0 - $config($w,bar,barwidth)/2.0}]
- }
-}
-
-# DrawYlabels --
-# Draw the labels to a y-axis (barchart)
-# Arguments:
-# w Name of the canvas
-# ylabels List of labels
-# noseries Number of series or "stacked"
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawYlabels { w ylabels noseries } {
- variable scaling
- variable config
-
- set linecolor $config($w,leftaxis,color)
- set textcolor $config($w,leftaxis,textcolor)
- set textfont $config($w,leftaxis,font)
- set thickness $config($w,leftaxis,thickness)
-
- $w delete "yaxis && $w"
-
- $w create line $scaling($w,pxmin) $scaling($w,pymin) \
- $scaling($w,pxmin) $scaling($w,pymax) \
- -fill $linecolor -width $thickness -tag [list yaxis $w]
-
- if { $noseries != "stacked" } {
- set y 1.0
- #set y [expr {0.5 + int($noseries)/(2.0*$noseries)}]
- } else {
- set y 1.0
- }
- set scaling($w,xbase) {}
- foreach label $ylabels {
- foreach {xcrd ycrd} [coordsToPixel $w $scaling($w,xmin) $y] {break}
- set xcrd [expr {$xcrd-2}]
- $w create text $xcrd $ycrd -text $label -tag [list yaxis $w] -anchor e \
- -fill $textcolor -font $textfont
- set y [expr {$y+1.0}]
-
- lappend scaling($w,xbase) 0.0
- }
-
- if { $noseries != "stacked" } {
- set scaling($w,stacked) 0
- set scaling($w,yshift) [expr {$config($w,bar,barwidth)/$noseries}]
- set scaling($w,barwidth) [expr {$config($w,bar,barwidth)/$noseries}]
- set scaling($w,ybase) [expr {1.0 - $config($w,bar,barwidth)/2.0}]
- } else {
- set scaling($w,stacked) 1
- set scaling($w,yshift) 0.0
- set scaling($w,barwidth) $config($w,bar,barwidth)
- set scaling($w,ybase) [expr {1.0 - $config($w,bar,barwidth)/2.0}]
- }
-}
-
-# XConfig --
-# Configure the x-axis for an XY plot
-# Arguments:
-# w Name of the canvas
-# args Option and value pairs
-# Result:
-# None
-#
-proc ::Plotchart::XConfig { w args } {
- AxisConfig xyplot $w x DrawXaxis $args
-}
-
-# TConfig --
-# Configure the time-axis for an TX plot
-# Arguments:
-# w Name of the canvas
-# args Option and value pairs
-# Result:
-# None
-#
-proc ::Plotchart::TConfig { w args } {
- AxisConfig txplot $w x DrawTimeaxis $args
-}
-
-# YConfig --
-# Configure the y-axis for an XY plot
-# Arguments:
-# w Name of the canvas
-# args Option and value pairs
-# Result:
-# None
-#
-proc ::Plotchart::YConfig { w args } {
- if { ! [string match "r*" $w] } {
- AxisConfig xyplot $w y DrawYaxis $args
- } else {
- AxisConfig xyplot $w y DrawRightaxis $args
- }
-}
-
-# LogXConfig, ... --
-# Configure the x-axis for an logX-Y, X-logY or logX-logY plot
-# Arguments:
-# w Name of the canvas
-# args Option and value pairs
-# Result:
-# None
-#
-proc ::Plotchart::XConfigLogXY { w args } {
- AxisConfig logxyplot $w x DrawLogXaxis $args
-}
-
-proc ::Plotchart::XConfigXLogY { w args } {
- AxisConfig xlogyplot $w x DrawXaxis $args
-}
-
-proc ::Plotchart::XConfigLogXLogY { w args } {
- AxisConfig logxlogyplot $w x DrawLogXaxis $args
-}
-
-# LogYConfig --
-# Configure the y-axis for an X-logY, X-logY or logX-logY plot
-# Arguments:
-# w Name of the canvas
-# args Option and value pairs
-# Result:
-# None
-#
-proc ::Plotchart::YConfigLogXY { w args } {
- if { ! [string match "r*" $w] } {
- AxisConfig logxyplot $w y DrawYaxis $args
- } else {
- #
- # TODO: this is not supported yet
- #
- AxisConfig xyplot $w y DrawRightaxis $args
- }
-}
-
-proc ::Plotchart::YConfigXLogY { w args } {
- if { ! [string match "r*" $w] } {
- AxisConfig xlogyplot $w y DrawLogYaxis $args
- } else {
- #
- # TODO: this is not supported yet
- #
- AxisConfig xyplot $w y DrawRightaxis $args
- }
-}
-
-proc ::Plotchart::YConfigLogXLogY { w args } {
- if { ! [string match "r*" $w] } {
- AxisConfig logxlogyplot $w y DrawLogYaxis $args
- } else {
- #
- # TODO: this is not supported yet
- #
- AxisConfig xyplot $w y DrawRightaxis $args
- }
-}
-
-# AxisConfig --
-# Configure an axis and redraw it if necessary
-# Arguments:
-# plottype Type of plot
-# w Name of the canvas
-# orient Orientation of the axis
-# drawmethod Drawing method
-# option_values Option/value pairs
-# Result:
-# None
-#
-# Note:
-# Merge the old configuration system with the new
-#
-proc ::Plotchart::AxisConfig { plottype w orient drawmethod option_values } {
- variable config
- variable scaling
- variable axis_options
- variable axis_option_clear
- variable axis_option_values
- variable axis_option_config
-
- set clear_data 0
-
- foreach {option value} $option_values {
- set idx [lsearch $axis_options $option]
- if { $idx < 0 } {
- return -code error "Unknown or invalid option: $option (value: $value)"
- } else {
- set clear_data [lindex $axis_option_clear $idx]
- set values [lindex $axis_option_values [expr {2*$idx+1}]]
- set isconfig [lindex $axis_option_config $idx]
- if { $values != "..." } {
- if { [lsearch $values $value] < 0 } {
- return -code error "Unknown or invalid value: $value for option $option - $values"
- }
- }
- if { $isconfig } {
- if { $orient == "x" } {
- set axis bottomaxis
- }
- if { $orient == "y" } {
- set axis leftaxis
- }
- set config($w,$axis,[string range $option 1 end]) $value
- } else {
- set scaling($w,$option,$orient) $value
- }
- if { $option == "-scale" } {
- set min ${orient}min
- set max ${orient}max
- set delt ${orient}delt
- foreach [list $min $max $delt] $value {break}
- #checker exclude warnVarRef
- set scaling($w,$min) [set $min]
- #checker exclude warnVarRef
- set scaling($w,$max) [set $max]
- #checker exclude warnVarRef
- set scaling($w,$delt) [set $delt]
- }
- }
- }
-
- if { $clear_data } {
- $w delete data
- }
-
- set xmin $scaling($w,xmin)
- set xmax $scaling($w,xmax)
- set ymin $scaling($w,ymin)
- set ymax $scaling($w,ymax)
-
- switch -- $plottype {
- "logxyplot" {
- set xmin [expr {pow(10.0,$scaling($w,xmin))}]
- set xmax [expr {pow(10.0,$scaling($w,xmax))}]
- }
- "xlogyplot" {
- set ymin [expr {pow(10.0,$scaling($w,ymin))}]
- set ymax [expr {pow(10.0,$scaling($w,ymax))}]
- }
- "logxlogyplot" {
- set xmin [expr {pow(10.0,$scaling($w,xmin))}]
- set xmax [expr {pow(10.0,$scaling($w,xmax))}]
- set ymin [expr {pow(10.0,$scaling($w,ymin))}]
- set ymax [expr {pow(10.0,$scaling($w,ymax))}]
- }
- }
-
- set originalSystem $scaling($w,coordSystem)
- set scaling($w,coordSystem) 0
-
-
- if { $orient == "x" } {
- if { [llength $scaling($w,xdelt)] == 1 } {
- #$drawmethod $w $scaling($w,xmin) $scaling($w,xmax) $scaling($w,xdelt)
- $drawmethod $w $xmin $xmax $scaling($w,xdelt)
- } else {
- #$drawmethod $w $scaling($w,xmin) $scaling($w,xmax) {} -xlabels $scaling($w,xdelt)
- $drawmethod $w $xmin $xmax {} -xlabels $scaling($w,xdelt)
- }
- }
- if { $orient == "y" } {
- if { [llength $scaling($w,ydelt)] == 1 } {
- #$drawmethod $w $scaling($w,ymin) $scaling($w,ymax) $scaling($w,ydelt)
- $drawmethod $w $ymin $ymax $scaling($w,ydelt)
- } else {
- #$drawmethod $w $scaling($w,ymin) $scaling($w,ymax) {} -ylabels $scaling($w,ydelt)
- $drawmethod $w $ymin $ymax {} -ylabels $scaling($w,ydelt)
- }
- }
- if { $orient == "z" } {
- $drawmethod $w $scaling($w,zmin) $scaling($w,zmax) $scaling($w,zdelt)
- }
-
- set scaling($w,coordSystem) $originalSystem
-}
-
-# DrawXTicklines --
-# Draw the ticklines for the x-axis
-# Arguments:
-# w Name of the canvas
-# colour Colour of the ticklines
-# dash Dash pattern
-# Result:
-# None
-#
-proc ::Plotchart::DrawXTicklines { w {colour black} {dash lines}} {
- DrawTicklines $w x $colour $dash
-}
-
-# DrawYTicklines --
-# Draw the ticklines for the y-axis
-# Arguments:
-# w Name of the canvas
-# colour Colour of the ticklines
-# dash Dash pattern
-# Result:
-# None
-#
-proc ::Plotchart::DrawYTicklines { w {colour black} {dash lines}} {
- DrawTicklines $w y $colour $dash
-}
-
-# DrawTicklines --
-# Draw the ticklines
-# Arguments:
-# w Name of the canvas
-# axis Which axis (x or y)
-# colour Colour of the ticklines
-# dash Dash pattern
-# Result:
-# None
-#
-proc ::Plotchart::DrawTicklines { w axis colour dash } {
- variable scaling
- variable pattern
-
- if { ! [info exists pattern($dash)] } {
- set dash "lines"
- }
-
- if { $axis == "x" } {
- #
- # Cater for both regular x-axes and time-axes
- #
- if { [info exists scaling($w,xaxis)] } {
- set botaxis xaxis
- } else {
- set botaxis taxis
- }
- $w delete [list xtickline && $w]
- if { $colour != {} } {
- foreach x $scaling($w,$botaxis) {
- $w create line $x $scaling($w,pymin) \
- $x $scaling($w,pymax) \
- -fill $colour -tag [list xtickline $w] \
- -dash $pattern($dash)
- }
- }
- } else {
- $w delete [list ytickline && $w]
- if { $colour != {} } {
- foreach y $scaling($w,yaxis) {
- $w create line $scaling($w,pxmin) $y \
- $scaling($w,pxmax) $y \
- -fill $colour -tag [list ytickline $w] \
- -dash $pattern($dash)
- }
- }
- }
- $w raise [list xaxis && $w]
- $w raise [list yaxis && $w]
- $w raise [list raxis && $w]
-}
-
-# DefaultLegend --
-# Set all legend options to default
-# Arguments:
-# w Name of the canvas
-# Result:
-# None
-#
-proc ::Plotchart::DefaultLegend { w } {
- variable legend
- variable config
-
- set legend($w,background) $config($w,legend,background)
- set legend($w,border) $config($w,legend,border)
- set legend($w,canvas) $w
- set legend($w,position) $config($w,legend,position)
- set legend($w,series) ""
- set legend($w,text) ""
- set legend($w,move) 0
- set legend($w,spacing) 10
-
- $w bind legendobj <ButtonPress-1> [list ::Plotchart::LegendAnchor $w %x %y]
- $w bind legendobj <Motion> [list ::Plotchart::LegendMove $w %x %y]
- $w bind legendobj <ButtonRelease-1> [list ::Plotchart::LegendRelease $w]
-}
-
-# LegendConfigure --
-# Configure the legend
-# Arguments:
-# w Name of the canvas
-# args Key-value pairs
-# Result:
-# None
-#
-proc ::Plotchart::LegendConfigure { w args } {
- variable legend
-
- foreach {option value} $args {
- switch -- $option {
- "-background" {
- set legend($w,background) $value
- }
- "-border" {
- set legend($w,border) $value
- }
- "-canvas" {
- set legend($w,canvas) $value
- }
- "-position" {
- if { [lsearch {top-left top-right bottom-left bottom-right} $value] >= 0 } {
- set legend($w,position) $value
- } else {
- return -code error "Unknown or invalid position: $value"
- }
- }
- "-font" {
- set legend($w,font) $value
- }
- "-legendtype" {
- set legend($w,legendtype) $value
- }
- "-spacing" {
- set legend($w,spacing) $value
- }
- default {
- return -code error "Unknown or invalid option: $option (value: $value)"
- }
- }
- }
-}
-
-# DrawLegend --
-# Draw or extend the legend - add the item and draw
-# Arguments:
-# w Name of the canvas
-# series For which series?
-# text Text to be shown
-# spacing (Optionally) spacing between entries
-# Result:
-# None
-#
-proc ::Plotchart::DrawLegend { w series text {spacing {}}} {
- variable legend
-
- if { [string match r* $w] } {
- set w [string range $w 1 end]
- }
-
- # Append only if new item - not in list already
- if { [lsearch -exact $legend($w,series) $series] < 0 } {
- lappend legend($w,series) $series
- lappend legend($w,text) $text
- }
-
- ActuallyDrawLegend $w $spacing
-}
-
-# RemoveFromLegend --
-# Remove an item from the legend and redraw it
-# Arguments:
-# w Name of the canvas
-# series For which series?
-# Result:
-# None
-#
-proc ::Plotchart::RemoveFromLegend { w series } {
- variable legend
- variable scaling
-
- if { [string match r* $w] } {
- set w [string range $w 1 end]
- }
-
- #
- # Remove item from list
- #
- set indx [lsearch -exact $legend($w,series) $series]
- set legend($w,series) [lreplace $legend($w,series) $indx $indx]
- set legend($w,text) [lreplace $legend($w,text) $indx $indx]
-
- ActuallyDrawLegend $w
-}
-
-# ActuallyDrawLegend --
-# Actually draw the legend
-# Arguments:
-# w Name of the canvas
-# spacing (Optionally) spacing between entries
-# Result:
-# None
-#
-proc ::Plotchart::ActuallyDrawLegend { w {spacing {}}} {
- variable legend
- variable scaling
- variable data_series
-
- if { [string match r* $w] } {
- set w [string range $w 1 end]
- }
-
- set legendw $legend($w,canvas)
-
- $legendw delete "legend && $w"
- $legendw delete "legendbg && $w"
-
- set y 0
- foreach series $legend($w,series) text $legend($w,text) {
-
- set colour "black"
- if { [info exists data_series($w,$series,-colour)] } {
- set colour $data_series($w,$series,-colour)
- }
- set type "line"
- if { [info exists data_series($w,$series,-type)] } {
- set type $data_series($w,$series,-type)
- }
- if { [info exists data_series($w,legendtype)] } {
- set type $data_series($w,legendtype)
- }
- if {[info exists legend($w,legendtype)]} {
- set type $legend($w,legendtype)
- }
- set width 1
- if { [info exists data_series($w,$series,-width)] } {
- set width $data_series($w,$series,-width)
- }
- set font TkTextFont
- if {[info exists legend($w,font)]} {
- set font $legend($w,font)
- }
- if {[info exists legend($w,spacing)] && $spacing == {}} {
- set spacing $legend($w,spacing)
- }
- #
- # Store this setting
- #
- if { $spacing != {} } {
- set legend($w,spacing) $spacing
- }
-
- # TODO: line or rectangle!
-
- if { $type != "rectangle" } {
- if { $type == "line" || $type == "both" } {
- $legendw create line 0 $y 15 $y -fill $colour -tag [list legend legendobj $w] -width $width
- }
-
- if { $type == "symbol" || $type == "both" } {
- set symbol "dot"
- if { [info exists data_series($w,$series,-symbol)] } {
- set symbol $data_series($w,$series,-symbol)
- }
- DrawSymbolPixel $legendw $series 7 $y $symbol $colour [list legend legendobj legend_$series $w]
- }
- } else {
- $legendw create rectangle 0 [expr {$y-3}] 15 [expr {$y+3}] \
- -fill $colour -tag [list legend legendobj legend_$series $w]
- }
-
- $legendw create text 25 $y -text $text -anchor w -tag [list legend legendobj legend_$series $w] -font $font
-
- set y [expr {$y + $spacing}] ;# TODO: size of font!
- }
-
- #
- # Now the frame and the background
- #
- foreach {xl yt xr yb} [$legendw bbox "legend && $w"] {break}
-
- set xl [expr {$xl-2}]
- set xr [expr {$xr+2}]
- set yt [expr {$yt-2}]
- set yb [expr {$yb+2}]
-
- $legendw create rectangle $xl $yt $xr $yb -fill $legend($w,background) \
- -outline $legend($w,border) -tag [list legendbg legendobj $w]
-
- $legendw raise legend
-
- if { $w == $legendw } {
- switch -- $legend($w,position) {
- "top-left" {
- set dx [expr { 10+$scaling($w,pxmin)-$xl}]
- set dy [expr { 10+$scaling($w,pymin)-$yt}]
- }
- "top-right" {
- set dx [expr {-10+$scaling($w,pxmax)-$xr}]
- set dy [expr { 10+$scaling($w,pymin)-$yt}]
- }
- "bottom-left" {
- set dx [expr { 10+$scaling($w,pxmin)-$xl}]
- set dy [expr {-10+$scaling($w,pymax)-$yb}]
- }
- "bottom-right" {
- set dx [expr {-10+$scaling($w,pxmax)-$xr}]
- set dy [expr {-10+$scaling($w,pymax)-$yb}]
- }
- }
- } else {
- set dx 10
- set dy 10
- }
-
- $legendw move "legend && $w" $dx $dy
- $legendw move "legendbg && $w" $dx $dy
-}
-
-# LegendAnchor --
-# Record the coordinates of the button press -
-# for moving the legend
-# Arguments:
-# w Name of the canvas
-# x X-coordinate
-# y Y-coordinate
-# Result:
-# None
-# Side effects:
-# X and Y stored
-#
-proc ::Plotchart::LegendAnchor { w x y } {
- variable legend
-
- set legend($w,move) 1
- set legend($w,xbutton) $x
- set legend($w,ybutton) $y
-}
-
-# LegendRelease --
-# Release the legend - it no longer moves
-# Arguments:
-# w Name of the canvas
-# Result:
-# None
-#
-proc ::Plotchart::LegendRelease { w } {
- variable legend
-
- set legend($w,move) 0
-}
-
-# LegendMove --
-# Move the legend objects
-# Arguments:
-# w Name of the canvas
-# x X-coordinate
-# y Y-coordinate
-# Result:
-# None
-# Side effects:
-# Legend moved
-#
-proc ::Plotchart::LegendMove { w x y } {
- variable legend
-
- if { $legend($w,move) } {
- set dx [expr {$x - $legend($w,xbutton)}]
- set dy [expr {$y - $legend($w,ybutton)}]
-
- $w move legendobj $dx $dy
-
- set legend($w,xbutton) $x
- set legend($w,ybutton) $y
- }
-}
-
-# DrawTimeaxis --
-# Draw the date/time-axis
-# Arguments:
-# w Name of the canvas
-# tmin Minimum date/time
-# tmax Maximum date/time
-# tstep Step size in days
-# Result:
-# None
-# Side effects:
-# Axis drawn in canvas
-#
-proc ::Plotchart::DrawTimeaxis { w tmin tmax tdelt } {
- variable scaling
- variable config
-
- set linecolor $config($w,bottomaxis,color)
- set textcolor $config($w,bottomaxis,textcolor)
- set textfont $config($w,bottomaxis,font)
- set thickness $config($w,bottomaxis,thickness)
- set ticklength $config($w,bottomaxis,ticklength)
- set justify $config($w,bottomaxis,justify)
- set offtick [expr {($ticklength > 0)? $ticklength+2 : 2}]
-
- #set scaling($w,tdelt) $tdelt
- set scaling($w,xdelt) $tdelt
-
- $w delete taxis
-
- $w create line $scaling($w,pxmin) $scaling($w,pymax) \
- $scaling($w,pxmax) $scaling($w,pymax) \
- -fill $linecolor -width $thickness -tag taxis
-
- set format $config($w,bottomaxis,format)
- if { [info exists scaling($w,-format,x)] } {
- set format $scaling($w,-format,x)
- }
-
- if { ! [string is double -strict $tmin] } {
- set ttmin [clock scan $tmin]
- set ttmax [clock scan $tmax]
- } else {
- set ttmin $tmin
- set ttmax $tmax
- }
-
- set t [expr {int($ttmin)}]
- set ttdelt [expr {$tdelt*86400.0}]
-
- set scaling($w,taxis) {}
-
- while { $t <= $ttmax } {
-
- foreach {xcrd ycrd} [coordsToPixel $w $t $scaling($w,ymin)] {break}
- set ycrd2 [expr {$ycrd+$ticklength}]
- set ycrd3 [expr {$ycrd+$offtick}]
-
- lappend scaling($w,taxis) $xcrd
-
- if { $format != "" } {
- set tlabel [clock format $t -format $format]
- } else {
- set tlabel [clock format $t -format "%Y-%m-%d"]
- }
- $w create line $xcrd $ycrd2 $xcrd $ycrd -tag taxis -fill $linecolor
- $w create text $xcrd $ycrd3 -text ...
[truncated message content] |