Tk Library Source Code

2024-06-03  Arjen Markus  <arjenmarkus@users,sourceforge.net>
        * plotconfig.tcl:  Add missing elements for 3dribbon plots (ticket 3d35a07f665b17987c9773cfa604b07d6d9b0cb7)
        * plotpriv.tcl:    Let the timechart methods return the canvas item IDs (ticket e8bf5556a856e0f56bfd0e12674339f3d09356ab)
        * plotannot.tcl:   Apply patch to long-standing bug regarding shaded vertical bars (ticket 34783217f723eb452634e7af7a1855d3e09b7fac)
        * plotaxis.tcl:    Introduce -locale option for time axis (ticket 55f89cf0be4fcdb002d3f96fc1ca8b351ccd1878)
        * plotchart.man:   Describe the new -locale option
        * pkgIndex.tcl:    Increase the version number to 2.6.2

2023-08-13  Arjen Markus  <arjenmarkus@users,sourceforge.net>
        * plotchart.tcl:   Correct the scaling for windrose plots (ticket 8df371ba8e)
        * pkgIndex.tcl:    Increase the version number to 2.6.1

2023-05-29  Arjen Markus  <arjenmarkus@users,sourceforge.net>
        * plotchart.man:   Describe the violin subcommand and dendrogram plots
        * plotchart.tcl:   Add the violin subcommand and the createDendrogram command

