saods9-data 7.2+dfsg-4 / usr / share / saods9 / src / plotdialog.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 PlotDialog {varname wtt title xaxis yaxis} {
    upvar #0 $varname var
    global $varname

    global ds9
    global pap

    if {[PlotRaise $varname]} {
	return
    }

    # add it to our xpa list
    global iap
    lappend iap(windows) $varname

    set var(top) ".${varname}"
    set var(mb) ".${varname}mb"
    set var(stats) 0
    set var(list) 0

    set var(mode) zoom
    set var(callback) {}

    set var(data,total) 0
    set var(data,current) 0

    set var(xdata) {}
    set var(ydata) {}
    set var(xedata) {}
    set var(yedata) {}

    set var(graph,title) "$title"
    set var(graph,xaxis) "$xaxis"
    set var(graph,yaxis) "$yaxis"

    set var(graph,x,auto) 1
    set var(graph,x,min) {}
    set var(graph,x,max) {}
    set var(graph,y,auto) 1
    set var(graph,y,min) {}
    set var(graph,y,max) {}

    # can be turned off for external line plots
    set var(graph,format) 1
    set var(graph,x,format) {}
    set var(graph,y,format) {}

    set var(graph,x,grid) $pap(graph,x,grid)
    set var(graph,x,log) $pap(graph,x,log) 
    set var(graph,x,flip) $pap(graph,x,flip) 
    set var(graph,y,grid) $pap(graph,y,grid)
    set var(graph,y,log) $pap(graph,y,log) 
    set var(graph,y,flip) $pap(graph,y,flip) 

    set var(titleFont) $pap(titleFont) 
    set var(titleSize) $pap(titleSize) 
    set var(titleWeight) $pap(titleWeight) 
    set var(titleSlant) $pap(titleSlant) 

    set var(textlabFont) $pap(textlabFont) 
    set var(textlabSize) $pap(textlabSize) 
    set var(textlabWeight) $pap(textlabWeight) 
    set var(textlabSlant) $pap(textlabSlant) 

    set var(numlabFont) $pap(numlabFont) 
    set var(numlabSize) $pap(numlabSize) 
    set var(numlabWeight) $pap(numlabWeight)
    set var(numlabSlant) $pap(numlabSlant)

    set var(discrete,symbol) $pap(discrete,symbol) 
    set var(discrete,fill) $pap(discrete,fill) 
    set var(discrete,color) $pap(discrete,color) 

    set var(linear,width) $pap(linear,width) 
    set var(linear,color) $pap(linear,color) 
    set var(linear,dash) $pap(linear,dash) 

    set var(step,width) $pap(step,width) 
    set var(step,color) $pap(step,color) 
    set var(step,dash) $pap(step,dash) 

    set var(quadratic,width) $pap(quadratic,width) 
    set var(quadratic,color) $pap(quadratic,color) 
    set var(quadratic,dash) $pap(quadratic,dash) 

    set var(error,width) $pap(error,width) 
    set var(error,color) $pap(error,color) 

    set var(bar,color) $pap(bar,color) 

    # create window
    Toplevel $var(top) $var(mb) 7 $wtt [list PlotDestroy $varname]

    $var(mb) add cascade -label [msgcat::mc {File}] -menu $var(mb).file
    $var(mb) add cascade -label [msgcat::mc {Edit}] -menu $var(mb).edit
    $var(mb) add cascade -label [msgcat::mc {Graph}] -menu $var(mb).graph
    $var(mb) add cascade -label [msgcat::mc {Element}] -menu $var(mb).element
    $var(mb) add cascade -label [msgcat::mc {Dataset}] -menu $var(mb).dataset

    menu $var(mb).file
    $var(mb).file add command -label "[msgcat::mc {Load Data}]..." \
	-command [list PlotLoadData $varname]
    $var(mb).file add command -label "[msgcat::mc {Save Data}]..." \
	-command [list PlotSaveData $varname]
    $var(mb).file add command -label [msgcat::mc {Clear Data}] \
	-command [list PlotClearData $varname]
    $var(mb).file add separator
    $var(mb).file add command -label [msgcat::mc {Duplicate Data}] \
	-command [list PlotDupData $varname 1]
    $var(mb).file add separator
    $var(mb).file add command -label [msgcat::mc {Statistics}] \
	-command "set ${varname}(stats) 1; PlotStats $varname"
    $var(mb).file add command -label [msgcat::mc {List Data}] \
	-command "set ${varname}(list) 1; PlotList $varname"
    $var(mb).file add separator
    $var(mb).file add command -label "[msgcat::mc {Load Configuration}]..." \
	-command [list PlotLoadConfig $varname]
    $var(mb).file add command -label "[msgcat::mc {Save Configuration}]..." \
	-command [list PlotSaveConfig $varname]
    $var(mb).file add separator
    switch $ds9(wm) {
	x11 {
	    $var(mb).file add command \
		-label "[msgcat::mc {Page Setup}]..." \
		-command PSPageSetup
	    $var(mb).file add command -label "[msgcat::mc {Print}]..." \
		-command [list PlotPSPrint $varname]
	}
	win32 -
	aqua {
	    $var(mb).file add command \
		-label "[msgcat::mc {Postscript Page Setup}]..." \
		-command PSPageSetup
	    $var(mb).file add command \
		-label "[msgcat::mc {Postscript Print}]..." \
		-command [list PlotPSPrint $varname]
	}
    }
    $var(mb).file add separator
    $var(mb).file add command -label [msgcat::mc {Close}] \
	-command [list PlotDestroy $varname]

    menu $var(mb).edit
    $var(mb).edit add command -label [msgcat::mc {Cut}] \
	-state disabled -accelerator "${ds9(ctrl)}X"
    $var(mb).edit add command -label [msgcat::mc {Copy}] \
	-state disabled -accelerator "${ds9(ctrl)}C"
    $var(mb).edit add command -label [msgcat::mc {Paste}] \
	-state disabled -accelerator "${ds9(ctrl)}V"
    $var(mb).edit add command -label [msgcat::mc {Clear}] \
	-state disabled
    $var(mb).edit add separator
    $var(mb).edit add radiobutton -label [msgcat::mc {Pointer}] \
	-variable ${varname}(mode) -value pointer \
	-command [list PlotChangeMode $varname]
    $var(mb).edit add radiobutton -label [msgcat::mc {Zoom}] \
	-variable ${varname}(mode) -value zoom \
	-command [list PlotChangeMode $varname]

    # Graph
    menu $var(mb).graph
    $var(mb).graph add cascade -label [msgcat::mc {Axes}] \
	-menu $var(mb).graph.axes
    $var(mb).graph add cascade -label [msgcat::mc {Font}] \
	-menu $var(mb).graph.font
    $var(mb).graph add separator
    $var(mb).graph add command -label "[msgcat::mc {Range}]..." \
	-command [list PlotRangeDialog $varname]
    $var(mb).graph add command -label "[msgcat::mc {Title}]..." \
	-command [list PlotTitleDialog $varname]

    menu $var(mb).graph.axes
    $var(mb).graph.axes add checkbutton -label [msgcat::mc {X Grid}] \
	-variable ${varname}(graph,x,grid) \
	-command [list $var(proc,updategraph) $varname]
    $var(mb).graph.axes add checkbutton -label [msgcat::mc {Log}] \
	-variable ${varname}(graph,x,log) \
	-command [list $var(proc,updategraph) $varname]
    $var(mb).graph.axes add checkbutton -label [msgcat::mc {Flip}] \
	-variable ${varname}(graph,x,flip) \
	-command [list $var(proc,updategraph) $varname]
    $var(mb).graph.axes add separator
    $var(mb).graph.axes add checkbutton -label [msgcat::mc {Y Grid}] \
	-variable ${varname}(graph,y,grid) \
	-command [list $var(proc,updategraph) $varname]
    $var(mb).graph.axes add checkbutton -label [msgcat::mc {Log}] \
	-variable ${varname}(graph,y,log) \
	-command [list $var(proc,updategraph) $varname]
    $var(mb).graph.axes add checkbutton -label [msgcat::mc {Flip}] \
	-variable ${varname}(graph,y,flip) \
	-command [list $var(proc,updategraph) $varname]

    menu $var(mb).graph.font
    $var(mb).graph.font add cascade -label [msgcat::mc {Axes Number}] \
	-menu $var(mb).graph.font.numlab
    $var(mb).graph.font add cascade -label [msgcat::mc {Axes Title}] \
	-menu $var(mb).graph.font.textlab
    $var(mb).graph.font add cascade -label [msgcat::mc {Title}] \
	-menu $var(mb).graph.font.title

    FontMenu $var(mb).graph.font.numlab $varname numlabFont numlabSize \
	numlabWeight numlabSlant [list $var(proc,updategraph) $varname]
    FontMenu $var(mb).graph.font.textlab $varname textlabFont textlabSize \
	textlabWeight textlabSlant [list $var(proc,updategraph) $varname]
    FontMenu $var(mb).graph.font.title $varname titleFont titleSize \
	titleWeight titleSlant [list $var(proc,updategraph) $varname]

    # element
    menu $var(mb).element

    # dataset
    menu $var(mb).dataset
}

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

    global ds9

    blt::RemoveBindTag $var(graph) zoom-$var(graph)
    bind $var(graph) <1> {}

    switch $var(mode) {
	pointer {bind $var(graph) <1> [list PlotButton $varname %x %y]}
	zoom {
	    switch $ds9(wm) {
		x11 -
		win32 {Blt_ZoomStack $var(graph) -mode release}
		aqua {Blt_ZoomStack $var(graph) -mode release "ButtonPress-1" "ButtonPress-2"}
	    }
	}
    }
}

