diff options
Diffstat (limited to 'ds9/library/catplot.tcl')
| -rw-r--r-- | ds9/library/catplot.tcl | 216 |
1 files changed, 216 insertions, 0 deletions
diff --git a/ds9/library/catplot.tcl b/ds9/library/catplot.tcl new file mode 100644 index 0000000..298b7a0 --- /dev/null +++ b/ds9/library/catplot.tcl @@ -0,0 +1,216 @@ +# Copyright (C) 1999-2016 +# Smithsonian Astrophysical Observatory, Cambridge, MA, USA +# For conditions of distribution and use, see copyright notice in "copyright" + +package provide DS9 1.0 + +proc CATPlot {varname} { + upvar #0 $varname var + global $varname + + # do we have a db? + if {![CATValidDB $var(tbldb)]} { + return + } + + if {$var(plot,x) == {}} { + set var(plot,x) "\$$var(colx)" + } + if {$var(plot,y) == {}} { + set var(plot,y) "\$$var(coly)" + } + + if {[CATPlotDialog $varname]} { + if {$var(plot,x) != {} && $var(plot,y) != {}} { + CATPlotGenerate $varname + } + } +} + +proc CATPlotGenerate {varname} { + upvar #0 $varname var + global $varname + + if {$var(plot,xerr) == {} && $var(plot,yerr) == {}} { + set dim xy + } elseif {$var(plot,xerr) != {} && $var(plot,yerr) == {}} { + set dim xyex + } elseif {$var(plot,xerr) == {} && $var(plot,yerr) != {}} { + set dim xyey + } else { + set dim xyexey + } + + global $var(tbldb) + set nrows [starbase_nrows $var(tbldb)] + set cols [starbase_columns $var(tbldb)] + + set rr {} + for {set ii 1} {$ii <= $nrows} {incr ii} { + foreach col $cols { + set val [starbase_get $var(tbldb) $ii \ + [starbase_colnum $var(tbldb) $col]] + # here's a tough one-- what to do if the col is blank + # for now, just set it to '0' + if {[string trim "$val"] == {}} { + set val 0 + } + eval "set \{$col\} \{$val\}" + } + + switch $dim { + xy {append rr [subst "$var(plot,x), $var(plot,y)\n"]} + xyex {append rr [subst "$var(plot,x), $var(plot,y), $var(plot,xerr)\n"]} + xyey {append rr [subst "$var(plot,x), $var(plot,y), $var(plot,yerr)\n"]} + xyexey {append rr [subst "$var(plot,x), $var(plot,y), $var(plot,xerr), $var(plot,yerr)\n"]} + } + } + + set xtitle [regsub -all {\$*} $var(plot,x) {}] + set ytitle [regsub -all {\$*} $var(plot,y) {}] + + set vvarname plot${varname} + upvar #0 $vvarname vvar + global $vvarname + + set ping [PlotPing $vvarname] + + if {!$ping} { + PlotScatterDialog $vvarname $var(title) {} {} {} + set vvar(callback) "CATSelectRows $varname plot" + set var(plot) 1 + set var(plot,var) $vvarname + } + + PlotClearData $vvarname + PlotDataSet $vvarname $dim $rr + PlotTitle $vvarname $var(title) $xtitle $ytitle + $vvar(proc,updategraph) $vvarname + PlotStats $vvarname + PlotList $vvarname +} + +proc CATPlotDialog {varname} { + upvar #0 $varname var + global $varname + global ds9 + global ed2 + + set w ".${varname}plot" + set mb ".${varname}plotmb" + + set ed2(ok) 0 + set ed2(x) $var(plot,x) + set ed2(xerr) $var(plot,xerr) + set ed2(y) $var(plot,y) + set ed2(yerr) $var(plot,yerr) + + DialogCreate $w [msgcat::mc {Plot}] ed2(ok) + + $w configure -menu $mb + menu $mb + + # file + $mb add cascade -label [msgcat::mc {File}] -menu $mb.file + menu $mb.file + $mb.file add command -label [msgcat::mc {Apply}] -command {set ed2(ok) 1} + $mb.file add command -label [msgcat::mc {Cancel}] -command {set ed2(ok) 0} + + # edit + $mb add cascade -label [msgcat::mc {Edit}] -menu $mb.edit + EditMenu $mb $varname + + # param + set f [ttk::frame $w.param] + + ttk::label $f.taxis -text {Axis} + ttk::label $f.terr -text {Error} + + ttk::label $f.tx -text {X} + ttk::entry $f.x -textvariable ed2(x) -width 21 + ttk::button $f.bx -text [msgcat::mc {Edit}] \ + -command "CATEditDialog ed2 x $var(catdb)" + ttk::entry $f.xerr -textvariable ed2(xerr) -width 21 + ttk::button $f.bxerr -text [msgcat::mc {Edit}] \ + -command "CATEditDialog ed2 xerr $var(catdb)" + ttk::menubutton $f.mx -text {Cols} -menu $f.mx.menu + ttk::menubutton $f.mxerr -text {Cols} -menu $f.mxerr.menu + + CATPlotDialogColsMenu $varname $f.mx x + CATPlotDialogColsMenu $varname $f.mxerr xerr + + ttk::label $f.ty -text {Y} + ttk::entry $f.y -textvariable ed2(y) -width 21 + ttk::button $f.by -text [msgcat::mc {Edit}] \ + -command "CATEditDialog ed2 y $var(catdb)" + ttk::entry $f.yerr -textvariable ed2(yerr) -width 21 + ttk::button $f.byerr -text [msgcat::mc {Edit}] \ + -command "CATEditDialog ed2 yerr $var(catdb)" + ttk::menubutton $f.my -text {Cols} -menu $f.my.menu + ttk::menubutton $f.myerr -text {Cols} -menu $f.myerr.menu + + CATPlotDialogColsMenu $varname $f.my y + CATPlotDialogColsMenu $varname $f.myerr yerr + + grid x $f.taxis x $f.terr -padx 2 -pady 2 -sticky ew + grid $f.tx $f.x $f.bx $f.xerr $f.bxerr -padx 2 -pady 2 -sticky ew + grid x $f.mx x $f.mxerr -padx 2 -pady 2 -sticky ew + grid $f.ty $f.y $f.by $f.yerr $f.byerr -padx 2 -pady 2 -sticky ew + grid x $f.my x $f.myerr -padx 2 -pady 2 -sticky ew + + # Buttons + set f [ttk::frame $w.buttons] + ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed2(ok) 1} \ + -default active + ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed2(ok) 0} + pack $f.ok $f.cancel -side left -expand true -padx 2 -pady 4 + + bind $w <Return> {set ed2(ok) 1} + + # Fini + ttk::separator $w.sep -orient horizontal + pack $w.param -side top -fill both -expand true + pack $w.buttons $w.sep -side bottom -fill x + + DialogCenter $w + DialogWait $w ed2(ok) $w.buttons.ok + + if {$ed2(ok)} { + set var(plot,x) $ed2(x) + set var(plot,xerr) $ed2(xerr) + set var(plot,y) $ed2(y) + set var(plot,yerr) $ed2(yerr) + } + + DialogDismiss $w + destroy $mb + + set rr $ed2(ok) + unset ed2 + return $rr +} + +proc CATPlotDialogColsMenu {varname f ww} { + upvar #0 $varname var + global $varname + global $var(catdb) + global ed2 + global ds9 + + set m $f.menu + + menu $m -tearoff 0 + if {[CATValidDB $var(catdb)]} { + set cnt -1 + foreach col [starbase_columns $var(catdb)] { + $m add command -label $col -command "set ed2($ww) \\$$col" + + # wrap if needed + incr cnt + if {$cnt>=$ds9(menu,size,wrap)} { + set cnt 0 + $m entryconfig $col -columnbreak 1 + } + } + } +} |