Artifact [5f2c7c2642]
Not logged in

Artifact 5f2c7c264280cf154c2ebbddf75251297d1e63f4:


###############################################################################
#
# graph.tcl
#
#  Copyright (C) 2017 Joerg Mehring, Bochum, DE, <j.mehring@sesam-gmbh.de>
#  All rights reserved. (BSD-3 license)
#
#  Redistribution and use in source and binary forms, with or without modification,
#  are permitted provided that the following conditions are met:
#
#  1. Redistributions of source code must retain the above copyright notice, this
#     list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright notice,
#     this list of conditions and the following disclaimer in the documentation
#     and/or other materials provided with the distribution.
#  3. Neither the name of the project nor the names of its contributors may be used
#     to endorse or promote products derived from this software without specific
#     prior written permission.
#
#  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
#  EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
#  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT
#  SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
#  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
#  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
#  BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
#  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
#  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
#
# Graph is a pure tcl library executing BLT (99% compatible) commands for 
# outputs other than the screen. It needs a driver to produce for example PDF
# output. Therefore you can use the package pdf4tcl::graph. It uses the pdf4tcl
# library to generate the output. The graph library itself only calls procedures
# like "Line", "Rect", "Arc", "Text" and "Pict". They have to do the real drawing
# job. Drivers exists for generating PostScript, PDF with pdf4tcl and also for
# the Debenu PDF Library (commercial).
#
# For an example of usage please have look at package pdf4tcl::graph.
#
###############################################################################

package provide graph 1.0


namespace eval graph {
  variable graph_idx -1
  variable marker_idx -1
  variable symbols
  variable graph
  variable graph_defaults
  variable element_defaults
  variable axis_defaults
  variable legend_defaults
  variable marker_defaults
  variable grid_defaults
  variable num_ticks 8
  # the output instance for the current PDF generating engine:
  variable graphOutInst {}

  array set graph_defaults {
    background      {239 239 239}
    borderwidth     0.2
    bottommargin    0
    font            {Helvetica 4}
    height          101
    justify         center
    leftmargin      0
    plotbackground  {255 255 255}
    plotborderwidth 0.1
    plotpadx        2.0
    plotpady        2.0
    plotrelief      solid
    relief          solid
    rightmargin     0
    title           ""
    topmargin       0
    width           127
    _elements       {}
    _axises         {}
    _markers        {}
    _margin         0.7
    _xaxis          x
    _yaxis          y
    _x2axis         x2
    _y2axis         y2
    _cliprect       {}
  }
  array set element_defaults {
    color           {0 0 128}
    barcommand      {}
    barwidth        0.9
    borderwidth     0.5
    dashes          {}
    data            {}
    fill            {0 0 128}
    hide            no
    label           {}
    linewidth       0.2
    mapx            x
    mapy            y
    outline         {0 0 0}
    outlinewidth    0.1
    pixels          2.75
    relief          raised
    smooth          linear
    symbol          circle
    symbolcommand   {}
    type            line
    xdata           {}
    ydata           {}
    _valid          no
    _xmin           0.0
    _xmax           1.0
    _ymin           0.0
    _ymax           1.0
  }
  array set axis_defaults {
    color           {0 0 0}
    command         {}
    descending      0
    hide            no
    justify         center
    linewidth       0.1
    logscale        no
    loose           yes
    majorticks      {}
    max             {}
    min             {}
    minorticks      {}
    rotate          0
    stepsize        0.0
    subdivisions    {}
    tickfont        {Helvetica 2.6}
    ticklength      2.5
    title           ""
    titlecolor      {0 0 0}
    titlefont       {Helvetica 4}
    _valid          no
    _width          {}
    _height         {}
    _format         %.15g
    _min            0.0
    _max            1.0
  }
  array set legend_defaults {
    anchor          n
    background      {239 239 239}
    borderwidth     0.2
    font            {Helvetica 2.6}
    foreground      {0 0 0}
    hide            no
    ipadx           0.5
    ipady           0.5
    padx            0.35
    pady            0.35
    position        right
    raised          no
    relief          sunken
  }
  array set marker_defaults {
    anchor          center
    coords          {}
    dashes          {}
    element         {}
    fill            {239 239 239}
    font            {Helvetica 2.6}
    hide            no
    image           {}
    justify         center
    linewidth       0.2
    mapx            x
    mapy            y
    name            {}
    outline         {0 0 0}
    padx            0.5
    pady            0.5
    rotate          0
    text            ""
    under           false
    xoffset         0
    yoffset         0
  }
  array set grid_defaults {
    color           {200 200 200}
    dashes          {}
    hide            yes
    linewidth       0.1
    mapx            x
    mapy            y
    minor           yes
  }
  array set symbols {}
  
  array set opt_defaults {
    linewidth   0.1
    rgbcolor    {255 255 255}
    dashpattern {}
    picts       {}
    rotation    0
    xpos        0
    ypos        0
    font        {Helvetica 4 {}}
  }
}

###############################################################################
#
# basic glue routines to combine drawing engine with graph calls
#

proc graph::graph { args } {
  return [graph_proc $args]
}


proc graph::get_opt { g optName } {
  variable graph
  
  return $graph($g,opts,$optName)
}


proc graph::set_opt { g optName value } {
  variable graph
  
  set graph($g,opts,$optName) $value
}


proc graph::append_opt { g optName value } {
  variable graph
  
  lappend graph($g,opts,$optName) $value
}


proc graph::setup { engine instance } {
  variable graphOutInst
  
  set graphOutInst $instance
  
  namespace import ::${engine}::graph::*
}


proc graph::execute {args} {
  variable graphOutInst

  return [$graphOutInst {*}$args]
}


###############################################################################
#
# graph proc called by graph
#

proc graph::graph_proc { params } {
  variable graph_idx
  variable graph
  variable opt_defaults

  init_symbols

  set g g[incr graph_idx]

  obj_defaults  $g graph_defaults
  obj_configure $g $params

  axis $g create x
  axis $g create {x2 -hide 1}
  axis $g create y
  axis $g create {y2 -hide 1}

  obj_defaults $g,legend legend_defaults
  obj_defaults $g,grid   grid_defaults  
  obj_defaults $g,opts   opt_defaults

  proc ::graph::$g {command args} "command $g \$command \$args"

  return ::graph::$g
}

###############################################################################
#
# graph command proc (configure, cget, element, axis, etc.)
#

proc graph::command { g command params } {
  variable graph

  switch -- $command {
    configure {
      obj_configure $g $params
    }
    cget {
      return [obj_cget $g [lindex $params 0]]
    }
    draw {
      draw $g [lindex $params 0] [lrange $params 1 end]
    }
    element {
      element $g [lindex $params 0] [lrange $params 1 end]
    }
    axis {
      axis $g [lindex $params 0] [lrange $params 1 end]
    }
    xaxis - yaxis - x2axis - y2axis {
      return [axisusage $g $command $params]
    }
    legend {
      legend $g [lindex $params 0] [lrange $params 1 end]
    }
    marker {
      marker $g [lindex $params 0] [lrange $params 1 end]
    }
    grid {
      grid $g [lindex $params 0] [lrange $params 1 end]
    }
    destroy {
      rename ::graph::$g {}
      array unset graph $g,*
    }
    default {
      return -code error "unknown command \"$command\""
    }
  }
}

###############################################################################
#
# some utilities for internal use only
#

proc graph::init_symbols {} {
  variable symbols

  if {[array size symbols] > 0} return

  array set symbols {
    square   { {-1.0  1.0  1.0 -1.0 -1.0}
               {-1.0 -1.0  1.0  1.0 -1.0} }
    plus     { {-1.0 -0.3 -0.3  0.3  0.3  1.0  1.0  0.3  0.3 -0.3 -0.3 -1.0 -1.0}
               {-0.3 -0.3 -1.0 -1.0 -0.3 -0.3  0.3  0.3  1.0  1.0  0.3  0.3 -0.3} }
    splus    { {-1.0 -0.1 -0.1  0.1  0.1  1.0  1.0  0.1  0.1 -0.1 -0.1 -1.0 -1.0}
               {-0.1 -0.1 -1.0 -1.0 -0.1 -0.1  0.1  0.1  1.0  1.0  0.1  0.1 -0.1} }
    triangle { {-1.1  1.1  0.0 -1.1}
               {-1.0 -1.0  1.0 -1.0} }
  }  

  # create some symbols by turning others by 45 degrees
  set sc45 0.707106781185	;# sin/cos 45 degrees
  foreach {src dst} {square diamond  plus cross     splus scross  triangle arrow0  
                     arrow0 arrow1   arrow1 arrow2  arrow2 arrow  } {
    foreach {px py} $symbols($src) {}
    set lx {}
    set ly {}
    foreach x $px y $py {
      lappend lx [expr {($x - $y) * $sc45}]
      lappend ly [expr {($x + $y) * $sc45}]
    }
    set symbols($dst) [list $lx $ly]
  }
  
  # create a circle with a 20-edge (18 degrees):
  #
  # set lx {}
  # set ly {}
  # for {set angle 0} {$angle <= 360} {incr angle 18} {
  #   lappend lx [expr {1.2 * sin(0.0174532925199 * $angle)}]
  #   lappend ly [expr {1.2 * cos(0.0174532925199 * $angle)}]
  # }
  # set symbols(circle) [list $lx $ly]
}