proc PlotCreateLineMenu {which var1 var2 cmd} {
    menu $which
    $which add radiobutton -label 1 -variable $var1 -value 1 -command $cmd
    $which add radiobutton -label 2 -variable $var1 -value 2 -command $cmd
    $which add radiobutton -label 3 -variable $var1 -value 3 -command $cmd
    $which add radiobutton -label 4 -variable $var1 -value 4 -command $cmd
    $which add separator
    $which add checkbutton -label [msgcat::mc {Dash}] -variable $var2 \
	-onvalue {yes} -offvalue {no} -command $cmd
}

proc PlotLineSymbolMenu {which var} {
    menu $which
    $which add radiobutton -label [msgcat::mc {Circle}] \
	-variable $var -value circle
    $which add radiobutton -label [msgcat::mc {Diamond}]  \
	-variable $var -value diamond
    $which add radiobutton -label [msgcat::mc {Plus}]  \
	-variable $var -value plus
    $which add radiobutton -label [msgcat::mc {Cross}]  \
	-variable $var -value cross
}

proc PlotLineWidthMenu {which var} {
    menu $which
    $which add radiobutton -label 0 -variable $var -value 0
    $which add radiobutton -label 1 -variable $var -value 1
    $which add radiobutton -label 2 -variable $var -value 2
    $which add radiobutton -label 3 -variable $var -value 3
}

