saods9-data 7.2+dfsg-4 / usr / share / saods9 / src / plotelement.tcl

#  Copyright (C) 1999-2012
#  Smithsonian Astrophysical Observatory, Cambridge, MA, USA
#  For conditions of distribution and use, see copyright notice in "copyright"

package provide DS9 1.0

proc PlotCreateErrorX {varname} {
    upvar #0 $varname var
    global $varname

    set nn $var(data,current)
    set err {}

    # delete markers
    foreach mk [$var(graph) marker names "m-${nn}-x*"] {
	$var(graph) marker delete $mk
    }

    global $var(xdata) $var(ydata) $var(xedata)
    set ll [$var(xdata) length]
    set xx [$var(xdata) range]
    set yy [$var(ydata) range]
    set xe [$var(xedata) range]

    for {set ii 0} {$ii<$ll} {incr ii} {
	set x [lindex $xx $ii]
	set y [lindex $yy $ii]
	set e [lindex $xe $ii]

	$var(graph) marker create line \
	    -name "m-${nn}-x${ii}" \
	    -coords "[expr $x+$e] $y [expr $x-$e] $y" \
	    -linewidth $var(error,width) \
	    -outline $var(error,color)
    }
}

proc PlotCreateErrorY {varname} {
    upvar #0 $varname var
    global $varname

    set nn $var(data,current)
    set err {}

    # delete markers
    foreach mk [$var(graph) marker names "m-${nn}-y*"] {
	$var(graph) marker delete $mk
    }

    global $var(xdata) $var(ydata) $var(yedata)
    set ll [$var(xdata) length]
    set xx [$var(xdata) range]
    set yy [$var(ydata) range]
    set ye [$var(yedata) range]

    for {set ii 0} {$ii<$ll} {incr ii} {
	set x [lindex $xx $ii]
	set y [lindex $yy $ii]
	set e [lindex $ye $ii]

	$var(graph) marker create line \
	    -name "m-${nn}-y${ii}" \
	    -coords "$x [expr $y-$e] $x [expr $y+$e] " \
	    -linewidth $var(error,width) \
	    -outline $var(error,color)
    }
}

proc PlotUpdateElementDiscrete {varname} {
    upvar #0 $varname var
    global $varname

    # warning: uses current vars
    if {$var(data,total) == 0} {
	return
    }

    set nn $var(data,current)
    set var($nn,discrete,color) $var(discrete,color)
    set var($nn,discrete,symbol) $var(discrete,symbol)
    set var($nn,discrete,fill) $var(discrete,fill)

    if {$var(discrete)} {
	if {$var(discrete,fill)} {
	    set clr $var(discrete,color)
	} else {
	    set clr {}
	}

	$var(graph) element configure "d-${nn}" \
	    -outline $var(discrete,color) -color $var(discrete,color) \
	    -symbol $var(discrete,symbol) -fill $clr
    }
}

proc PlotUpdateElementLinear {varname} {
    upvar #0 $varname var
    global $varname

    # warning: uses current vars
    if {$var(data,total) == 0} {
	return
    }

    set nn $var(data,current)
    set var($nn,linear,color) $var(linear,color)
    set var($nn,linear,width) $var(linear,width)

    if {$var(linear)} {
	if {$var(linear,dash) == {yes}} {
	    set dash {8 3}
	} else {
	    set dash { }
	}
	$var(graph) element configure "l-${nn}" \
	    -linewidth $var(linear,width) -dashes $dash \
	    -color $var(linear,color)
    }
}

proc PlotUpdateElementStep {varname} {
    upvar #0 $varname var
    global $varname

    # warning: uses current vars
    if {$var(data,total) == 0} {
	return
    }

    set nn $var(data,current)
    set var($nn,step,color) $var(step,color)
    set var($nn,step,width) $var(step,width)

    if {$var(step)} {
	if {$var(step,dash) == {yes}} {
	    set dash {8 3}
	} else {
	    set dash { }
	}
	$var(graph) element configure "s-${nn}" \
	    -linewidth $var(step,width) -dashes $dash \
	    -color $var(step,color)
    }
}

proc PlotUpdateElementQuadratic {varname} {
    upvar #0 $varname var
    global $varname

    # warning: uses current vars
    if {$var(data,total) == 0} {
	return
    }

    set nn $var(data,current)
    set var($nn,quadratic,color) $var(quadratic,color)
    set var($nn,quadratic,width) $var(quadratic,width)

    if {$var(quadratic)} {
	if {$var(quadratic,dash) == {yes}} {
	    set dash {8 3}
	} else {
	    set dash { }
	}
	$var(graph) element configure "q-${nn}" \
	    -linewidth $var(quadratic,width) -dashes $dash \
	    -color $var(quadratic,color)
    }
}

proc PlotUpdateElementBar {varname} {
    upvar #0 $varname var
    global $varname

    # warning: uses current vars
    if {$var(data,total) == 0} {
	return
    }

    set nn $var(data,current)
    set var($nn,bar,color) $var(bar,color)

    if {$var(bar)} {
	switch $var(bar,color) {
	    black {set clr "#000001"}
	    default {set clr $var(bar,color)}
	}
	$var(graph) element configure "b-${nn}" \
	    -foreground $clr -background $clr 
    }
}

proc PlotUpdateElementError {varname} {
    upvar #0 $varname var
    global $varname

    # warning: uses current vars
    if {$var(data,total) == 0} {
	return
    }

    set nn $var(data,current)
    set var($nn,error,color) $var(error,color)
    set var($nn,error,width) $var(error,width)

    foreach mk [$var(graph) marker names "m-${nn}*"] {
	$var(graph) marker configure $mk \
	    -linewidth $var(error,width) \
	    -outline $var(error,color)
    }
}

proc PlotHighliteElement {varname rowlist} {
    upvar #0 $varname var
    global $varname

    # rowlist starts at 1
    set result {}
    foreach rr $rowlist {
	append result "[expr $rr-1] "
    }
    $var(proc,highlite) $varname $result
}