proc graph::draw_symbol { g x0 y0 symbol size fillcolor outlinecolor } {
  variable symbols

  if {$symbol == {} || $symbol == "none" || $size == 0} return

  if {$symbol == "circle"} {
    SetColor $g $outlinecolor
    Arc $g $x0 $y0 [expr {1.2 * $size}] 0 360 $fillcolor
    return
  }

  if {[regexp {^@(.+)$} $symbol all pname]} {
    if {[PictSize $g $pname] == {}} {
      LoadPict $g $pname
    }
    if {[set psize [PictSize $g $pname]] == {}} return
    foreach {dx dy} $psize {}
    set x [expr {$x0 - $dx / 2.0}]
    set y [expr {$y0 - $dy / 2.0}]
    Pict $g $x $y $pname
    return
  }

  if {![info exists symbols($symbol)]} return

  foreach {lx ly} $symbols($symbol) {}
  set px {}
  set py {}
  foreach x $lx y $ly {
    lappend px [expr {$x0 + $x * $size}]
    lappend py [expr {$y0 + $y * $size}]
  }
  PolyObject $g [list $px $py] [GetRGB $fillcolor]
  if {$outlinecolor != {}} {
    SetColor $g $outlinecolor
    PolyObject $g [list $px $py]
  }
}


proc graph::transform { x a b c d {log no} } {
  if {$log} { set x [expr {($x > 0.0)? log10($x) : $a}] }
  return [expr {$c + ($d - $c) * ($x - $a) / ($b - $a)}]
}


proc graph::set_linewidth { g width } {
  variable graph

  set org_linewidth [get_opt $g linewidth]
  set_opt $g linewidth $width
  return $org_linewidth
}


proc graph::calc_box { dx dy angle v_box_w v_box_h } {
  upvar $v_box_w box_w
  upvar $v_box_h box_h

  if {$angle == 0} {
    set box_w $dx
    set box_h $dy
    return
  }
  set alpha [expr {0.01745329252 * $angle}]
  set sin_alpha [expr {sin($alpha)}]
  set cos_alpha [expr {cos($alpha)}]
  set box_w [expr {$dy * $sin_alpha + $dx * $cos_alpha}]
  set box_h [expr {$dy * $cos_alpha + $dx * $sin_alpha}]
  return [expr {sqrt($box_w * $box_w + $box_h * $box_h)}]
}


proc graph::swap { v_a v_b } {
  upvar $v_a a
  upvar $v_b b

  set tmp $a; set a $b; set b $tmp
}


proc graph::turn_vector { v_x v_y x0 y0 xr yr angle } {
  upvar $v_x x
  upvar $v_y y
  set alpha [expr {0.01745329252 * $angle}]
  set sin_a [expr {sin($alpha)}]
  set cos_a [expr {cos($alpha)}]
  set x [expr {$x0 + $xr * $cos_a - $yr * $sin_a}]
  set y [expr {$y0 + $xr * $sin_a + $yr * $cos_a}]
}


proc graph::text_rot { g txt xc yc tw th angle } {
  set dx [expr {-0.5 * $tw}]
  set dy [expr {-0.3 * $th}]
  if {$angle != 0} {
    turn_vector x y $xc $yc $dx $dy $angle
    Text $g $x $y $txt rotate $angle
  } else {
    set x [expr {$xc + $dx}]
    set y [expr {$yc + $dy}]
    Text $g $x $y $txt
  }
}


proc graph::draw_frame { g x_left y_top x_right y_bottom background relief borderwidth } {
  if {$borderwidth > 0} {
    set bgc [GetRGB $background]
    if {$y_top < $y_bottom} { swap y_top y_bottom }
    if {$x_right < $x_left} { swap x_left x_right }
    set xl [expr {$x_left   + $borderwidth}]
    set xr [expr {$x_right  - $borderwidth}]
    set yt [expr {$y_top    - $borderwidth}]
    set yb [expr {$y_bottom + $borderwidth}]
    switch $relief {
      sunken {
	set color [rgbdarken $bgc 35]
	PolyObject $g [list [list $x_left   $x_left $x_right $xr $xl $xl $x_left  ] \
			 [list $y_bottom $y_top  $y_top   $yt $yt $yb $y_bottom]] $color
	set color [rgblighten $bgc 35]
	PolyObject $g [list [list $x_left   $x_right  $x_right $xr $xr $xl $x_left  ] \
			 [list $y_bottom $y_bottom $y_top   $yt $yb $yb $y_bottom]] $color
      }
      raised {
	set color [rgblighten $bgc 35]
	PolyObject $g [list [list $x_left   $x_left $x_right $xr $xl $xl $x_left  ] \
			 [list $y_bottom $y_top  $y_top   $yt $yt $yb $y_bottom]] $color
	set color [rgbdarken $bgc 35]
	PolyObject $g [list [list $x_left   $x_right  $x_right $xr $xr $xl $x_left  ] \
			 [list $y_bottom $y_bottom $y_top   $yt $yb $yb $y_bottom]] $color
      }
      solid {
	Rect $g $xr     $y_bottom $x_right $y_top black
	Rect $g $x_left $yt       $x_right $y_top black
	Rect $g $x_left $y_bottom $xl      $y_top black
	Rect $g $x_left $y_bottom $x_right $yb    black
      }
      default {
        # nix
      }
    }
  }
}


proc graph::obj_defaults { index defaults_name } {
  upvar #0 graph::$defaults_name defaults
  variable graph

  foreach item [array names defaults] {
    set graph($index,$item) $defaults($item)
  }
}


proc graph::obj_configure { index params } {
  variable graph

  foreach {name value} $params {
    if {[regexp {^\-(\w+)$} $name all option]} {
      if {[info exists graph($index,$option)]} {
	set graph($index,$option) $value
      } else {
        return -code error "unknown option \"$option\""
      }
    } else {
      return -code error "syntax error in option \"$option\""
    }
  }
}


proc graph::obj_cget { index option } {
  variable graph

  regexp {^\-(\w+)$} $option all option
  if {[info exists graph($index,$option)]} {
    return $graph($index,$option)
  } else {
    return -code error "unknown option \"$option\""
  }
}


proc graph::obj_names { index {params *} } {
  variable graph

  if {$params == "*"} {
    return $graph($index)
  }
  set lst {}
  foreach item $graph($index) {
    foreach pattern $params {
      if {[string match $pattern $item]} {
	lappend lst $name
	break
      }
    }
  }
  return $lst
}


proc graph::obj_delete { itemindex listindex params } {
  variable graph

  foreach name $params {
    if {[set idx [lsearch -exact $graph($itemindex) $name]] != -1} {
      array unset graph $listindex-$name,*
      set graph($itemindex) [lreplace $graph($itemindex) $idx $idx]
    }
  }
}

###############################################################################
#
# element components
#

proc graph::element { g operation params } {
  variable graph

  switch -- $operation {
    create {
      set name [lindex $params 0]
      set index $g,elem-$name
      obj_defaults  $index element_defaults
      set graph($index,label) $name
      element $g configure $params
      lappend graph($g,_elements) $name
    }
    configure {
      set name [lindex $params 0]
      set index $g,elem-$name
      obj_configure $index [lrange $params 1 end]
      set calc no
      if {[lsearch -exact $params "-data"] != -1} {
        set graph($index,xdata) {}
        set graph($index,ydata) {}
      }
      if {[lsearch -exact $params "-xdata"] != -1 || 
          [lsearch -exact $params "-ydata"] != -1   } {
        set graph($index,data) {}
	set calc yes
      }
      set graph($index,_valid) no
      axis_invalidate $g
    }
    cget {
      set name [lindex $params 0]
      return [obj_cget $g,elem-$name [lindex $params 1]]
    }
    delete {
      obj_delete $g,_elements $g,elem $params
      axis_invalidate $g
    }
    exists {
      set name [lindex $params 0]
      return [info exists graph($g,elem-$name,label)]
    }
    names {
      if {$params == {}} { set params * }
      return [obj_names $g,_elements $params]
    }
    type {
      set name [lindex $params 0]
      return $graph($g,elem-$name,type)
    }
    bardata {
      set values [lindex $params 0]
      set min    [lindex $params 1]
      set max    [lindex $params 2]
      set clcnt  [lindex $params 3]
      set scale  [lindex $params 4]
      return [data_to_bar_values $values $min $max $clcnt $scale]
    }
    default {
      return -code error "unknown operation \"$operation\""
    }
  }
}


proc graph::is_var_ref { varname } {
  upvar $varname var
  if {[llength $var] == 1 &&
      [regexp {^[a-zA-Z_]} $var] &&
      [info exists ::$var]} {
    return yes
  }
  return no
}