proc PlotLineDashMenu {which var} {
    menu $which
    $which add radiobutton -label [msgcat::mc {No}] -variable $var \
	-value no
    $which add radiobutton -label [msgcat::mc {Yes}]  -variable $var \
	-value yes
}

proc PlotDataFormatDialog {xarname} {
    upvar $xarname xar
    global ed

    set w {.apdata}

    set ed(ok) 0
    set ed(dim) $xar

    DialogCreate $w [msgcat::mc {Data Format}] ed(ok)

    # Param
    set f [ttk::frame $w.param]

    ttk::label $f.title -text [msgcat::mc {Data Format}]
    ttk::radiobutton $f.xy -text {X Y} -variable ed(dim) -value xy
    ttk::radiobutton $f.xyex -text {X Y XErr} -variable ed(dim) -value xyex
    ttk::radiobutton $f.xyey -text {X Y YErr} -variable ed(dim) -value xyey
    ttk::radiobutton $f.xyexey -text {X Y XErr YErr} -variable ed(dim) \
	-value xyexey

    grid $f.title -padx 2 -pady 2 -sticky w
    grid $f.xy -padx 2 -pady 2 -sticky w
    grid $f.xyex -padx 2 -pady 2 -sticky w
    grid $f.xyey -padx 2 -pady 2 -sticky w
    grid $f.xyexey -padx 2 -pady 2 -sticky w

    # Buttons
    set f [ttk::frame $w.buttons]
    ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed(ok) 1} \
	-default active 
    ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed(ok) 0}
    pack $f.ok $f.cancel -side left -expand true -padx 2 -pady 4

    bind $w <Return> {set ed(ok) 1}

    # Fini
    ttk::separator $w.sep -orient horizontal
    pack $w.buttons $w.sep -side bottom -fill x
    pack $w.param -side top -fill both -expand true

    DialogCenter $w 
    DialogWait $w ed(ok) $w.param.xy
    DialogDismiss $w

    if {$ed(ok)} {
	set xar $ed(dim)
    }

    set rr $ed(ok)
    unset ed
    return $rr
}

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

    global ed

    set w {.aptitle}

    set ed(ok) 0

    set ed(x,auto) $var(graph,x,auto)
    set ed(x,min) $var(graph,x,min)
    set ed(x,max) $var(graph,x,max)
    set ed(x,format) $var(graph,x,format)

    set ed(y,auto) $var(graph,y,auto)
    set ed(y,min) $var(graph,y,min)
    set ed(y,max) $var(graph,y,max)
    set ed(y,format) $var(graph,y,format)

    DialogCreate $w [msgcat::mc {Range}] ed(ok)

    # Param
    set f [ttk::frame $w.param]
    ttk::label $f.t -text [msgcat::mc {Axis}]
    ttk::label $f.tto -text [msgcat::mc {To}]
    ttk::label $f.tfrom -text [msgcat::mc {From}]
    ttk::label $f.tformat -text [msgcat::mc {Format}]
    ttk::label $f.tauto -text [msgcat::mc {Automatic}]

    ttk::label $f.x -text [msgcat::mc {X}]
    ttk::entry $f.xmin -textvariable ed(x,min) -width 12
    ttk::entry $f.xmax -textvariable ed(x,max) -width 12
    ttk::entry $f.xformat -textvariable ed(format,x) -width 8
    ttk::checkbutton $f.xauto -variable ed(x,auto)

    ttk::label $f.y -text [msgcat::mc {Y}]
    ttk::entry $f.ymin -textvariable ed(y,min) -width 12
    ttk::entry $f.ymax -textvariable ed(y,max) -width 12
    ttk::entry $f.yformat -textvariable ed(format,y) -width 8
    ttk::checkbutton $f.yauto -variable ed(y,auto)

    grid $f.t $f.tfrom $f.tto $f.tformat $f.tauto -padx 2 -pady 2 -sticky w
    grid $f.x $f.xmin $f.xmax $f.xformat $f.xauto -padx 2 -pady 2 -sticky w
    grid $f.y $f.ymin $f.ymax $f.yformat $f.yauto -padx 2 -pady 2 -sticky w

    # Buttons
    set f [ttk::frame $w.buttons]
    ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed(ok) 1} \
	-default active 
    ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed(ok) 0}
    pack $f.ok $f.cancel -side left -expand true -padx 2 -pady 4

    bind $w <Return> {set ed(ok) 1}

    # Fini
    ttk::separator $w.sep -orient horizontal
    pack $w.buttons $w.sep -side bottom -fill x
    pack $w.param -side top -fill both -expand true

    DialogCenter $w 
    DialogWait $w ed(ok) $w.param.xmin
    DialogDismiss $w

    if {$ed(ok)} {
	set var(graph,x,auto) $ed(x,auto)
	set var(graph,x,min) $ed(x,min) 
	set var(graph,x,max) $ed(x,max) 
	set var(graph,x,format) $ed(x,format)

	set var(graph,y,auto) $ed(y,auto)
	set var(graph,y,min) $ed(y,min) 
	set var(graph,y,max) $ed(y,max) 
	set var(graph,y,format) $ed(y,format)

	$var(proc,updategraph) $varname
    }
    
    set rr $ed(ok)
    unset ed
    return $rr
}