if {![package vsatisfies [package provide Tcl] 8.5-]} {
    # PRAGMA: returnok
    return
}
package ifneeded Plotchart 2.6.2 [list source [file join $dir plotchart.tcl]]
package ifneeded xyplot    1.0.1 [list source [file join $dir xyplot.tcl]]
package ifneeded plotanim    0.2 [list source [file join $dir plotanim.tcl]]

        set x2 $rxmax
    }

    set n 50
    if { $dir == "h" } {
        set nmax [expr {ceil($n*($rxmax-$rxmin)/double($pxmax-$pxmin))}]
    } else {
        set nmax [expr {ceil($n*($rymin-$rymax)/double($pymax-$pymin))}]
    }
    for { set i 0 } { $i < $nmax } { incr i } {
        set factor [expr {($first*$i+$last*($n-$i-1))/double($n)}]
        set gcolour [BrightenColour $colour $intensity $factor]

        if { $dir == "h" } {
            set x1     $x2
            set x2     [expr {$rxmin+($i+1)*$fac}]
            if { $i == $nmax-1 } {
                set x2 $rxmax
            }
        } else {
            set y1     $y2
            set y2     [expr {$rymin+$i*$fac}]
            if { $i == $nmax-1 } {
                set y2 $rymax
            }
        }

        $w create rectangle $x1 $y1 $x2 $y2 -fill $gcolour -outline $gcolour -tag {data background}
    }

    $w lower data

    set scaling($w,xaxis) {}

    set xs      {}
    set xts     {}
    set xbackup {}
    set numeric 1
    set gmt     0
    set locale  {}

    if { $xdelt eq {} } {
        set numeric 1

        foreach {arg val} $args {
            switch -exact -- $arg {
                -xlabels {

                    set numeric    2
                    set timeformat $val
                    set scaling($w,xdelt) $xdelt
                }
                -gmt {
                    set gmt $val
                }
                -locale {
                    set locale $val
                }
            }
        }
    }

    foreach x $xs xt $xts xb $xbackup {

        if { $numeric > 0 } {

            if { [string is double $xt] } {
                if { $numeric == 1 } {
                    set xlabel [format "%.12g" $xt]
                    if { $format != "" } {
                        set xlabel [FormatNumber $format $xt]
                    }
                } else {
                    set xlabel [clock format [expr {int($xt)}] -format $timeformat -gmt $gmt -locale $locale]
                }
            } else {
                set xlabel $xt
            }

            $w create line $xcrd $ycrd2 $xcrd $ycrd -tag [list xaxis $w] -fill $linecolor

[comment {-*- tcl -*- doctools manpage}]
[manpage_begin Plotchart n 2.6.2]
[copyright {2022 Arjen Markus <[email protected]>}]
[moddesc   Plotchart]
[titledesc {Simple plotting and charting package}]
[require Tcl [opt 8.5]]
[require Tk [opt 8.5]]
[require Plotchart [opt 2.6.2]]

[description]
[para]

Plotchart is a Tcl-only package that focuses on the easy creation of
xy-plots, barcharts and other common types of graphical presentations.
The emphasis is on ease of use, rather than flexibility. The procedures

[section "USING DATE/TIME LABELS"]
The options -timeformat and -gmt are used to control the display of date/time
labels along the x-axis for those plot types for which it makes sense. These
options were implemented to take care of date/time labels for stripcharts,
as you can also use custom labels (the option -xlabels) if the axis is "static".
Since this is not the case for stripcharts, this was not an option (Tcllib/Tklib bug 3613718).

You can also specify the -locale option to get a localised date/time label.

The example below illustrates how to use the -timeformat option. The -gmt option
merely suppresses the handling of daylight saving time by the [lb]clock format[rb] command.

[example {
package require Plotchart

pack [canvas .c -width 500 -bg white]

#
# Note that we need to present the x values as clock seconds
#
set start [clock scan  "0:00"]
set stop  [clock scan "10:00"]
set s [Plotchart::createStripchart .c [list $start $stop 7200] {0 10 1} -timeformat "%H:%M"]

# With a locale like "de":
#set s [Plotchart::createStripchart .c [list $start $stop 7200] {0 10 1} -timeformat "%H:%M" -locale de]

foreach {x y} {0 0 2 5 5 2 9 9 12 10} {
    set x [expr {$start + 3600 * $x}] ;# Convert hour to clock seconds
    $s plot a $x $y
}}]

The [emph plot] subcommand simply interprets the x and y data as straightforward
numbers, so that you need to do the conversion from date/time to "clock seconds" yourself.

   if { $xdelt eq {} || [lsearch $argv "-timeformat"] >= 0 } {
       set known_args {}
       foreach {arg val} [array get options] {
           switch -exact -- $arg {
               -xlabels    -
               -timeformat -
               -locale     -
               -gmt        {
                   lappend known_args $arg $val
               }
               -axesatzero -
               -isometric  -
               -ylabels    -
               -altylabels {

source [file join [file dirname [info script]] "plotobject.tcl"]
source [file join [file dirname [info script]] "plottable.tcl"]
source [file join [file dirname [info script]] "plotstatustimeline.tcl"]
source [file join [file dirname [info script]] "plotdendrogram.tcl"]

# Announce our presence
#
package provide Plotchart 2.6.2

        timechart     {title subtitle margin text legend leftaxis rightaxis bottomaxis background}
        stripchart    {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask}
        isometric     {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask}
        3dplot        {title subtitle margin text legend xaxis yaxis zaxis             background}
        3dbars        {title subtitle margin text legend leftaxis rightaxis bottomaxis background}
        radialchart   {title subtitle margin text legend leftaxis rightaxis bottomaxis background}
        txplot        {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask}
        3dribbon      {title subtitle margin text legend xaxis yaxis zaxis leftaxis rightaxis bottomaxis background}
        boxplot       {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask bar}
        windrose      {title subtitle margin text legend axis                          background}
        targetdiagram {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask limits}
        performance   {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask limits}
        table         {title subtitle margin background header oddrow evenrow cell frame leftaxis rightaxis bottomaxis}
        ternary       {title subtitle margin text legend axis leftaxis rightaxis bottomaxis background mask}
        distnormal    {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask}

   set xmin  [clock scan $time_begin]
   set xmax  [clock scan $time_end]
   set ybott [expr {$scaling($w,current)+$scaling($w,dy)}]

   foreach {x1 y1} [coordsToPixel $w $xmin $scaling($w,current)] {break}
   foreach {x2 y2} [coordsToPixel $w $xmax $ybott              ] {break}

   set items [$w create rectangle $x1 $y1 $x2 $y2 -fill $colour \
                  -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]]

   ReorderChartItems $w

   set scaling($w,current) [expr {$scaling($w,current)-1.0}]

   RescaleChart $w

   return $items
}

# DrawAdditionalPeriod --
#    Draw an additional period on the same level (no text)
# Arguments:
#    w           Name of the canvas
#    time_begin  Start time

   set xmin  [clock scan $time_begin]
   set xmax  [clock scan $time_end]
   set ybott [expr {$scaling($w,current)+$scaling($w,dy)}]

   foreach {x1 y1} [coordsToPixel $w $xmin $scaling($w,current)] {break}
   foreach {x2 y2} [coordsToPixel $w $xmax $ybott              ] {break}

   set items [$w create rectangle $x1 $y1 $x2 $y2 -fill $colour \
                  -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]]

   ReorderChartItems $w

   set scaling($w,current) [expr {$scaling($w,current)-1.0}]

   RescaleChart $w

   return $items
}

# DrawTimeVertLine --
#    Draw a vertical line with a label
# Arguments:
#    w           Name of the canvas
#    text        Text to identify the line

   #
   set xtime [clock scan $time]
   #set ytext [expr {$scaling($w,ymax)-0.5*$scaling($w,dy)}]
   set ytext $scaling($w,ymax)
   foreach {x y} [coordsToPixel $w $xtime $ytext] {break}
   set y [expr {$y-5}]

   lappend items [$w create text $x $y -text $text -anchor sw -tags [list $w horizscroll timeline]]

   #
   # Draw the line
   #
   foreach {x1 y1} [coordsToPixel $w $xtime $scaling($w,ymin)] {break}
   foreach {x2 y2} [coordsToPixel $w $xtime $scaling($w,ymax)] {break}

   lappend items [$w create line $x1 $y1 $x2 $y2 -fill $colour -tags [list $w horizscroll timeline tline]]

   $w raise topmask

   return $items
}

# DrawTimeMilestone --
#    Draw a "milestone"
# Arguments:
#    w           Name of the canvas
#    text        Text to identify the line

   #
   # Draw the text first
   #
   set ytext [expr {$scaling($w,current)+0.5*$scaling($w,dy)}]
   foreach {x y} [coordsToPixel $w $scaling($w,xmin) $ytext] {break}

   lappend items [$w create text 5 $y -text $text -anchor w \
                      -tags [list vertscroll above item_[expr {int($scaling($w,current))}]]]

   #
   # Draw an upside-down triangle to indicate the time
   #
   set xcentre [clock scan $time]
   set ytop    $scaling($w,current)
   set ybott   [expr {$scaling($w,current)+0.8*$scaling($w,dy)}]

   foreach {x1 y1} [coordsToPixel $w $xcentre $ybott] {break}
   foreach {x2 y2} [coordsToPixel $w $xcentre $ytop]  {break}

   set x2 [expr {$x1-0.4*($y1-$y2)}]
   set x3 [expr {$x1+0.4*($y1-$y2)}]
   set y3 $y2

   lappend items [$w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \
                      -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]]

   ReorderChartItems $w

   set scaling($w,current) [expr {$scaling($w,current)-1.0}]

   RescaleChart $w

   return $items
}

# DrawAdditionalMilestone --
#    Draw an additional "milestone"
# Arguments:
#    w           Name of the canvas
#    time        Time for which the milestone is drawn

   foreach {x1 y1} [coordsToPixel $w $xcentre $ybott] {break}
   foreach {x2 y2} [coordsToPixel $w $xcentre $ytop]  {break}

   set x2 [expr {$x1-0.4*($y1-$y2)}]
   set x3 [expr {$x1+0.4*($y1-$y2)}]
   set y3 $y2

   set items [$w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \
                  -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]]

   ReorderChartItems $w

   set scaling($w,current) [expr {$scaling($w,current)-1.0}]

   RescaleChart $w

   return $items
}

# ScaleItems --
#    Scale all items by a given factor
# Arguments:
#    w           Name of the canvas
#    xcentre     X-coordinate of centre