proc graph::elem_calc { g name } {
  variable graph

  set index $g,elem-$name
  set x_min 1e300
  set x_max -1e300
  set y_min 1e300
  set y_max -1e300
  if {$graph($index,data) != {}} {
    if {[is_var_ref graph($index,data)]} {
      upvar #0 $graph($index,data) xydata
    } else {
      upvar 0 graph($index,data) xydata
    }
    foreach {x y} $xydata {
      if {$x > $x_max} { set x_max $x }
      if {$x < $x_min} { set x_min $x }
      if {$y > $y_max} { set y_max $y }
      if {$y < $y_min} { set y_min $y }
    }
  } else {
    if {[is_var_ref graph($index,xdata)]} {
      upvar #0 $graph($index,xdata) xdata
    } else {
      upvar 0 graph($index,xdata) xdata
    }
    if {$xdata != {}} {
      foreach x $xdata {
	if {$x > $x_max} { set x_max $x }
	if {$x < $x_min} { set x_min $x }
      }
    }
    if {[is_var_ref graph($index,ydata)]} {
      upvar #0 $graph($index,ydata) ydata
    } else {
      upvar 0 graph($index,ydata) ydata
    }
    if {$ydata != {}} {
      foreach y $ydata {
	if {$y > $y_max} { set y_max $y }
	if {$y < $y_min} { set y_min $y }
      }
    }
  }
  if {$x_min > $x_max} {
    set graph($index,_xmin) 0.0
    set graph($index,_xmax) 1.0
  } else {
    set graph($index,_xmin) $x_min
    set graph($index,_xmax) $x_max
  }
  if {$y_min > $y_max} {
    set graph($index,_ymin) 0.0
    set graph($index,_ymax) 1.0
  } else {
    set graph($index,_ymin) $y_min
    set graph($index,_ymax) $y_max
  }
  if {$graph($index,label) == ""} {
    set graph($index,_title) $name
  } else {
    set graph($index,_title) $graph($index,label)
  }
  set graph($index,_valid) yes
}


proc graph::elem_draw { g elem xl_graph yt_graph xr_graph yb_graph } {
  variable graph

  set index $g,elem-$elem

  set mapx $graph($index,mapx)
  set mapy $graph($index,mapy)

  set x_min $graph($g,axis-$mapx,_min)
  set x_max $graph($g,axis-$mapx,_max)
  set x_log $graph($g,axis-$mapx,logscale)
  set y_min $graph($g,axis-$mapy,_min)
  set y_max $graph($g,axis-$mapy,_max)
  set y_log $graph($g,axis-$mapy,logscale)

  set type      $graph($index,type)
  set linewidth $graph($index,linewidth)
  set symbol    $graph($index,symbol)
  set symbolcmd $graph($index,symbolcommand)
  set color     $graph($index,color)
  set outlcolor $graph($index,outline)
  set outlwidth $graph($index,outlinewidth)
  set fillcolor $graph($index,fill)
  set dashes    $graph($index,dashes)
  set smooth    $graph($index,smooth)
  set symsize   $graph($index,pixels)
  set symsize_2 [expr {$symsize / 2.0}]

  set x_points {}
  set y_points {}

  if {$graph($index,data) != {}} {
    if {[is_var_ref graph($index,data)]} {
      upvar #0 $graph($index,data) xydata
    } else {
      upvar 0 graph($index,data) xydata
    }
    set count 0
    foreach {x y} $xydata {
      lappend x_points [transform $x $x_min $x_max $xl_graph $xr_graph $x_log]
      lappend y_points [transform $y $y_min $y_max $yb_graph $yt_graph $y_log]
      incr count
    }
  } else {
    if {[is_var_ref graph($index,xdata)]} {
      upvar #0 $graph($index,xdata) xdata
    } else {
      upvar 0 graph($index,xdata) xdata
    }
    if {[is_var_ref graph($index,ydata)]} {
      upvar #0 $graph($index,ydata) ydata
    } else {
      upvar 0 graph($index,ydata) ydata
    }
    if {$xdata != {} && $ydata != {}} {
      set count 0
      foreach x $xdata y $ydata {
	lappend x_points [transform $x $x_min $x_max $xl_graph $xr_graph $x_log]
	lappend y_points [transform $y $y_min $y_max $yb_graph $yt_graph $y_log]
	incr count
      }
    } else {
      set count [llength $ydata]
      set x 1
      foreach y $ydata {
	lappend x_points [transform $x 1      $count $xl_graph $xr_graph $x_log]
	lappend y_points [transform $y $y_min $y_max $yb_graph $yt_graph $y_log]
	incr x
      }
    }
  }
  if {$count == 0} return

  if {$type == "bar"} {
    SetColor $g     $color
    SetLinewidth $g $linewidth

    set rel $graph($index,relief)
    set baw $graph($index,barwidth)
    set cmd $graph($index,barcommand)
    set bdw $graph($index,borderwidth)
    set dx  [expr {$baw * ($xr_graph - $xl_graph) / ($count +1)}]
    set dx2 [expr {$dx / 2.0}]
    set y0  [transform 0 $y_min $y_max $yb_graph $yt_graph]
    set idx 0
    foreach x $x_points y $y_points {
      set xl [expr {$x - $dx2}]
      set xr [expr {$x + $dx2}]
      if {$y >= $y0} {
	set yt $y
	set yb $y0
	if {$yt - $yb < 2 * $bdw} {
	  set yt [expr {$yb + 2 * $bdw}]
	}
      } else {
	set yt $y0
	set yb $y
	if {$yt - $yb < 2 * $bdw} {
	  set yb [expr {$yb - 2 * $bdw}]
	}
      }
      if {$cmd != {}} {
	$cmd $idx [lindex $ydata $idx] $xl $yt $xr $yb $fillcolor $rel $bdw
      } else {
	Rect $g $xl $yt $xr $yb $fillcolor
	draw_frame $g $xl $yt $xr $yb $fillcolor $rel $bdw
      }
      incr idx
    }
    return
  }

  if {$type == "line"} {
    SetColor $g     $color
    SetLinewidth $g $linewidth
    SetDash $g      $dashes

    if {$linewidth != {} && $linewidth > 0.0} {
      switch $smooth {
	step {
	  set x_points2 {}
	  set y_points2 {}
	  set last_y {}
	  foreach x $x_points y $y_points {
	    if {$last_y != {}} {
	      lappend x_points2 $x
	      lappend y_points2 $last_y
	    }
	    lappend x_points2 $x
	    lappend y_points2 $y
	    set last_y $y
	  }
	  PolyObject $g [list $x_points2 $y_points2]
	}
	natural - quadratic {
	  MakeSplineData x_points y_points x_points2 y_points2
	  PolyObject $g [list $x_points2 $y_points2]
	}
	default {
	  PolyObject $g [list $x_points $y_points]
	}
      }
    }
    SetDash $g {}

    if {$symbol == {} || $symbol == "none" || $symsize == 0} return

    SetLinewidth $g $outlwidth
    foreach x0 $x_points y0 $y_points {
      if {$symbolcmd != {}} {
	set name    $symbol
	set size    $symsize_2
	set fill    $fillcolor
	set outline $outlcolor
	eval "$symbolcmd $x0 $y0 name size fill outline"
	draw_symbol $g $x0 $y0 $name $size $fill $outline
      } else {
	draw_symbol $g $x0 $y0 $symbol $symsize_2 $fillcolor $outlcolor
      }
    }
    return
  }

  return -code error "unknown element type \"$type\""
}


proc graph::data_to_bar_values { values min max clcnt {scale 1.0} } {
  if {[is_var_ref values]} {
    upvar #0 $values data
  } else {
    upvar 0 values data
  }

  set count [llength $data]
  set range [expr {$max - $min}]
  set clmax [expr {$clcnt -1}]
  set delta [expr {$range / $clcnt}]
  array set classes {}
  for {set class 0} {$class < $clcnt} {incr class} {
    set classes($class) 0
  }
  foreach val $data {
    set class [expr {round($clcnt * ($val - $min) / $range)}]
    if {$class <      0} { set class      0 }
    if {$class > $clmax} { set class $clmax }
    incr classes($class)
  }
  set clvals {}
  set bars {}
  set value $min
  for {set class 0} {$class < $clcnt} {incr class} {
    lappend clvals $value
    set value [expr {$value + $delta}]
    lappend bars [expr {$scale * $classes($class) / $count}]
  }
  return [list $clvals $bars $delta]
}

###############################################################################
#
# axis components
#

proc graph::axis { g operation params } {
  variable graph

  switch -- $operation {
    create {
      set name [lindex $params 0]
      obj_defaults  $g,axis-$name axis_defaults
      axis $g configure $params
      lappend graph($g,_axises) $name
    }
    configure {
      set name [lindex $params 0]
      obj_configure $g,axis-$name [lrange $params 1 end]
      foreach item {min max} {
	if {$graph($g,axis-$name,$item) != {}} {
	  set graph($g,axis-$name,_$item) $graph($g,axis-$name,$item)
	}
      }
    }
    cget {
      set name [lindex $params 0]
      return [obj_cget $g,axis-$name [lindex $params 1]]
    }
    delete {
      obj_delete $g,_axises $g,axis $params
    }
    names {
      if {$params == {}} { set params * }
      return [obj_names $g,_axises $params]
    }
    default {
      return -code error "unknown operation \"$operation\""
    }
  }
}


