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

proc PlotScatter {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

    PlotScatterProc $varname
    PlotDialog $varname $wtt $title $xaxis $yaxis
    PlotDialogScatter $varname

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

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

    PlotScatterProc $varname
    PlotDialog $varname $wtt $title $xaxis $yaxis
    PlotDialogScatter $varname
}

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

    set var(proc,updategraph) PlotScatterUpdateGraph
    set var(proc,createelement) PlotScatterCreateElement
    set var(proc,updateelement) PlotScatterUpdateElement
    set var(proc,highlite) PlotScatterHighliteElement
    set var(proc,button) PlotScatterButton
}

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

    global pap

    set var(seq) 0
    set var(discrete) 1
    set var(linear) 0
    set var(step) 0
    set var(quadratic) 0
    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 {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]

    # 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).scatter \
			-width 600 -height 500 \
			-plotrelief groove \
			-plotborderwidth 2 \
		       ]
    $var(graph) legend configure -hide yes

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

proc PlotScatterUpdateGraph {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 PlotScatterCreateElement {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
	}
    }

    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)

    # 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 PlotScatterUpdateElement {varname} {
    upvar #0 $varname var
    global $varname

    set nn $var(data,current)
    set var($nn,discrete) $var(discrete)
    set var($nn,error) $var(error)

    $var(graph) element configure "d-${nn}" -hide [expr !$var(discrete)]

    foreach mk [$var(graph) marker names "m-${nn}*"] {
	$var(graph) marker configure $mk -hide [expr !$var(error)]
    }
}

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

    if {$var(data,total) == 0} {
	return
    }

    if {$var(callback) == {}} {
	return
    }

    # warning: uses d-1
    set rr [$var(graph) element closest $x $y]
    set el [lindex $rr 1]
    set row [lindex $rr 3]

    if {$row != {}} {
	if {$el == {d-1}} {
	    $var(graph) element deactivate d-1
	    $var(graph) element activate d-1 $row
	    # rows start at 1
	    eval "$var(callback) [expr $row+1]"
	}
    } else {
	$var(graph) element deactivate d-1
	eval "$var(callback) {}"
    }
}

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

    # warning: uses d-1
    if {$var(data,total) == 0} {
	return
    }

    if {$var(discrete)} {
	$var(graph) element deactivate d-1
	if {$rowlist != {}} {
	    # can have multiple rows
	    eval "$var(graph) element activate d-1 $rowlist"
	}
    }
}