Attachment "plotcontour.tcl" to
ticket [1113033fff]
added by
arjenmarkus
2005-01-31 15:19:48.
#! /bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}
# plotcontour.tcl --
# Contour plotting test program for the Plotchart package
###############################################################################
#
# The basic idea behind the method used for contouring within this sample
# is primarily based on :
#
# (1) "Contour Plots of Large Data Sets" by Chris Johnston
# Computer Language, May 1986
#
# a somewhat similar method was also described in
#
# (2) "A Contouring Subroutine" by Paul D. Bourke
# BYTE, June 1987
# http://astronomy.swin.edu.au/~pbourke/projection/conrec/
#
#
#
# In (1) it is assumed that you have a N x M grid of data that you need
# to process. In order to generate a contour, each cell of the grid
# is handled without regard to it's neighbors. This is unlike many other
# contouring algorithms that follow the current contour line into
# neighboring cells in an attempt to produce "smoother" contours.
#
# In general the method described is:
#
# 1) for each four cornered cell of the grid,
# calculate the center of the cell (average of the four corners)
#
# data(i ,j) : Point (1)
# data(i+1,j) : Point (2)
# data(i+1,j+1) : Point (3)
# data(i ,j+1) : Point (4)
# center : Point (5)
#
# (4)-------------(3)
# | \ / |
# | \ / |
# | \ / |
# | \ / |
# | \ / |
# | (5) |
# | / \ |
# | / \ |
# | / \ |
# ^ | / \ |
# | | / \ |
# J (1)-------------(2)
#
# I ->
#
# This divides the cell into four triangles.
#
# 2) Each of the five points in the cell can be assigned a sign (+ or -)
# depending upon whether the point is above (+) the current contour
# or below (-).
#
# A contour will cross an edge whenever the points on the boundary of
# the edge are of an opposite sign.
#
# A few examples :
#
# (-) (-) (-) | (+) (-) (-) (+) | (-)
# \ _ \
# \ / \ \
# (-) - (-) | _ /(+) | - (+) -
# / / / \
# / / / \
# (-) | (+) (-) | (+) (+) | (-) (-) | (+)
#
#
# (Hopefully the "rough" character diagrams above give you the
# general idea)
#
# It turns out that there are 32 possibles combinations of + and -
# and therefore 32 basic paths through the cell. And if you swap
# the (+) and (-) in the diagram above, the "same" basic path is
# generated:
#
# (+) (+) (+) | (-) (+) (+) (-) | (+)
# \ _ \
# \ / \ \
# (+) - (+) | _ /(-) | - (-) -
# / / / \
# / / / \
# (+) | (-) (+) | (-) (-) | (+) (+) | (-)
#
#
# So, it turns out that there are 16 basic paths through the cell.
#
###############################################################################
#
# The original article/code worked on all four triangles together and
# generated one of the 16 paths.
#
# For this version of the code, I split the cell into the four triangles
# and handle each triangle individually.
#
# Doing it this way is slower than the above method for calculating the
# contour lines. But since it "simplifies" the code when doing "color filled"
# contours, I opted for the longer calculation times.
#
###############################################################################
###############################################################################
#
# Implementation details :
#
# global variables :
#
# glob_var : This array hold a variety of values
#
# x : This "2d" (NxM) array holds the X coordinates of the data
# y : This "2d" (NxM) array holds the Y coordinates of the data
# f : This "2d" (NxM) array holds the "functional" value of
# the data (refer to the proc "make_grid" for more details)
#
# NOTE : The color fill algorithm still need some work.
# The problem is when more than one contour line passes through
# a given triangle, it may not color the triangle correctly.
#
# When the first contour through a triangle is calculated, I want
# to store that information in "oldlist" (see proc tri_contour),
# and then use the info in "oldlist" to help determine the proper
# shading if two or more contours pass through the triangle.
#
# At present, the code just prints a message that I
#
# "Need to handle oldlist"
#
###############################################################################
source plotchart.tcl
package require Plotchart
set rv 1 ;# rv (reverse video) : used to set
# foreground and background colors
set filled_cont true ;# set to "false" if you only want
# contour lines.
# "true" will do contour color shading.
set simple_box_contour false ;# normally to "false". If set to "true"
# the normal contouring is by-passed and
# this "grid cell" is colored based on
# the average value of the four corners
set show_grid false ;# set to "true" if you want display
# the grid.
proc plot_contour {filled_cont rv {simple_box_contour false} {show_grid false} } {
global glob_var
set pi 3.1415926
set DtoR [expr $pi / 180.0]
set glob_var(simple_box_contour) $simple_box_contour
set glob_var(filled_contour) $filled_cont
if {$rv} {
set glob_var(fg) black
set glob_var(bg) white
} else {
set glob_var(fg) white
set glob_var(bg) black
}
set sWidth [winfo screenwidth .]
set sHeight [winfo screenheight .]
if {$sWidth < $sHeight} {
set cWidth [expr {$sWidth * 0.75}]
set cHeight $cWidth
} else {
set cWidth [expr {$sHeight * 0.75}]
set cHeight $cWidth
}
set c [canvas .c -background $glob_var(bg) \
-width $cWidth -height $cHeight]
pack $c -fill both -side top
set winCoords [make_grid 20 20]
foreach {xmin xmax ymin ymax} $winCoords {break}
set xtics 4
set ytics 4
set xlimits [getScaleLimits $xmin $xmax $xtics]
set ylimits [getScaleLimits $ymin $ymax $ytics]
foreach {wxmin wxmax wxstep} $xlimits {break}
foreach {wymin wymax wystep} $ylimits {break}
set chart [::Plotchart::createXYPlot $c $xlimits $ylimits]
set fmin -1.0
set fmax 1.0
set ncont 41
contour $chart $c $fmin $fmax $ncont
if {$show_grid} {
draw_grid $chart $c
}
$c raise contour_line
update
}
proc getScaleLimits { xmin xmax ntics } {
set rmin 0.5
set rmax 5.0
set ratio [expr {($xmax - $xmin) / $ntics}]
if {$ratio <= 0.0} {
set ratio 1.0
}
set irdoff 0
set iexp [expr {int(log10($ratio))}]
set aratio [expr {log10($ratio) - $iexp}]
set armax [expr {log10($rmax)}]
if { $aratio > $armax } {
set irdoff 1
}
if { $aratio < $armax } {
set irdoff -1
}
set iexp [expr {$iexp + $irdoff}]
set pexp [expr {pow(10.0,$iexp)}]
set ratio [expr {$ratio / $pexp }]
if {$ratio > 10.0} {
incr iexp
set pexp [expr {pow(10.0,$iexp)}]
set ratio [expr {$ratio / $pexp }]
}
# Find interval to be used on graph
if { $ratio <= 1.0 } {
# Interval is one
set ticint [expr {1.0 * $pexp}]
} else {
if { $ratio <= 2.0 } {
# Interval is two
set ticint [expr {2.0 * $pexp}]
} else {
# Interval is five
set ticint [expr {5.0 * $pexp}]
}
}
if { $xmin >= 0.0 } {
set smin [expr {(int($xmin/$ticint + 1.0e-4)) * $ticint}]
} else {
set smin [expr {(int($xmin/$ticint - 0.9999)) * $ticint}]
}
set smax [expr {(int(($xmax-$xmin)/$ticint + 0.999) * $ticint) + $smin }]
return [list $smin $smax $ticint]
}
proc make_grid { {imax 100} {jmax 100} } {
global glob_var
global x y f
set pi 3.1415926
set d2r [expr $pi / 180.0]
set xmin -90.0
set xmax 90.0
set ymin -90.0
set ymax 90.0
set xrange [expr {$xmax - $xmin}]
set yrange [expr {$ymax - $ymin}]
set dx [expr {$xrange / ($imax - 1)}]
set dy [expr {$yrange / ($jmax - 1)}]
for {set i 1} {$i <= $imax} {incr i} {
for {set j 1} {$j <= $jmax} {incr j} {
set xx [expr {$xmin + ($i-1)*$dx}]
set yy [expr {$ymin + ($j-1)*$dy}]
set x($i,$j) $xx
set y($i,$j) $yy
set sx [expr {sin($xx * $d2r)}]
set cx [expr {cos($yy * $d2r)}]
set f($i,$j) [expr {($sx*$cx)}]
}
}
set glob_var(imax) $imax
set glob_var(jmax) $jmax
# return [list -100.0 100.0 -100.0 100.0]
return [list $xmin $xmax $ymin $ymax]
}
proc draw_grid {chart canv} {
global glob_var
global x y f
$chart dataconfig "grid" -colour "black"
for {set i 1} {$i <= $glob_var(imax)} {incr i} {
set xylist {}
for {set j 1} {$j <= $glob_var(jmax)} {incr j} {
lappend xylist $x($i,$j) $y($i,$j)
}
c_line $chart $canv $xylist black
}
for {set j 1} {$j <= $glob_var(jmax)} {incr j} {
set xylist {}
for {set i 1} {$i <= $glob_var(imax)} {incr i} {
lappend xylist $x($i,$j) $y($i,$j)
}
c_line $chart $canv $xylist black
}
}
proc contour {chart canv fmin fmax ncont} {
global glob_var
global x y f
global cont
set df [expr {($fmax - $fmin) / ($ncont - 1)}]
set dh [expr {240.0 / ($ncont - 1)}]
puts "Fmin = $fmin : Fmax = $fmax : Ncont = $ncont"
# "ncont" is the number of contour lines. Add one
# to get the number of intervals. Therefore calculate
# the colors from zero to ncont.
#
for {set i 0} {$i <= $ncont} {incr i} {
set cont($i,fval) [expr {$fmin + ($i * $df)}]
set cont($i,hue) [expr {240.0 - ($i * $dh)}]
if {$cont($i,hue) < 0.01} {
set cont($i,hue) 0.0
}
set rgbList [hsv2rgb $cont($i,hue) 1.0 1.0]
set r [expr {int([lindex $rgbList 0] * 65535)}]
set g [expr {int([lindex $rgbList 1] * 65535)}]
set b [expr {int([lindex $rgbList 2] * 65535)}]
set cont($i,color) [format "#%.4x%.4x%.4x" $r $g $b]
}
for {set i 1} {$i < $glob_var(imax)} {incr i} {
set i1 [expr {$i + 1}]
for {set j 1} {$j < $glob_var(jmax)} {incr j} {
set j1 [expr {$j + 1}]
set x1 $x($i1,$j)
set x2 $x($i,$j)
set x3 $x($i,$j1)
set x4 $x($i1,$j1)
set y1 $y($i1,$j)
set y2 $y($i,$j)
set y3 $y($i,$j1)
set y4 $y($i1,$j1)
set f1 $f($i1,$j)
set f2 $f($i,$j)
set f3 $f($i,$j1)
set f4 $f($i1,$j1)
set xb [list $x1 $x2 $x3 $x4]
set yb [list $y1 $y2 $y3 $y4]
set fb [list $f1 $f2 $f3 $f4]
box_contour $chart $canv $xb $yb $fb $fmin $fmax $ncont
}
}
## for {set i 0} {$i <= $ncont} {incr i} {
## puts "Contour level $i : Fval = $cont($i,fval)"
## }
}
proc box_contour {chart canv xb yb fb fmin fmax ncont} {
global glob_var
global x y f
global cont
foreach {x1 x2 x3 x4} $xb {}
foreach {y1 y2 y3 y4} $yb {}
foreach {f1 f2 f3 f4} $fb {}
set xc [expr {($x1 + $x2 + $x3 + $x4) * 0.25}]
set yc [expr {($y1 + $y2 + $y3 + $y4) * 0.25}]
set fc [expr {($f1 + $f2 + $f3 + $f4) * 0.25}]
if {$glob_var(simple_box_contour)} {
set ic [expr {int( $ncont * ($fc-$fmin) / ($fmax-$fmin) )}]
if {$ic < 0} {
set ic 0
}
if {$ic > [expr {$ncont - 1}]} {
set ic [expr {$ncont - 1}]
}
set xylist [list $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4]
# canvasPlot::polygon $win $xylist -fill $cont($ic,color)
c_polygon $chart $canv $xylist $cont($ic,color)
} else {
tri_contour $chart $canv $x1 $y1 $f1 $x2 $y2 $f2 $xc $yc $fc $fmin $fmax $ncont
tri_contour $chart $canv $x2 $y2 $f2 $x3 $y3 $f3 $xc $yc $fc $fmin $fmax $ncont
tri_contour $chart $canv $x3 $y3 $f3 $x4 $y4 $f4 $xc $yc $fc $fmin $fmax $ncont
tri_contour $chart $canv $x4 $y4 $f4 $x1 $y1 $f1 $xc $yc $fc $fmin $fmax $ncont
}
}
proc tri_contour { chart canv x1 y1 f1 x2 y2 f2 x3 y3 f3 fmin fmax ncont } {
global glob_var
global x y f
global cont
set frange [expr {$fmax - $fmin}]
set nc [expr {$ncont - 1}]
set df [expr {$frange / $nc}]
# Find the min/max function values for this triangle
#
set tfmin [min $f1 $f2 $f3]
set tfmax [max $f1 $f2 $f3]
# Based on the above min/max, figure out which
# contour levels/colors that bracket this interval
#
set imin 0
for {set i 0} {$i < $ncont} {incr i} {
set ff $cont($i,fval)
if {$ff <= $tfmin} {
set imin $i
set imax $i
}
if {$ff >= $tfmin && $ff <= $tfmax} {
set imax $i
}
}
# First handle the simple case where one color can
# be used to color the entire triangle...
#
if {$glob_var(filled_contour)} {
if {$imin == $imax} {
set ictmp $imin
if {$cont($imin,fval) < $tfmax} {
incr ictmp
}
set pxylist [list $x1 $y1 $x2 $y2 $x3 $y3]
c_polygon $chart $canv $pxylist $cont($ictmp,color)
return
}
}
set oldlist {}
set vertlist {}
# Since the simple above has already been handled,
# make sure that the contour levels go past "tfmax"
#
incr imax
# Loop over all contour levels of interest for this triangle
#
for {set ic $imin} {$ic <= $imax} {incr ic} {
# Get the value for this contour level
#
set ff $cont($ic,fval)
set pxylist {}
# First check to see if the current contour value "ff"
# falls within the min/max values for this triangle
#
if {$ff >= $tfmin && $ff <= $tfmax} {
# Determine if the current contour level
# intersects each side of the triangle
#
set side12 [expr {($ff - $f1) * ($ff - $f2)}]
set side23 [expr {($ff - $f2) * ($ff - $f3)}]
set side31 [expr {($ff - $f3) * ($ff - $f1)}]
if {$side12 <= 0.0} {
# It intersects this side : between points 1 & 2
# Calculate the intersection point 1
#
set xyf1 [fintpl $x1 $y1 $f1 $x2 $y2 $f2 $ff]
# Add this point to the current polygon point list
#
set pxylist $xyf1
if {$side23 <= 0.0} {
# It intersects this side : between points 2 & 3
# Calculate the intersection point 2
#
set xyf2 [fintpl $x2 $y2 $f2 $x3 $y3 $f3 $ff]
# Add this point to the current polygon point list
#
foreach {xx yy} $xyf2 {}
lappend pxylist $xx $yy
foreach {xx1 yy1 xx2 yy2} $pxylist {break}
if {$glob_var(filled_contour)} {
if {[llength $oldlist] == 0} {
if {$f2 < $ff} {
lappend pxylist $x2 $y2
lappend vertlist 2
} else {
lappend pxylist $x3 $y3 $x1 $y1
lappend vertlist 3 1
}
c_polygon $chart $canv $pxylist $cont($ic,color)
} else {
set lst1 [lindex $oldlist 0]
set lst2 [lindex $oldlist 1]
foreach {side1 ox1 oy1} $lst1 {break}
foreach {side2 ox2 oy2} $lst2 {break}
if {$side1 == "side12" && $side2 == "side23"} {
lappend pxylist $ox2 $oy2 $ox1 $oy1
} else {
if {$side1 == "side12" && $side2 == "side31"} {
lappend pxylist $x3 $y3 $ox2 $oy2 $ox1 $oy1
} else {
lappend pxylist $ox1 $oy1 $ox2 $oy2 $x1 $y1
}
}
c_polygon $chart $canv $pxylist $cont($ic,color)
}
set oldlist {}
lappend oldlist [list "side12" $xx1 $yy1]
lappend oldlist [list "side23" $xx2 $yy2]
}
} else {
# It intersects this side : between points 3 & 1
# Calculate the intersection point 2
#
set xyf2 [fintpl $x3 $y3 $f3 $x1 $y1 $f1 $ff]
foreach {xx yy} $xyf2 {}
lappend pxylist $xx $yy
foreach {xx1 yy1 xx2 yy2} $pxylist {break}
if {$glob_var(filled_contour)} {
if {[llength $oldlist] == 0} {
if {$f1 < $ff} {
lappend pxylist $x1 $y1
lappend vertlist 1
} else {
lappend pxylist $x3 $y3 $x2 $y2
lappend vertlist 3 2
}
c_polygon $chart $canv $pxylist $cont($ic,color)
} else {
set lst1 [lindex $oldlist 0]
set lst2 [lindex $oldlist 1]
foreach {side1 ox1 oy1} $lst1 {break}
foreach {side2 ox2 oy2} $lst2 {break}
if {$side1 == "side12" && $side2 == "side31"} {
lappend pxylist $ox2 $oy2 $ox1 $oy1
} else {
if {$side1 == "side12" && $side2 == "side23"} {
lappend pxylist $x3 $y3 $ox2 $oy2 $ox1 $oy1
} else {
lappend pxylist $ox2 $oy2 $ox1 $oy1 $x2 $y2
}
}
c_polygon $chart $canv $pxylist $cont($ic,color)
}
set oldlist {}
lappend oldlist [list "side12" $xx1 $yy1]
lappend oldlist [list "side31" $xx2 $yy2]
}
}
} else {
set xyf1 [fintpl $x2 $y2 $f2 $x3 $y3 $f3 $ff]
set xyf2 [fintpl $x3 $y3 $f3 $x1 $y1 $f1 $ff]
foreach {xx1 yy1} $xyf1 {}
lappend pxylist $xx1 $yy1
foreach {xx2 yy2} $xyf2 {}
lappend pxylist $xx2 $yy2
if {$glob_var(filled_contour)} {
if {[llength $oldlist] == 0} {
if {$f3 < $ff} {
lappend pxylist $x3 $y3
lappend vertlist 3
} else {
lappend pxylist $x1 $y1 $x2 $y2
lappend vertlist 1 2
}
c_polygon $chart $canv $pxylist $cont($ic,color)
} else {
set lst1 [lindex $oldlist 0]
set lst2 [lindex $oldlist 1]
foreach {side1 ox1 oy1} $lst1 {break}
foreach {side2 ox2 oy2} $lst2 {break}
if {$side1 == "side23" && $side2 == "side31"} {
lappend pxylist $ox2 $oy2 $ox1 $oy1
} else {
if {$side1 == "side12" && $side2 == "side23"} {
lappend pxylist $x1 $y1 $ox1 $oy1 $ox2 $oy2
} else {
lappend pxylist $ox2 $oy2 $ox1 $oy1 $x2 $y2
}
}
c_polygon $chart $canv $pxylist $cont($ic,color)
}
set oldlist {}
lappend oldlist [list "side23" $xx1 $yy1]
lappend oldlist [list "side31" $xx2 $yy2]
}
}
# Construct the contour line from the intersection
# points calculated above
#
foreach {xx1 yy1} $xyf1 {}
foreach {xx2 yy2} $xyf2 {}
set xylist [list $xx1 $yy1 $xx2 $yy2]
# Draw the contour line. If we're doing a "filled contour"
# (ie coloring each triangle) then use "black" as the color
# of the line, otherwise use the "contour color" for the line.
# A tag is used so that we can "raise/lower" the line if desired.
#
if {$glob_var(filled_contour)} {
# c_line $chart $canv $xylist $cont($ic,color)
c_line $chart $canv $xylist black -tag contour_line
} else {
c_line $chart $canv $xylist $cont($ic,color)
}
} else {
# The current contour value "ff" is such that either :
# ff < tfmin
# ff > tfmax
if {$glob_var(filled_contour)} {
if {[llength $oldlist] == 0} {
set pxylist [list $x1 $y1 $x2 $y2 $x3 $y3]
c_polygon $chart $canv $pxylist $cont($ic,color)
} else {
# We should only reach this point when
# ic == imax and we need to finish the color fill
# for this triangle
#
set lst1 [lindex $oldlist 0]
set lst2 [lindex $oldlist 1]
foreach {side1 ox1 oy1} $lst1 {break}
foreach {side2 ox2 oy2} $lst2 {break}
if {$side1 == "side12" && $side2 == "side23"} {
if {[lsearch $vertlist "2"] == -1} {
set pxylist [list $ox1 $oy1 $ox2 $oy2 $x2 $y2 ]
} else {
set pxylist [list $ox1 $oy1 $ox2 $oy2 $x3 $y3 $x1 $y1 ]
}
}
if {$side1 == "side12" && $side2 == "side31"} {
if {[lsearch $vertlist "1"] == -1} {
set pxylist [list $ox1 $oy1 $ox2 $oy2 $x1 $y1 ]
} else {
set pxylist [list $ox1 $oy1 $ox2 $oy2 $x3 $y3 $x2 $y2 ]
}
}
if {$side1 == "side23" && $side2 == "side31"} {
if {[lsearch $vertlist "3"] == -1} {
set pxylist [list $ox1 $oy1 $ox2 $oy2 $x3 $y3 ]
} else {
set pxylist [list $ox1 $oy1 $ox2 $oy2 $x1 $y1 $x2 $y2 ]
}
}
c_polygon $chart $canv $pxylist $cont($ic,color)
set oldlist {}
}
}
}
}
}
proc fintpl {x1 y1 f1 x2 y2 f2 ff} {
if {[expr {$f2 - $f1}] != 0.0} {
set xx [expr {$x1 + (($ff - $f1)*($x2 - $x1)/($f2 - $f1))}]
set yy [expr {$y1 + (($ff - $f1)*($y2 - $y1)/($f2 - $f1))}]
} else {
# puts "FINTPL : f1 == f2 : x1,y1 : $x1 , $y1 : x2,y2 : $x2 , $y2"
set xx $x1
set yy $y1
}
set xmin [min $x1 $x2]
set xmax [max $x1 $x2]
set ymin [min $y1 $y2]
set ymax [max $y1 $y2]
if {$xx < $xmin} { set xx $xmin }
if {$xx > $xmax} { set xx $xmax }
if {$yy < $ymin} { set yy $ymin }
if {$yy > $ymax} { set yy $ymax }
return [list $xx $yy]
}
proc min { val args } {
set min $val
foreach val $args {
if { $val < $min } {
set min $val
}
}
return $min
}
proc max { val args } {
set max $val
foreach val $args {
if { $val > $max } {
set max $val
}
}
return $max
}
proc c_line {chart canv xylist color args} {
set wxylist {}
foreach {xx yy} $xylist {
foreach {pxcrd pycrd} [::Plotchart::coordsToPixel $canv $xx $yy] {break}
lappend wxylist $pxcrd $pycrd
}
eval "$canv create line $wxylist -fill $color $args"
}
proc c_polygon {chart canv xylist color args} {
set wxylist {}
foreach {xx yy} $xylist {
foreach {pxcrd pycrd} [::Plotchart::coordsToPixel $canv $xx $yy] {break}
lappend wxylist $pxcrd $pycrd
}
eval "$canv create polygon $wxylist -fill $color $args"
}
########################################################################
# The following two routines were borrowed from :
#
# http://mini.net/cgi-bin/wikit/666.html
########################################################################
# rgb2hsv --
#
# Convert a color value from the RGB model to HSV model.
#
# Arguments:
# r g b the red, green, and blue components of the color
# value. The procedure expects, but does not
# ascertain, them to be in the range 0 to 1.
#
# Results:
# The result is a list of three real number values. The
# first value is the Hue component, which is in the range
# 0.0 to 360.0, or -1 if the Saturation component is 0.
# The following to values are Saturation and Value,
# respectively. They are in the range 0.0 to 1.0.
#
# Credits:
# This routine is based on the Pascal source code for an
# RGB/HSV converter in the book "Computer Graphics", by
# Baker, Hearn, 1986, ISBN 0-13-165598-1, page 304.
#
proc rgb2hsv {r g b} {
set h [set s [set v 0.0]]]
set sorted [lsort -real [list $r $g $b]]
set v [expr {double([lindex $sorted end])}]
set m [lindex $sorted 0]
set dist [expr {double($v-$m)}]
if {$v} {
set s [expr {$dist/$v}]
}
if {$s} {
set r' [expr {($v-$r)/$dist}] ;# distance of color from red
set g' [expr {($v-$g)/$dist}] ;# distance of color from green
set b' [expr {($v-$b)/$dist}] ;# distance of color from blue
if {$v==$r} {
if {$m==$g} {
set h [expr {5+${b'}}]
} else {
set h [expr {1-${g'}}]
}
} elseif {$v==$g} {
if {$m==$b} {
set h [expr {1+${r'}}]
} else {
set h [expr {3-${b'}}]
}
} else {
if {$m==$r} {
set h [expr {3+${g'}}]
} else {
set h [expr {5-${r'}}]
}
}
set h [expr {$h*60}] ;# convert to degrees
} else {
# hue is undefined if s == 0
set h -1
}
return [list $h $s $v]
}
# hsv2rgb --
#
# Convert a color value from the HSV model to RGB model.
#
# Arguments:
# h s v the hue, saturation, and value components of
# the color value. The procedure expects, but
# does not ascertain, h to be in the range 0.0 to
# 360.0 and s, v to be in the range 0.0 to 1.0.
#
# Results:
# The result is a list of three real number values,
# corresponding to the red, green, and blue components
# of a color value. They are in the range 0.0 to 1.0.
#
# Credits:
# This routine is based on the Pascal source code for an
# HSV/RGB converter in the book "Computer Graphics", by
# Baker, Hearn, 1986, ISBN 0-13-165598-1, page 304.
#
proc hsv2rgb {h s v} {
set v [expr {double($v)}]
set r [set g [set b 0.0]]
if {$h == 360} { set h 0 }
# if you feed the output of rgb2hsv back into this
# converter, h could have the value -1 for
# grayscale colors. Set it to any value in the
# valid range.
if {$h == -1} { set h 0 }
set h [expr {$h/60}]
set i [expr {int(floor($h))}]
set f [expr {$h - $i}]
set p1 [expr {$v*(1-$s)}]
set p2 [expr {$v*(1-($s*$f))}]
set p3 [expr {$v*(1-($s*(1-$f)))}]
switch -- $i {
0 { set r $v ; set g $p3 ; set b $p1 }
1 { set r $p2 ; set g $v ; set b $p1 }
2 { set r $p1 ; set g $v ; set b $p3 }
3 { set r $p1 ; set g $p2 ; set b $v }
4 { set r $p3 ; set g $p1 ; set b $v }
5 { set r $v ; set g $p1 ; set b $p2 }
}
return [list $r $g $b]
}
#
# Main code
#
plot_contour $filled_cont $rv $simple_box_contour $show_grid