proc graph::axisusage { g axisplace params } {
  variable graph

  # example moving the x-axis to the right side: $g x2axis use x
  if {[lindex $params 0] != "use"} {
    return -code error "invalid command \"$params\" to $axisplace"
  }
  set alist [lrange $params 1 end]
  if {[llength $alist] == 1} { set alist [lindex $params 1] }
  foreach axis $alist {
    if {[lsearch {xaxis yaxis x2axis y2axis} $axisplace] == -1} {
      return -code error "unknown axis place \"$axisplace\""
    }
    if {$axis != {}} {
      foreach place {xaxis yaxis x2axis y2axis} {
	if {[set idx [lsearch $graph($g,_$place) $axis]] != -1} {
	  set graph($g,_$place) [lreplace $graph($g,_$place) $idx $idx]
	}
      }
      lappend graph($g,_$axisplace) $axis
    }
  }
  return $graph($g,_$axisplace)
}


proc graph::axis_getplace { g name } {
  variable graph

  foreach place {xaxis yaxis x2axis y2axis} {
    if {[lsearch $graph($g,_$place) $name] != -1} {
      return $place
    }
  }
}


# Reference: Paul Heckbert "Nice Numbers for Graph Labels", Graphics Gems, pp 61-63
proc graph::nicenum { x round } {
  set expt [expr {floor(log10($x))}]
  set frac [expr {$x / pow(10,$expt)}]
  if {$round} {
    if {$frac < 1.5} {
      set nice 1.0
    } elseif {$frac < 3.0} {
      set nice 2.0
    } elseif {$frac < 7.0} {
      set nice 5.0
    } else {
      set nice 10.0
    }
  } else {
    if {$frac < 1.0} {
      set nice 1.0
    } elseif {$frac < 2.0} {
      set nice 2.0
    } elseif {$frac < 5.0} {
      set nice 5.0
    } else {
      set nice 10.0
    }
  }
  set val [expr {$nice * pow(10,$expt)}]
  return $val
}


# Reference: BLT bltGrAxis.c LogScaleAxis()
proc graph::axis_logscale { index min max } {
  variable graph
  variable num_ticks

  if {$graph($index,min) != {}} { set min $graph($index,min) }
  if {$graph($index,max) != {}} { set max $graph($index,max) }

  set min [expr {($min != 0.0)? log10(abs($min)) : 0.0}]
  set max [expr {($max != 0.0)? log10(abs($max)) : 1.0}]

  set nMajor 0; set nMinor 0
  set majorStep 0.0; set minorStep 0.0

  set tickMin [expr {floor($min)}]
  set tickMax [expr {ceil($max)}]
  set range [expr {$tickMax - $tickMin}]

  if {$range > 10} {
    set range [nicenum $range no]
    set majorStep [nicenum [expr {$range / double($num_ticks)}] yes]
    set tickMin [expr {floor($tickMin / $majorStep) * $majorStep}]
    set tickMax [expr {ceil($tickMax / $majorStep) * $majorStep}]
    set nMajor [expr {int(($tickMax - $tickMin) / $majorStep) +1}]
    set minorStep [expr {pow(10, floor(log10($majorStep)))}]
    if {$minorStep == $majorStep} {
      set nMinor 4
      set minorStep 0.2
    } else {
      set nMinor [expr {round($majorStep  / $minorStep) -1}]
    }
  } else {
    if {$tickMin == $tickMax} { incr tickMax }
    set majorStep 1.0
    set nMajor [expr {int($tickMax - $tickMin +1)}]
    set minorStep 0.0
    set nMinor 10
  }

  if {$graph($index,loose)} {
    set graph($index,_min) $min
    set graph($index,_max) $max
  } else {
    set graph($index,_min) $tickMin
    set graph($index,_max) $tickMax
  }
  set graph($index,_step)  $majorStep
  set graph($index,_first) [expr {floor($tickMin)}]
  set graph($index,_range) [expr {$graph($index,_max) - $graph($index,_min)}]
  set graph($index,_steps) $nMajor
}


# Reference: BLT bltGrAxis.c LinearScaleAxis()
proc graph::axis_linearscale { index min max } {
  variable graph
  variable num_ticks

  if {$graph($index,min) != {}} { set min $graph($index,min) }
  if {$graph($index,max) != {}} { set max $graph($index,max) }

  set nTicks 0
  set tickMin 0.0
  set tickMax 0.0
  set range [expr {$max - $min}]

  # Calculate the major tick stepping.
  if {$graph($index,stepsize) > 0.0} {
    set step $graph($index,stepsize)
    while {2 * $step >= $range} {
      set step [expr {$step * 0.5}]
    }
  } else {
    set range [nicenum $range no]
    set step  [nicenum [expr {$range / double($num_ticks)}] yes]
  }
  set graph($index,_step) $step

  # Find the outer tick values.
  set tickMin [expr {floor($min / $step) * $step}]
  set tickMax [expr {ceil($max / $step) * $step}]

  if {$graph($index,loose)} {
    set graph($index,_min) $min
    set graph($index,_max) $max
  } else {
    set graph($index,_min) $tickMin
    set graph($index,_max) $tickMax
  }
  set graph($index,_first) $tickMin
  set graph($index,_range) [expr {$graph($index,_max) - $graph($index,_min)}]
  set graph($index,_steps) [expr {round(($tickMax - $tickMin) / $step) +1}]
}


proc graph::axis_calc { g name } {
  variable graph

  set index $g,axis-$name
  set place [axis_getplace $g $name]
  set graph($index,_place) $place
  if {$place == {}} return

  switch $place {
    xaxis - x2axis { set orient horizontal; set minitem _xmin; set maxitem _xmax }
    yaxis - y2axis { set orient vertical;   set minitem _ymin; set maxitem _ymax }
  }

  set min 1e300
  set max -1e300
  set bargraph false
  foreach elem $graph($g,_elements) {
    if {$graph($g,elem-$elem,_valid)} {
      set val $graph($g,elem-$elem,$minitem)
      if {$val < $min} { set min $val }
      set val $graph($g,elem-$elem,$maxitem)
      if {$val > $max} { set max $val }
      if {$graph($g,elem-$elem,type) == "bar"} {
	set bargraph true
	if {$orient == "horizontal"} {
	  set min [expr {$min - 0.5}]
	  set max [expr {$max + 0.5}]
	}
      }
    }
  }
  if {$graph($index,min) != {}} { set min $graph($index,min) }
  if {$graph($index,max) != {}} { set max $graph($index,max) }

  if {$min == $max} return

  if {$min > $max} { set min 0.0; set max 1.0 }

  if {$bargraph} {
    if {$orient == "horizontal"} {
      if {$graph($index,stepsize) == 0.0} {
	set graph($index,stepsize) 1.0
      }
      if {$graph($index,subdivisions) == {}} {
	set graph($index,subdivisions) 1
      }
    }
    if {$orient == "vertical"} {
      if {$graph($index,min) == {} && $min > 0.0} {
	set graph($index,min) 0.0
      }
      if {$graph($index,max) == {} && $max < 0.0} {
	set graph($index,max) 0.0
      }
    }
  }

  set logscale $graph($index,logscale)
  if {$logscale} {
    axis_logscale $index $min $max
  } else {
    axis_linearscale $index $min $max
  }
  
  set step       $graph($index,_step)
  set steps      $graph($index,_steps)
  set first      $graph($index,_first)
  set format     $graph($index,_format)
  set angle      $graph($index,rotate)
  set majorticks $graph($index,majorticks)
  set value      $first

  if {$graph($index,hide)} {
    set graph($index,_width)  0
    set graph($index,_height) 0
  } else {
    if {$graph($index,title) != ""} {
      foreach {font size attr} $graph($index,titlefont) {}
      SetFont $g $font $size $attr
      set margin1 0.25
      set title_h [expr {[LineHeight] + $margin1}]
    } else {
      set title_h 0
    }

    foreach {font size attr} $graph($index,tickfont) {}
    SetFont $g $font $size $attr

    set dy [LineHeight]
    set box_h 0; set box_w 0
    set max_h 0; set max_w 0
    set graph($index,_txts) {}

    if {$majorticks == {}} {
      for {set idx 0} {$idx < $steps} {incr idx} {
	if {$graph($index,command) != {}} {
	  set txt [eval "$graph($index,command) $g $value"]
	} else {
	  if {$logscale} {
	    set txt [format $format [expr {pow(10,round($value))}]]
	  } else {
	    set txt [format $format $value]
	  }
	}
	set dx [TextWidth $txt]
	set size [calc_box $dx $dy $angle box_w box_h]
	lappend graph($index,_txts) [list $txt $dx $dy $box_w $box_h $size]
	set box_w [expr {abs($box_w)}]
	set box_h [expr {abs($box_h)}]
	if {$box_w > $max_w} { set max_w $box_w }
	if {$box_h > $max_h} { set max_h $box_h }
	set value [expr {$value + $step}]
      }
    } else {
      foreach value $majorticks {
	if {$graph($index,command) != {}} {
	  set txt [eval "$graph($index,command) $g $value"]
	} else {
	  set txt [format $format $value]
	}
	set dx [TextWidth $txt]
	set size [calc_box $dx $dy $angle box_w box_h]
	lappend graph($index,_txts) [list $txt $dx $dy $box_w $box_h $size]
	set box_w [expr {abs($box_w)}]
	set box_h [expr {abs($box_h)}]
	if {$box_w > $max_w} { set max_w $box_w }
	if {$box_h > $max_h} { set max_h $box_h }
      }
    }

    set graph($index,_width)  $max_w
    set graph($index,_height) $max_h
    set ticklen $graph($index,ticklength)
    set margin2 0.35
    if {$orient == "horizontal"} {
      set graph($index,_height) [expr {$max_h + $ticklen + $margin2 + $title_h}]
    } else {
      set graph($index,_width) [expr {$max_w + $ticklen + $margin2 + $title_h}]
    }
  }
  set graph($index,_valid) yes
}



