saods9-data 7.2+dfsg-4 / usr / share / saods9 / src / plotline.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 PlotLineTool {} {
    global iap
    PlotLine $iap(tt) [msgcat::mc {Line Plot Tool}] {} {} {} 2 {}
}

proc PlotLine {tt wtt title xaxis yaxis dim data} {
    global iap

    # make the window name unique
    set ii [lsearch $iap(windows) $tt]
    if {$ii>=0} {
	append tt $iap(unique)
	incr iap(unique)
    }

    # set the window title if none
    if {$wtt == {}} {
	set wtt $tt
    }

    set varname $tt
    upvar #0 $varname var
    global $varname

    PlotLineProc $varname
    PlotDialog $varname $wtt $title $xaxis $yaxis
    PlotDialogLine $varname

    PlotDataSet $varname $dim $data
    $var(proc,updategraph) $varname
    PlotStats $varname
    PlotList $varname
}

proc PlotLineDialog {varname wtt title xaxis yaxis} {
    upvar #0 $varname var
    global $varname

    PlotLineProc $varname
    PlotDialog $varname $wtt $title $xaxis $yaxis
    PlotDialogLine $varname
}

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

    set var(proc,updategraph) PlotLineUpdateGraph
    set var(proc,createelement) PlotLineCreateElement
    set var(proc,updateelement) PlotLineUpdateElement
    set var(proc,highlite) PlotLineHighliteElement
    set var(proc,button) PlotLineButton
}

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

    global pap

    set var(seq) 1
    set var(discrete) $pap(discrete)
    set var(linear) $pap(linear)
    set var(step) $pap(step)
    set var(quadratic) $pap(quadratic)
    set var(error) $pap(error)
    set var(bar) 0

    # element
    $var(mb).element add cascade -label [msgcat::mc {Discrete}] \
	-menu $var(mb).element.discrete
    $var(mb).element add cascade -label [msgcat::mc {Linear}] \
	-menu $var(mb).element.linear
    $var(mb).element add cascade -label [msgcat::mc {Step}] \
	-menu $var(mb).element.step
    $var(mb).element add cascade -label [msgcat::mc {Quadratic}] \
	-menu $var(mb).element.quadratic
    $var(mb).element add cascade -label [msgcat::mc {Error}] \
	-menu $var(mb).element.error

    # discrete
    menu $var(mb).element.discrete
    $var(mb).element.discrete add checkbutton -label [msgcat::mc {Show}] \
	-variable ${varname}(discrete) \
	-command [list $var(proc,updateelement) $varname]
    $var(mb).element.discrete add separator
    $var(mb).element.discrete add cascade -label [msgcat::mc {Color}] \
	-menu $var(mb).element.discrete.color
    $var(mb).element.discrete add cascade -label [msgcat::mc {Shape}] \
	-menu $var(mb).element.discrete.shape

    ColorMenu $var(mb).element.discrete.color $varname discrete,color \
	[list PlotUpdateElementDiscrete $varname]
    menu $var(mb).element.discrete.shape
    $var(mb).element.discrete.shape add radiobutton \
	-label [msgcat::mc {Circle}] \
	-variable ${varname}(discrete,symbol) -value circle \
	-command [list PlotUpdateElementDiscrete $varname]
    $var(mb).element.discrete.shape add radiobutton \
	-label [msgcat::mc {Diamond}] \
	-variable ${varname}(discrete,symbol) -value diamond \
	-command [list PlotUpdateElementDiscrete $varname]
    $var(mb).element.discrete.shape add radiobutton \
	-label [msgcat::mc {Plus}] \
	-variable ${varname}(discrete,symbol) -value plus \
	-command [list PlotUpdateElementDiscrete $varname]
    $var(mb).element.discrete.shape add radiobutton \
	-label [msgcat::mc {Cross}] \
	-variable ${varname}(discrete,symbol) -value cross \
	-command [list PlotUpdateElementDiscrete $varname]
    $var(mb).element.discrete.shape add separator
    $var(mb).element.discrete.shape add checkbutton \
	-label [msgcat::mc {Fill}] \
	-variable ${varname}(discrete,fill) \
	-command [list PlotUpdateElementDiscrete $varname]

    # linear
    menu $var(mb).element.linear
    $var(mb).element.linear add checkbutton \
	-label [msgcat::mc {Show}] \
	-variable ${varname}(linear) \
	-command [list $var(proc,updateelement) $varname]
    $var(mb).element.linear add separator
    $var(mb).element.linear add cascade \
	-label [msgcat::mc {Color}] \
	-menu $var(mb).element.linear.color
    $var(mb).element.linear add cascade \
	-label [msgcat::mc {Line}] \
	-menu $var(mb).element.linear.line

    ColorMenu $var(mb).element.linear.color $varname linear,color \
	[list PlotUpdateElementLinear $varname]
    PlotCreateLineMenu $var(mb).element.linear.line \
	${varname}(linear,width) ${varname}(linear,dash) \
	[list PlotUpdateElementLinear $varname]

    # step
    menu $var(mb).element.step
    $var(mb).element.step add checkbutton \
	-label [msgcat::mc {Show}] \
	-variable ${varname}(step) \
	-command [list $var(proc,updateelement) $varname]
    $var(mb).element.step add separator
    $var(mb).element.step add cascade \
	-label [msgcat::mc {Color}] \
	-menu $var(mb).element.step.color
    $var(mb).element.step add cascade \
	-label [msgcat::mc {Line}] \
	-menu $var(mb).element.step.line

    ColorMenu $var(mb).element.step.color $varname step,color \
	[list PlotUpdateElementStep $varname]
    PlotCreateLineMenu $var(mb).element.step.line \
	${varname}(step,width) ${varname}(step,dash) \
	[list PlotUpdateElementStep $varname]

    # quadratic
    menu $var(mb).element.quadratic
    $var(mb).element.quadratic add checkbutton \
	-label [msgcat::mc {Show}] \
	-variable ${varname}(quadratic) \
	-command [list $var(proc,updateelement) $varname]
    $var(mb).element.quadratic add separator
    $var(mb).element.quadratic add cascade \
	-label [msgcat::mc {Color}] \
	-menu $var(mb).element.quadratic.color
    $var(mb).element.quadratic add cascade \
	-label [msgcat::mc {Line}] \
	-menu $var(mb).element.quadratic.line

    ColorMenu $var(mb).element.quadratic.color $varname quadratic,color \
	[list PlotUpdateElementQuadratic $varname]
    PlotCreateLineMenu $var(mb).element.quadratic.line \
	${varname}(quadratic,width) ${varname}(quadratic,dash) \
	[list PlotUpdateElementQuadratic $varname]

    # error
    menu $var(mb).element.error
    $var(mb).element.error add checkbutton \
	-label [msgcat::mc {Show}] \
	-variable ${varname}(error) \
	-command [list $var(proc,updateelement) $varname]
    $var(mb).element.error add separator
    $var(mb).element.error add cascade \
	-label [msgcat::mc {Color}] \
	-menu $var(mb).element.error.color
    $var(mb).element.error add cascade \
	-label [msgcat::mc {Line}] \
	-menu $var(mb).element.error.line

    ColorMenu $var(mb).element.error.color $varname error,color \
	[list PlotUpdateElementError $varname]
    WidthDashMenu $var(mb).element.error.line $varname error,width {} \
	[list PlotUpdateElementError $varname] {}

    # graph
    set var(graph) [blt::graph $var(top).line \
			-width 600 -height 500 \
			-plotrelief groove \
			-plotborderwidth 2 \
		       ]
    $var(graph) legend configure -hide yes

    pack $var(graph) -expand yes -fill both
    PlotChangeMode $varname
}

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

    if {$var(graph,x,auto)} {
	set xmin {}
	set xmax {}
    } else {
	set xmin $var(graph,x,min)
	set xmax $var(graph,x,max)
    }

    if {$var(graph,y,auto)} {
	set ymin {}
	set ymax {}
    } else {
	set ymin $var(graph,y,min)
	set ymax $var(graph,y,max)
    }

    $var(graph) xaxis configure -min $xmin -max $xmax \
	-descending $var(graph,x,flip)
    $var(graph) yaxis configure -min $ymin -max $ymax \
	-descending $var(graph,y,flip)

    PlotUpdateGraph $varname
}

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

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

    # delete current elements
    set nn $var(data,current)
    foreach el [$var(graph) element names] {
	set f [split $el -]
	if {[lindex $f 1] == $nn} {
	    $var(graph) element delete $el
	}
    }

    # discrete
    if {$var(discrete,fill)} {
	set clr $var(discrete,color)
    } else {
	set clr {}
    }
    $var(graph) element create "d-${nn}" \
	-xdata $var(xdata) -ydata $var(ydata) \
	-linewidth 0 -pixels 5 \
	-symbol $var(discrete,symbol) \
	-fill $clr \
	-outline $var(discrete,color) \
	-color $var(discrete,color)

    # linear
    if {$var(linear,dash) == {yes}} {
	set dash {8 3}
    } else {
	set dash { }
    }
    $var(graph) element create "l-${nn}" \
	-xdata $var(xdata) -ydata $var(ydata) \
	-smooth linear -symbol {} \
	-linewidth $var(linear,width) \
	-color $var(linear,color) \
	-dashes $dash

    # step
    if {$var(step,dash) == {yes}} {
	set dash {8 3}
    } else {
	set dash { }
    }
    $var(graph) element create "s-${nn}" \
	-xdata $var(xdata) -ydata $var(ydata) \
	-smooth step -symbol {} \
	-linewidth $var(step,width) \
	-color $var(step,color) \
	-dashes $dash

    # quadratic
    # note: quadratic does not work when flipped
    if {$var(quadratic,dash) == {yes}} {
	set dash {8 3}
    } else {
	set dash { }
    }
    $var(graph) element create "q-${nn}" \
	-xdata $var(xdata) -ydata $var(ydata) \
	-smooth quadratic -symbol {} \
	-linewidth $var(quadratic,width) \
	-color $var(quadratic,color) \
	-dashes $dash

    # error
    if {$var(xedata) != {}} {
	if {[$var(xedata) length] != 0} {
	    PlotCreateErrorX $varname
	}
    }
    if {$var(yedata) != {}} {
	if {[$var(yedata) length] != 0} {
	    PlotCreateErrorY $varname
	}
    }

    # do this to force an update in case of no visible elements
    $var(graph) legend configure -hide yes
}

proc PlotLineUpdateElement {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) $var(discrete)
    set var($nn,linear) $var(linear)
    set var($nn,step) $var(step)
    set var($nn,quadratic) $var(quadratic)
    set var($nn,error) $var(error)

    $var(graph) element configure "d-${nn}" -hide [expr !$var(discrete)]
    $var(graph) element configure "l-${nn}" -hide [expr !$var(linear)]
    $var(graph) element configure "s-${nn}" -hide [expr !$var(step)]
    $var(graph) element configure "q-${nn}" -hide [expr !$var(quadratic)]
    
    foreach mk [$var(graph) marker names "m-${nn}*"] {
	$var(graph) marker configure $mk -hide [expr !$var(error)]
    }
}

proc PlotLineButton {varname x y} {
    upvar #0 $varname var
    global $varname
}

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