proc PlotTitleDialog {varname} {
    upvar #0 $varname var
    global $varname
    global ed

    set w {.aptitle}

    set ed(ok) 0
    set ed(title) $var(graph,title)
    set ed(xaxis) $var(graph,xaxis)
    set ed(yaxis) $var(graph,yaxis)

    DialogCreate $w [msgcat::mc {Title}] ed(ok)

    # Param
    set f [ttk::frame $w.param]
    ttk::label $f.label -text [msgcat::mc {Plot Title}]
    ttk::entry $f.title -textvariable ed(title) -width 30
    ttk::label $f.xlabel -text [msgcat::mc {X Axis Title}]
    ttk::entry $f.xtitle -textvariable ed(xaxis) -width 30
    ttk::label $f.ylabel -text [msgcat::mc {Y Axis Title}]
    ttk::entry $f.ytitle -textvariable ed(yaxis) -width 30

    grid $f.label $f.title -padx 2 -pady 2 -sticky ew
    grid $f.xlabel $f.xtitle -padx 2 -pady 2 -sticky ew
    grid $f.ylabel $f.ytitle -padx 2 -pady 2 -sticky ew
    grid columnconfigure $f 1 -weight 1

    # Buttons
    set f [ttk::frame $w.buttons]
    ttk::button $f.ok -text [msgcat::mc {OK}] -command {set ed(ok) 1} \
	-default active 
    ttk::button $f.cancel -text [msgcat::mc {Cancel}] -command {set ed(ok) 0}
    pack $f.ok $f.cancel -side left -expand true -padx 2 -pady 4

    bind $w <Return> {set ed(ok) 1}

    # Fini
    ttk::separator $w.sep -orient horizontal
    pack $w.buttons $w.sep -side bottom -fill x
    pack $w.param -side top -fill both -expand true

    DialogCenter $w 
    DialogWait $w ed(ok) $w.param.title
    DialogDismiss $w

    if {$ed(ok)} {
	set var(graph,title) $ed(title)
	set var(graph,xaxis) $ed(xaxis)
	set var(graph,yaxis) $ed(yaxis)

	$var(proc,updategraph) $varname
    }
    
    set rr $ed(ok)
    unset ed
    return $rr
}

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

    $var(proc,button) $varname $x $y
}