proc graph::axis_draw_tick { g axis value min max p1 p2 tick1 tick2 margin
                                      ticktxt angle dogrid_major
				      grid_color grid_linew grid_dashes p3 p4 } {
  switch $axis {
    x  - y  { set factor -1 }
    x2 - y2 { set factor  1 }
  }
  switch $axis {
    x - x2 {
      set x [transform $value $min $max $p1 $p2]
      if {$x >= $p1 && $x <= $p2} {
	Line $g $x $tick1 $x $tick2
	foreach {txt tw th bw bh size} $ticktxt {}
	set xc $x
	set yc [expr {$tick2 + $factor * ($margin + 0.5 * abs($bh))}]
	text_rot $g $txt $xc $yc $tw $th $angle
	if {$dogrid_major} {
	  gridline $g $grid_color $grid_linew $grid_dashes $x $p3 $x $p4
	}
      }
    }
    y - y2 {
      set y [transform $value $min $max $p1 $p2]
      if {$y >= $p1 && $y <= $p2} {
	Line $g $tick1 $y $tick2 $y
	foreach {txt tw th bw bh size} $ticktxt {}
	set xc [expr {$tick2 + $factor * ($margin + 0.5 * abs($bw))}]
	set yc $y
	text_rot $g $txt $xc $yc $tw $th $angle
	if {$dogrid_major} {
	  gridline $g $grid_color $grid_linew $grid_dashes $p3 $y $p4 $y
	}
      }
    }
  }
}


proc graph::axis_draw_subticks { g axis val div interval step min max p1 p2
                                          logscale tick1 tick3 dogrid_minor
				          grid_color grid_linew grid_dashes
				          minorticks p3 p4 } {
  if {$logscale} {
    set step [expr {10 * $step * pow(10,$val)}]
    set val  0
  }
  switch $axis {
    x - x2 {
      if {$minorticks == {}} {
	for {set subidx 1} {$subidx < $div} {incr subidx} {
	  set val [expr {$val + $step}]
	  set x [transform $val $min $max $p1 $p2 $logscale]
	  if {$x >= $p1 && $x <= $p2} {
	    Line $g $x $tick1 $x $tick3
	    if {$dogrid_minor} {
	      gridline $g $grid_color $grid_linew $grid_dashes $x $p3 $x $p4
	    }
	  }
	}
      } else {
        foreach minorval $minorticks {
	  set x [transform [expr {$val+$minorval*$interval}] $min $max $p1 $p2 $logscale]
	  if {$x >= $p1 && $x <= $p2} {
	    Line $g $x $tick1 $x $tick3
	    if {$dogrid_minor} {
	      gridline $g $grid_color $grid_linew $grid_dashes $x $p3 $x $p4
	    }
	  }
	}
      }
    }
    y - y2 {
      if {$minorticks == {}} {
	for {set subidx 1} {$subidx < $div} {incr subidx} {
	  set val [expr {$val + $step}]
	  set y [transform $val $min $max $p1 $p2 $logscale]
	  if {$y >= $p1 && $y <= $p2} {
	    Line $g $tick1 $y $tick3 $y
	    if {$dogrid_minor} {
	      gridline $g $grid_color $grid_linew $grid_dashes $p3 $y $p4 $y
	    }
	  }
	}
      } else {
        foreach minorval $minorticks {
	  set y [transform [expr {$val+$minorval*$interval}] $min $max $p1 $p2 $logscale]
	  if {$y >= $p1 && $y <= $p2} {
	    Line $g $tick1 $y $tick3 $y
	    if {$dogrid_minor} {
	      gridline $g $grid_color $grid_linew $grid_dashes $p3 $y $p4 $y
	    }
	  }
	}
      }
    }
  }
}


proc graph::axis_draw { g name xl yt xr yb 
                                 xl_graph yt_graph xr_graph yb_graph } {
  variable graph

  set index $g,axis-$name
  if {!$graph($index,_valid)} return
  if {$graph($index,hide)} return

  if {$graph($index,title) != ""} {
    set txt $graph($index,title)
    SetColor $g $graph($index,titlecolor)
    foreach {font size attr} $graph($index,titlefont) {}
    SetFont $g $font $size $attr
    set tw [TextWidth $txt]
    set th [LineHeight]
    switch $graph($index,_place) {
      yaxis {
	set yc [expr {$yb + 0.5 * ($yt - $yb)}]
	set xc [expr {$xl + 0.7 * $th}]
	text_rot $g $txt $xc $yc $tw $th 90
      }
      y2axis {
	set yc [expr {$yb + 0.5 * ($yt - $yb)}]
	set xc [expr {$xr - 0.7 * $th}]
	text_rot $g $txt $xc $yc $tw $th -90
      }
      xaxis {
	set xc [expr {$xl + 0.5 * ($xr - $xl)}]
	set yc [expr {$yb + 0.7 * $th}]
	text_rot $g $txt $xc $yc $tw $th 0
      }
      x2axis {
	set xc [expr {$xl + 0.5 * ($xr - $xl)}]
	set yc [expr {$yt - 0.7 * $th}]
	text_rot $g $txt $xc $yc $tw $th 0
      }
    }
  }

  SetColor $g     $graph($index,color)
  SetLinewidth $g $graph($index,linewidth)
  foreach {font size attr} $graph($index,tickfont) {}
  SetFont $g $font $size $attr

  set asc2 [expr {$size * 0.33}]
  set margin 0.7

  set ticklen    $graph($index,ticklength)
  set command    $graph($index,command)
  set subdiv     $graph($index,subdivisions)
  set angle      $graph($index,rotate)
  set logscale   $graph($index,logscale)
  set majorticks $graph($index,majorticks)
  set minorticks $graph($index,minorticks)

  set first  $graph($index,_first)
  set min    $graph($index,_min)
  set max    $graph($index,_max)
  set step   $graph($index,_step)
  set steps  $graph($index,_steps)
  set format $graph($index,_format)
  set value  $first

  if {$subdiv == {}} {
    if {$logscale} {
      set subdiv 10
    } else {
      set subdiv 2
    }
  }
  set substep [expr {double($step) / $subdiv}]

  set dogrid_major no
  set dogrid_minor no
  if {!$graph($g,grid,hide) &&
      ($graph($g,grid,mapx) == $name || $graph($g,grid,mapy) == $name)} {
    set dogrid_major yes
    set dogrid_minor $graph($g,grid,minor)
  }
  set axis_linew  $graph($index,linewidth)
  set grid_color  [GetRGB $graph($g,grid,color)]
  set grid_linew  $graph($g,grid,linewidth)
  set grid_dashes $graph($g,grid,dashes)
  if {$axis_linew == 0} {
    set dogrid_major false
    set dogrid_minor false
  }

  switch $graph($index,_place) {
    xaxis {
      Line $g $xl $yt $xr $yt
      set y_tick1 $yt
      set y_tick2 [expr {$yt - $ticklen}]
      set y_tick3 [expr {$yt - $ticklen / 2.0}]
      set y_text  $yb
      if {$majorticks == {}} {
	for {set idx 0} {$idx < $steps} {incr idx} {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g x $value $min $max $xl $xr $y_tick1 $y_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $yt_graph $yb_graph
	  axis_draw_subticks $g x $value $subdiv $step $substep $min $max $xl $xr $logscale \
	    $y_tick1 $y_tick3 $dogrid_minor $grid_color $grid_linew $grid_dashes $minorticks \
	    $yt_graph $yb_graph
	  set value [expr {$value + $step}]
	}
      } else {
	set idx 0
        foreach value $majorticks {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g x $value $min $max $xl $xr $y_tick1 $y_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $yt_graph $yb_graph
	  incr idx
	}
      }
    }
    x2axis {
      Line $g $xl $yb $xr $yb
      set y_tick1 $yb
      set y_tick2 [expr {$yb + $ticklen}]
      set y_tick3 [expr {$yt + $ticklen / 2.0}]
      set y_text  [expr {$yt - [LineHeight]}]
      if {$majorticks == {}} {
	for {set idx 0} {$idx < $steps} {incr idx} {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g x2 $value $min $max $xl $xr $y_tick1 $y_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $yt_graph $yb_graph
	  axis_draw_subticks $g x2 $value $subdiv $step $substep $min $max $xl $xr $logscale \
	    $y_tick1 $y_tick3 $dogrid_minor $grid_color $grid_linew $grid_dashes $minorticks \
	    $yt_graph $yb_graph
	  set value [expr {$value + $step}]
	}
      } else {
        set idx 0
	foreach value $majorticks {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g x2 $value $min $max $xl $xr $y_tick1 $y_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $yt_graph $yb_graph
	  incr idx
	}
      }
    }
    yaxis {
      Line $g $xr $yt $xr $yb
      set x_tick1 $xr
      set x_tick2 [expr {$xr - $ticklen}]
      set x_tick3 [expr {$xr - $ticklen / 2.0}]
      set x_text  [expr {$x_tick2 - $margin}]
      if {$majorticks == {}} {
	for {set idx 0} {$idx < $steps} {incr idx} {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g y $value $min $max $yb $yt $x_tick1 $x_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $xl_graph $xr_graph
	  axis_draw_subticks $g y $value $subdiv $step $substep $min $max $yb $yt $logscale \
	    $x_tick1 $x_tick3 $dogrid_minor $grid_color $grid_linew $grid_dashes $minorticks \
	    $xl_graph $xr_graph
	  set value [expr {$value + $step}]
	}
      } else {
	set idx 0
        foreach value $majorticks {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g y $value $min $max $yb $yt $x_tick1 $x_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $xl_graph $xr_graph
	  incr idx
	}
      }
    }
    y2axis {
      Line $g $xl $yt $xl $yb
      set x_tick1 $xl
      set x_tick2 [expr {$xl + $ticklen}]
      set x_tick3 [expr {$xl + $ticklen / 2.0}]
      set x_text  [expr {$x_tick2 + $margin}]
      if {$majorticks == {}} {
	for {set idx 0} {$idx < $steps} {incr idx} {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g y2 $value $min $max $yb $yt $x_tick1 $x_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $xl_graph $xr_graph
	  axis_draw_subticks $g y2 $value $subdiv $step $substep $min $max $yb $yt $logscale \
	    $x_tick1 $x_tick3 $dogrid_minor $grid_color $grid_linew $grid_dashes $minorticks \
	    $xl_graph $xr_graph
	  set value [expr {$value + $step}]
	}
      } else {
        set idx 0
	foreach value $majorticks {
	  set txt [lindex $graph($index,_txts) $idx]
	  axis_draw_tick $g y2 $value $min $max $yb $yt $x_tick1 $x_tick2 $margin \
	    $txt $angle $dogrid_major $grid_color $grid_linew $grid_dashes $xl_graph $xr_graph
	  incr idx
	}
      }
    }
  }
}


proc graph::axis_invalidate { g } {
  variable graph

  foreach name $graph($g,_axises) {
    set graph($g,axis-$name,_valid) no
  }
}

###############################################################################
#
# legend components
#

proc graph::legend { g operation params } {
  variable graph

  switch -- $operation {
    configure {
      obj_configure $g,legend $params
    }
    cget {
      return [obj_cget $g,legend $params 1]
    }
    default {
      return -code error "unknown operation \"$operation\""
    }
  }
}


proc graph::legend_calc { g } {
  variable graph

  set titles {}
  foreach elem $graph($g,_elements) {
    set index $g,elem-$elem
    if {$graph($index,_valid)} {
      lappend titles $graph($index,_title)
    }
  }

  set index $g,legend
  if {$graph($index,hide)} {
    set graph($index,_valid) no
    return
  }
  switch $graph($index,position) {
    left - right { set inmargin yes; set graph($index,_orientation) vertical   }
    top - bottom { set inmargin yes; set graph($index,_orientation) horizontal }
    default      { set inmargin no;  set graph($index,_orientation) vertical   }
  }
  set graph($index,_inmargin) $inmargin

  if {$titles == {}} {
    set graph($index,_width)  0
    set graph($index,_height) 0
    set graph($index,_valid)  no
    return
  }
  set count [llength $titles]

  foreach {font size attr} $graph($index,font) {}
  SetFont $g $font $size $attr

  set objwidth [expr {1.5 * $size}]
  set objsize  [expr {$size / 3.0}]

  set graph($index,_objwidth) $objwidth
  set graph($index,_objsize)  $objsize

  set padx  $graph($index,padx)
  set pady  $graph($index,pady)
  set ipadx $graph($index,ipadx)
  set ipady $graph($index,ipady)
  set bdw   $graph($index,borderwidth)

  if {$graph($index,_orientation) == "vertical"} {
    set graph($index,_height) [expr {$count * ([LineHeight] + $ipady) + $ipady}]
    set maxwidth 0
    foreach title $titles {
      set txtwidth [TextWidth $title]
      set width [expr {$objwidth + $ipadx + $txtwidth}]
      if {$width > $maxwidth} { set maxwidth $width }
    }
    set graph($index,_width) [expr {$ipadx + $maxwidth + $ipadx}]
  } else {
    set graph($index,_height) [expr {[LineHeight] + 2 * $ipady}]
    set sumwidth 0
    foreach title $titles {
      set txtwidth [TextWidth $title]
      set width [expr {$objwidth + $ipadx + $txtwidth}]
      set sumwidth [expr {$sumwidth + $ipadx + $width}]
    }
    set graph($index,_width) [expr {$sumwidth + $ipadx}]
  }
  set graph($index,_width)  [expr {$graph($index,_width)  + 2 * ($bdw + $padx)}]
  set graph($index,_height) [expr {$graph($index,_height) + 2 * ($bdw + $pady)}]
  set graph($index,_valid)  yes
}


proc graph::legend_draw { g x_left y_top x_right y_bottom } {
  variable graph

  set index $g,legend

  set padx   $graph($index,padx)
  set pady   $graph($index,pady)
  set ipadx  $graph($index,ipadx)
  set ipady  $graph($index,ipady)
  set bdw    $graph($index,borderwidth)
  set bgc    $graph($index,background)
  set fgc    $graph($index,foreground)
  set rel    $graph($index,relief)
  set anchor $graph($index,anchor)
  set pos    $graph($index,position)

  if {$pos == "plotarea"} { set pos top }

  set width       $graph($index,_width)
  set height      $graph($index,_height)
  set objwidth    $graph($index,_objwidth)
  set objsize     $graph($index,_objsize)
  set orientation $graph($index,_orientation)

  set xl $x_left
  set xr [expr {$xl + $width}]
  set yt $y_top
  set yb [expr {$yt - $height}]

  switch -glob -- $pos {
    left {
      set xl $x_left
      set xr [expr {$xl + $width}]
    }
    right {
      set xr $x_right
      set xl [expr {$xr - $width}]
    }
    top - bottom {
      switch $anchor {
        n - s - center {
	  set xl [expr {$x_left + ($x_right - $x_left - $width) / 2.0}]
	  set xr [expr {$xl + $width}]
	}
	w {
	  set xl $x_left
	  set xr [expr {$xl + $width}]
	}
	e {
	  set xr $x_right
	  set xl [expr {$xr - $width}]
	}
      }
    }
    @*,* {
      if {[regexp {@([\d\.\-mcpi]+),([\d\.\-mcpi]+)$} $pos all pos_x pos_y]} {
	if {$pos_x > 0} {
	  set xl [expr {$x_left + $pos_x}]
	  set xr [expr {$xl + $width}]
	} else {
	  set xr [expr {$x_right - $pos_x}]
	  set xl [expr {$xr - $width}]
	}
      }
    }
  }
  switch -glob -- $graph($index,position) {
    left - right {
      switch $anchor {
        n {
	  set yt $y_top
	  set yb [expr {$yt - $height}]
	}
	s {
	  set yb $y_bottom
	  set yt [expr {$yb + $height}]
	}
	e - w - center {
	  set yb [expr {$x_bottom + ($x_top - $x_bottom - $height) / 2.0}]
	  set yt [expr {$yb + $height}]
	}
      }
    }
    top {
      set yt $y_top
      set yb [expr {$yt - $height}]
    }
    bottom {
      set yb $y_bottom
      set yt [expr {$yb + $height}]
    }
    @*,* {
      if {[regexp {@([\d\.\-mcpi]+),([\d\.\-mcpi]+)$} $pos all pos_x pos_y]} {
	if {$pos_y > 0} {
	  set yt [expr {$y_top - $pos_y}]
	  set yb [expr {$yt - $height}]
	} else {
	  set yb [expr {$y_bottom - $pos_y}]
	  set yt [expr {$yb + $height}]
	}
      }
    }
  }

  # shrink area with padding
  set xl [expr {$xl + $padx}]
  set xr [expr {$xr - $padx}]
  set yt [expr {$yt - $pady}]
  set yb [expr {$yb + $pady}]

  # draw background rect
  set_linewidth $g -1
  Rect $g $xl $yt $xr $yb $bgc
  set_linewidth $g 0

  # draw border frame
  if {$bdw > 0} {
    draw_frame $g $xl $yt $xr $yb $bgc $rel $bdw

    # shrink area with border width
    set xl [expr {$xl + $bdw}]
    set xr [expr {$xr - $bdw}]
    set yt [expr {$yt - $bdw}]
    set yb [expr {$yb + $bdw}]
  }

  foreach {font size attr} $graph($index,font) {}
  SetFont $g $font $size $attr
  set fh [LineHeight]

  set yt [expr {$yt - $ipady}]
  set xl [expr {$xl + $ipadx}]
  foreach elem $graph($g,_elements) {
    set eidx $g,elem-$elem
    if {!$graph($eidx,_valid)} continue
    set e_color  $graph($eidx,color)
    set e_fcolor $graph($eidx,fill)
    set e_ocolor $graph($eidx,outline)
    set e_symbol $graph($eidx,symbol)
    set e_type   $graph($eidx,type)
    set e_dashes $graph($eidx,dashes)
    set title    $graph($eidx,_title)
    set yb [expr {$yt - $fh}]
    set ym [expr {$yt - $fh * 0.5}]
    set yT [expr {$yt - $fh * 0.8}]
    set xs [expr {$xl + $objwidth / 2.0}]
    set xr [expr {$xl + $objwidth}]

    SetColor $g $e_color
    SetLinewidth $g 0.5
    if {$e_type == "line"} {
      SetDash $g $e_dashes
      Line $g $xl $ym $xr $ym
      SetDash $g {}
    }

    SetLinewidth $g 0.2
    if {$e_type == "bar"} { set e_symbol square }
    draw_symbol $g $xs $ym $e_symbol $objsize $e_fcolor $e_ocolor

    SetColor $g $fgc
    set xT [expr {$xr + $ipadx}]
    Text $g $xT $yT $title
    if {$orientation == "vertical"} {
      set yt [expr {$yb - $ipady}]
    } else {
      set txtwidth [TextWidth $title]
      set xl [expr {$xr + $ipadx + $txtwidth + $ipadx}]
    }
  }
}

###############################################################################
#
# marker components
#

proc graph::marker { g operation params } {
  variable graph

  switch -- $operation {
    create {
      variable marker_idx
      set name m[incr marker_idx]
      obj_defaults $g,marker-$name marker_defaults
      set graph($g,marker-$name,type) [lindex $params 0]
      set graph($g,marker-$name,name) $name
      set params [lreplace $params 0 0 $name]
      marker $g configure $params
      lappend graph($g,_markers) $name
      return $name
    }
    configure {
      set name [lindex $params 0]
      obj_configure $g,marker-$name [lrange $params 1 end]
    }
    cget {
      set name [lindex $params 0]
      return [obj_cget $g,marker-$name [lindex $params 1]]
    }
    delete {
      obj_delete $g,_markers $g,marker $params
    }
    exists {
      if {[lsearch [marker $g names] [lindex $params 0]] != -1} {
        return yes
      } else {
        return no
      }
    }
    names {
      if {$params == {}} { set params * }
      return [obj_names $g,_markers $params]
    }
    default {
      return -code error "unknown operation \"$operation\""
    }
  }
}


proc graph::marker_draw { g marker xl_graph yt_graph xr_graph yb_graph } {
  variable graph

  set index $g,marker-$marker
  if {$graph($index,hide) ||
      $graph($index,coords) == {}} continue
  set mapx   $graph($index,mapx)
  set mapy   $graph($index,mapy)
  set coords $graph($index,coords)
  set type   $graph($index,type)
  set xsub   $graph($index,xoffset)
  set ysub   $graph($index,yoffset)
  set elem   $graph($index,element)
  if {$elem != {}} {
    if {[lsearch $graph($g,_elements) $elem] == -1} continue
    if {!$graph($g,elem-$elem,_valid)} continue
  }
  if {[lsearch -exact $graph($g,_axises) $mapx] == -1 ||
      [lsearch -exact $graph($g,_axises) $mapy] == -1   } continue
  set x_min $graph($g,axis-$mapx,_min)
  set x_max $graph($g,axis-$mapx,_max)
  set x_log $graph($g,axis-$mapx,logscale)
  set y_min $graph($g,axis-$mapy,_min)
  set y_max $graph($g,axis-$mapy,_max)
  set y_log $graph($g,axis-$mapy,logscale)
  set clist {}
  foreach {x y} $coords {
    lappend clist [transform [expr {$x - $xsub}] $x_min $x_max $xl_graph $xr_graph $x_log]
    lappend clist [transform [expr {$y - $ysub}] $y_min $y_max $yb_graph $yt_graph $y_log]
  }
  
  switch -- $type {
    line {
      SetDash $g      $graph($index,dashes)
      SetColor $g     $graph($index,outline)
      SetLinewidth $g $graph($index,linewidth)
      foreach {xl yt xr yb} $clist {}
      Line $g $xl $yt $xr $yb
      SetDash $g {}
    }
    polygon {
      SetDash $g      $graph($index,dashes)
      SetColor $g     $graph($index,outline)
      SetLinewidth $g $graph($index,linewidth)
      set x_list {}
      set y_list {}
      foreach {x y} $clist {
        lappend x_list $x
        lappend y_list $y
      }
      PolyObject $g [list $x_list $y_list] [GetRGB $graph($index,fill)]
      SetDash $g {}
    }
    text {
      set text $graph($index,text)
      if {$text != {}} {
	set fill    $graph($index,fill)
	set anchor  $graph($index,anchor)
	set justify $graph($index,justify)
	set padx    $graph($index,padx)
	set pady    $graph($index,pady)

	SetColor $g $graph($index,outline)
	foreach {font size attr} $graph($index,font) {}
	SetFont $g $font $size $attr

	foreach {x y} $clist {}

	set lines [split $text \n]
	set lcnt [llength $lines]
	set tw 0
	foreach line $lines {
	  set w [TextWidth $line]
	  if {$w > $tw} { set tw $w }
	}
	set lh [LineHeight]
	set dx [expr {$tw + 2 * $padx}]
	set dy [expr {$lcnt * $lh + 2 * $pady}]

	set xl [expr {$x - $dx / 2.0}]
	set yt [expr {$y + $dy / 2.0}]
	if {$anchor != "center"} {
	  foreach item [split $anchor {}] {
	    switch $item {
	      n { set yt $y }
	      s { set yt [expr {$y + $dy}] }
	      w { set xl $x }
	      e { set xl [expr {$x - $dx}] }
	    }
	  }
	}

	if {$fill != {}} {
	  SetLinewidth $g -1
	  set xr [expr {$xl + $dx}]
	  set yb [expr {$yt - $dy}]
	  Rect $g $xl $yt $xr $yb $fill
	}

	set x [expr {$xl + $padx}]
	set y [expr {$yt - $pady - 0.8 * $lh}]
	set w [expr {$dx - 2 * $padx}]
	foreach line $lines {
	  switch $justify {
	    left   { Text $g $x $y $line }
	    center { Text $g $x $y $line center $w }
	    right  { Text $g $x $y $line right  $w }
	  }
	  set y [expr {$y - $lh}]
	}
      }
    }
    image {
      set pname $graph($index,image)
      if {[PictSize $g $pname] == {}} {
	LoadPict $g $pname
      }
      if {[set psize [PictSize $g $pname]] == {}} return
      foreach {dx dy} $psize {}
      foreach {x0 y0} $clist {}
      set x [expr {$x0 - $dx / 2.0}]
      set y [expr {$y0 - $dy / 2.0}]
      Pict $g $x $y $pname
    }
  }
}

###############################################################################
#
# grid components
#

proc graph::grid { g operation params } {
  variable graph

  switch -- $operation {
    configure {
      obj_configure $g,grid $params
    }
    cget {
      return [obj_cget $g,grid [lindex $params 0]]
    }
    on {
      set graph($g,grid,hide) no
    }
    off {
      set graph($g,grid,hide) yes
    }
    toggle {
      if {$graph($g,grid,hide)} {
        grid $g on
      } else {
        grid $g off
      }
    }
    default {
      return -code error "unknown operation \"$operation\""
    }
  }
}


proc graph::gridline { g color linewidth dashes x1 y1 x2 y2 } {
  variable graph

  
  set org_linewidth [get_opt $g linewidth]
  set org_rgbcolor  [get_opt $g rgbcolor]
  
  SetLinewidth $g $linewidth
  SetColor $g     $color
  SetDash $g      $dashes

  Line $g $x1 $y1 $x2 $y2

  SetLinewidth $g $org_linewidth
  SetColor $g     $org_rgbcolor
  SetDash $g      {}
}

###############################################################################
#
# graph drawing proc
#

proc graph::draw { g x0 y0 } {
  variable graph

  set origin [GetOrigin $g]

  set org_font        [get_opt $g font]
  set org_linewidth   [get_opt $g linewidth]
  set org_rgbcolor    [get_opt $g rgbcolor]
  set org_dashpattern [get_opt $g dashpattern]

  foreach elem $graph($g,_elements) {
    elem_calc $g $elem
  }
  foreach axis $graph($g,_axises) {
    axis_calc $g $axis
  }
  legend_calc $g

  set margin $graph($g,_margin)
    
  set g_width  $graph($g,width)
  set g_height $graph($g,height)

  CalcXY $g x0 y0       ;# page coords to bottom-left related

  if {$origin} {        ;# 0/0 = top-left
    set x_left   $x0
    set x_right  [expr {$x_left + $g_width}]  
    set y_bottom [expr {$y0 - $g_height}]
    set y_top    $y0
  } else {              ;# 0/0 = bottom-left
    set x_left   $x0
    set x_right  [expr {$x_left + $g_width}]  
    set y_bottom $y0
    set y_top    [expr {$y0 + $g_height}]
  }

  set bgc $graph($g,background)
  set bdw $graph($g,borderwidth)
  set rel $graph($g,relief)

  set_opt $g linewidth -1
  Rect $g $x_left $y_top $x_right $y_bottom $bgc
  set_opt $g linewidth 0

  draw_frame $g $x_left $y_top $x_right $y_bottom $bgc $rel $bdw

  set x_left   [expr {$x_left   + $bdw + $margin}]
  set x_right  [expr {$x_right  - $bdw - $margin}]
  set y_top    [expr {$y_top    - $bdw - $margin}]
  set y_bottom [expr {$y_bottom + $bdw + $margin}]

  # draw graph title:
  if {$graph($g,title) != ""} {
    foreach {font size attr} $graph($g,font) {}
    SetFont $g $font $size $attr
    set fh [LineHeight]
    set y_text [expr {$y_top - $margin - $fh * 0.8}]
    set txtlen [TextWidth $graph($g,title)]
    switch $graph($g,justify) {
      left {
        set x_text [expr {$x_left + $margin}]
      }
      center {
        set x_text [expr {$x_left + ($x_right - $x_left - $txtlen) / 2.0}]
      }
      right {
        set x_text [expr {$x_right - $margin - $txtlen}]
      }
    }
    Text $g $x_text $y_text $graph($g,title)
    set y_top [expr {$y_top - $fh - 2 * $margin}]
  }

  # draw legend in margin:
  if {$graph($g,legend,_valid)} {
    if {$graph($g,legend,_inmargin)} {
      legend_draw $g $x_left $y_top $x_right $y_bottom
    }

    set width  $graph($g,legend,_width)
    set height $graph($g,legend,_height)
    switch $graph($g,legend,position) {
      left   { set x_left   [expr {$x_left   + $width  + $margin}] }
      right  { set x_right  [expr {$x_right  - $width  - $margin}] }
      top    { set y_top    [expr {$y_top    - $height - $margin}] }
      bottom { set y_bottom [expr {$y_bottom + $height + $margin}] }
    }
  }

  # calc drawing area:
  set xl_draw $x_left
  set xr_draw $x_right
  set yt_draw $y_top
  set yb_draw $y_bottom
  if {$graph($g,bottommargin) > 0} {
    set yb_draw [expr {$yb_draw + $graph($g,bottommargin) + $margin}]
  } else {
    foreach axis $graph($g,_xaxis) {
      set index $g,axis-$axis
      if {!$graph($index,_valid)} continue
      set yb_draw [expr {$yb_draw + $graph($index,_height) + $margin}]
    }
  }
  if {$graph($g,topmargin) > 0} {
    set yt_draw [expr {$yt_draw - $graph($g,topmargin) - $margin}]
  } else {
    foreach axis $graph($g,_x2axis) {
      set index $g,axis-$axis
      if {!$graph($index,_valid)} continue
      set yt_draw [expr {$yt_draw - $graph($index,_height) - $margin}]
    }
  }
  if {$graph($g,leftmargin) > 0} {
    set xl_draw [expr {$xl_draw + $graph($g,leftmargin) + $margin}]
  } else {
    foreach axis $graph($g,_yaxis) {
      set index $g,axis-$axis
      if {!$graph($index,_valid)} continue
      set xl_draw [expr {$xl_draw + $graph($index,_width) + $margin}]
    }
  }
  if {$graph($g,rightmargin) > 0} {
    set xr_draw [expr {$xr_draw - $graph($g,rightmargin) - $margin}]
  } else {
    foreach axis $graph($g,_y2axis) {
      set index $g,axis-$axis
      if {!$graph($index,_valid)} continue
      set xr_draw [expr {$xr_draw - $graph($index,_width) - $margin}]
    }
  }
  set xl_draw [expr {$xl_draw + $margin}]
  set xr_draw [expr {$xr_draw - $margin}]
  set yt_draw [expr {$yt_draw - $margin}]
  set yb_draw [expr {$yb_draw + $margin}]

  # calc graph area:
  set padx $graph($g,plotpadx)
  set pady $graph($g,plotpady)
  set xl_graph [expr {$xl_draw + $graph($g,borderwidth) + $padx}]
  set xr_graph [expr {$xr_draw - $graph($g,borderwidth) - $padx}]
  set yt_graph [expr {$yt_draw - $graph($g,borderwidth) - $pady}]
  set yb_graph [expr {$yb_draw + $graph($g,borderwidth) + $pady}]
  set graph($g,_xl_graph) $xl_graph
  set graph($g,_xr_graph) $xr_graph
  set graph($g,_yt_graph) $yt_graph
  set graph($g,_yb_graph) $yb_graph

  # parray graph $g,*

  # draw graph background and frame
  set bgc $graph($g,plotbackground)
  set rel $graph($g,plotrelief)
  set bdw $graph($g,plotborderwidth)
  set_opt $g linewidth -1
  Rect $g $xl_draw $yt_draw $xr_draw $yb_draw $bgc
  set_opt $g linewidth 0
  draw_frame $g $xl_draw $yt_draw $xr_draw $yb_draw $bgc $rel $bdw
  set xl_draw [expr {$xl_draw + $bdw}]
  set xr_draw [expr {$xr_draw - $bdw}]
  set yt_draw [expr {$yt_draw - $bdw}]
  set yb_draw [expr {$yb_draw + $bdw}]

  # draw axes (and grid lines):
  set xl $xl_graph
  set xr $xr_graph
  set yb $y_bottom
  foreach axis $graph($g,_xaxis) {
    set index $g,axis-$axis
    if {!$graph($index,_valid)} continue
    set yt [expr {$yb + $graph($index,_height) + $margin}]
    axis_draw $g $axis $xl $yt $xr $yb \
              $xl_graph $yt_graph $xr_graph $yb_graph
    set yb $yt
  }
  set yt $y_top
  foreach axis $graph($g,_x2axis) {
    set index $g,axis-$axis
    if {!$graph($index,_valid)} continue
    set yb [expr {$yt - $graph($index,_height) - $margin}]
    axis_draw $g $axis $xl $yt $xr $yb \
                    $xl_graph $yt_graph $xr_graph $yb_graph
    set yt $yb
  }
  set yt $yt_graph
  set yb $yb_graph
  set xl $x_left
  foreach axis $graph($g,_yaxis) {
    set index $g,axis-$axis
    if {!$graph($index,_valid)} continue
    set xr [expr {$xl + $graph($index,_width) + $margin}]
    axis_draw $g $axis $xl $yt $xr $yb \
                    $xl_graph $yt_graph $xr_graph $yb_graph
    set xl $xr
  }
  set xr $x_right
  foreach axis $graph($g,_y2axis) {
    set index $g,axis-$axis
    if {!$graph($index,_valid)} continue
    set xl [expr {$xr - $graph($index,_width) - $margin}]
    axis_draw $g $axis $xl $yt $xr $yb \
                    $xl_graph $yt_graph $xr_graph $yb_graph
    set xr $xl
  }

  ClipRect $g $xl_draw $yt_draw $xr_draw $yb_draw
  set graph($g,_cliprect) [list $xl_draw $yt_draw $xr_draw $yb_draw]

  # draw marker elements under data elements
  foreach marker $graph($g,_markers) {
    if {$graph($g,marker-$marker,under)} {
      marker_draw $g $marker $xl_graph $yt_graph $xr_graph $yb_graph
    }
  }

  # draw graph elements
  foreach elem $graph($g,_elements) {
    if {!$graph($g,elem-$elem,_valid)} continue
    elem_draw $g $elem $xl_graph $yt_graph $xr_graph $yb_graph
  }

  # draw marker elements above data elements
  foreach marker $graph($g,_markers) {
    if {!$graph($g,marker-$marker,under)} {
      marker_draw $g $marker $xl_graph $yt_graph $xr_graph $yb_graph
    }
  }

  # draw legend in plotarea:
  if {$graph($g,legend,_valid)} {
    SetColor $g black
    if {!$graph($g,legend,_inmargin)} {
      legend_draw $g $xl_draw $yt_draw $xr_draw $yb_draw
    }
  }

  UnclipRect $g

  foreach {font size attr} $org_font {}
  SetFont $g $font $size $attr
  SetLinewidth $g   $org_linewidth
  SetDash $g        $org_dashpattern
  SetColor $g       $org_rgbcolor

  return $g
}

###############################################################################