saods9-data 7.2+dfsg-4 / usr / share / saods9 / src / plotprocess.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 ProcessPlotCmd {xarname iname buf fn} {
    upvar $xarname xar
    upvar $iname i

    global iap
    set varname $iap(tt)
    set id 0

    # check for next command line option
    if {[string range [lindex $xar $i] 0 0] != {-}} {

	# determine which plot
	switch -- [string tolower [lindex $xar $i]] {
	    {} -
	    bar -
	    scatter -
	    new {}

	    data -
	    load -
	    save -
	    clear -
	    loadconfig -
	    saveconfig -
	    print -
	    page -
	    pagesetup -
	    close -

	    graph -
	    font -
	    dataset -
	    view -
	    color -
	    line {
		set varname [lindex $iap(windows) end]
		set id [lsearch $iap(windows) $varname]
	    }

	    default {
		set varname [lindex $xar $i]
		set id [lsearch $iap(windows) $varname]
		incr i
	    }
	}
    }

    # we better have a tt by now
    if {$id == -1} {
	Error "[msgcat::mc {Unable to find plot window}] $varname"
	return
    }

    upvar #0 $varname var
    global $varname

    # check for next command line option
    if {[string range [lindex $xar $i] 0 0] != {-}} {

	# now, process plot command
	switch -- [string tolower [lindex $xar $i]] {
	    {} -
	    bar -
	    scatter {
		if {$buf != {}} {
		    ProcessPlotNew $varname $xarname $iname $buf
		} elseif {$fn != {}} {
		    if {[file exists $fn]} {
			set ch [open $fn r]
			set txt [read $ch]
			close $ch
			ProcessPlotNew $varname $xarname $iname $txt
		    }
		} else {
		    ProcessPlotNew $varname $xarname $iname {}
		}
	    }
	    new {
		incr i
		switch -- [lindex $xar $i] {
		    name {
			set varname [lindex $xar [expr $i+1]]
			incr i 2
		    }
		}
		if {$buf != {}} {
		    ProcessPlotNew $varname $xarname $iname $buf
		} elseif {$fn != {}} {
		    if {[file exists $fn]} {
			set ch [open $fn r]
			set txt [read $ch]
			close $ch
			ProcessPlotNew $varname $xarname $iname $txt
		    }
		} else {
		    ProcessPlotNew $varname $xarname $iname {}
		}
	    }
	    data {
		incr i
		if {$buf != {}} {
		    ProcessPlotData $varname $xarname $iname $buf
		} elseif {$fn != {}} {
		    if {[file exists $fn]} {
			set ch [open $fn r]
			set txt [read $ch]
			close $ch
			ProcessPlotData $varname $xarname $iname $txt
		    }
		}
	    }
	    load {
		set ff [lindex $xar [expr $i+1]]
		set dim [lindex $xar [expr $i+2]]
		incr i 2
		PlotLoadDataFile $varname $ff $dim
		FileLast apdatafbox $ff
	    }
	    save {
		incr i
		set ff [lindex $xar $i]
		PlotSaveDataFile $varname $ff
		FileLast apdatafbox $ff
	    }
	    clear {
		PlotClearData $varname
	    }
	    loadconfig {
		incr i
		set ff [lindex $xar $i]
		PlotLoadConfigFile $varname $ff
		FileLast apconfigfbox $ff
	    }
	    saveconfig {
		incr i
		set ff [lindex $xar $i]
		PlotSaveConfigFile $varname $ff
		FileLast apconfigfbox $ff
	    }
	    print {
		incr i
		ProcessPlotPrint $varname $xarname $iname
	    }
	    page -
	    pagesetup {
		incr i
		ProcessPlotPageSetup $varname $xarname $iname
	    }
	    close {
		PlotDestroy $varname
	    }

	    graph {
		incr i
		ProcessPlotGraph $varname $xarname $iname
	    }
	    font {
		incr i
		ProcessPlotFont $varname $xarname $iname
	    }
	    dataset {
		incr i
		PlotProcessDataset $varname $xarname $iname
	    }
	    view {
		incr i
		PlotProcessView $varname $xarname $iname
	    }
	    color {
		incr i
		PlotProcessColor $varname $xarname $iname
	    }
	    line {
		incr i
		PlotProcessLine $varname $xarname $iname
	    }
	}
    } else {
	ProcessPlotNew $varname $xarname $iname {}
    }
}

proc ProcessSendPlotCmd {proc id param} {
    global iap
    $proc $id "$iap(windows)\n"
}

proc ProcessPlotNew {varname xarname iname buf} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    # check for next command line option
    if {[string range [lindex $xar $i] 0 0] != {-}} {
	switch -- [string tolower [lindex $xar $i]] {
	    line {incr i; ProcessPlotNewOne line $varname $xarname $iname $buf}
	    bar {incr i;ProcessPlotNewOne bar $varname $xarname $iname $buf}
	    scatter {incr i;ProcessPlotNewOne scatter $varname $xarname $iname $buf}
	    default {ProcessPlotNewOne line $varname $xarname $iname $buf}
	}
    } else {
	PlotLine $varname {} {} {} {} xy $buf
	incr i -1
    }
}

proc ProcessPlotNewOne {which varname xarname iname buf} {
    upvar #0 $varname var
    global $varname

    upvar 3 $xarname xar
    upvar 3 $iname i

    if {[string range [lindex $xar $i] 0 0] != {-}} {
	switch -- [string tolower [lindex $xar $i]] {
	    stdin {incr i; AnalysisPlotStdin $which $varname {} $buf}
	    {} {
		switch $which {
		    line {PlotLine $varname {} {} {} {} xy $buf}
		    bar {PlotBar $varname {} {} {} {} xy $buf}
		    scatter {PlotScatter $varname {} {} {} {} xy $buf}
		}
	    }
	    default {
		switch $which {
		    line {
			PlotLine $varname {} \
			    [lindex $xar $i] \
			    [lindex $xar [expr $i+1]] \
			    [lindex $xar [expr $i+2]] \
			    [lindex $xar [expr $i+3]] \
			    $buf
		    }
		    bar {
			PlotBar $varname {} \
			    [lindex $xar $i] \
			    [lindex $xar [expr $i+1]] \
			    [lindex $xar [expr $i+2]] \
			    [lindex $xar [expr $i+3]] \
			    $buf
		    }
		    scatter {
			PlotScatter $varname {} \
			    [lindex $xar $i] \
			    [lindex $xar [expr $i+1]] \
			    [lindex $xar [expr $i+2]] \
			    [lindex $xar [expr $i+3]] \
			    $buf
		    }
		}
		incr i 3
	    }
	}
    } else {
	switch $which {
	    line {PlotLine $varname {} {} {} {} xy $buf}
	    bar {PlotBar $varname {} {} {} {} xy $buf}
	    scatter {PlotScatter $varname {} {} {} {} xy $buf}
	}
	incr i -1
    }
}

proc ProcessPlotData {varname xarname iname buf} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    PlotRaise $varname
    PlotDataSet $varname [lindex $xar $i] $buf
    $var(proc,updategraph) $varname
    PlotStats $varname
    PlotList $varname
}

proc ProcessPlotPrint {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    global ps
    global current

    switch -- [string tolower [lindex $xar $i]] {
	destination {incr i; set ps(dest) [lindex $xar $i]}
	command {incr i; set ps(cmd) [lindex $xar $i]}
	filename {incr i; set ps(filename) [lindex $xar $i] }
	palette -
	color {incr i; set ps(color) [lindex $xar $i] }

	{} {PlotPostScript $varname}
	default {incr i -1; PlotPostScript $varname}
    }
}

proc ProcessPlotPageSetup {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    global ps

    switch -- [string tolower [lindex $xar $i]] {
	orientation -
	orient {incr i; set ps(orient) [lindex $xar $i]}
	pagesize -
	size {incr i; set ps(size) [lindex $xar $i] }
    }
}

proc ProcessPlotGraph  {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    switch -- [string tolower [lindex $xar $i]] {
	scale {
	    # backward compatibility
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		linearlinear {
		    set var(graph,x,log) 0
		    set var(graph,y,log) 0
		}
		linearlog {
		    set var(graph,x,log) 0
		    set var(graph,y,log) 1
		}
		loglinear {
		    set var(graph,x,log) 1
		    set var(graph,y,log) 0
		}
		loglog {
		    set var(graph,x,log) 1
		    set var(graph,y,log) 1
		}
	    }
	    $var(proc,updategraph) $varname
	}
	grid {
	    incr i; 
	    switch -- [string tolower [lindex $xar $i]] {
		x {
		    incr i; 
		    set var(graph,x,grid) [FromYesNo [lindex $xar $i]]
		}
		y {
		    incr i; 
		    set var(graph,y,grid) [FromYesNo [lindex $xar $i]]
		}
		default {
		    # backward compatibility
		    set var(graph,y,grid) [FromYesNo [lindex $xar $i]]
		    set var(graph,x,grid) [FromYesNo [lindex $xar $i]]
		}
	    }
	    $var(proc,updategraph) $varname
	}
	log {
	    incr i; 
	    switch -- [string tolower [lindex $xar $i]] {
		x {
		    incr i; 
		    set var(graph,x,log) [FromYesNo [lindex $xar $i]]
		}
		y {
		    incr i; 
		    set var(graph,y,log) [FromYesNo [lindex $xar $i]]
		}
	    }
	    $var(proc,updategraph) $varname
	}
	flip {
	    incr i; 
	    switch -- [string tolower [lindex $xar $i]] {
		x {
		    incr i; 
		    set var(graph,x,flip) [FromYesNo [lindex $xar $i]]
		}
		y {
		    incr i; 
		    set var(graph,y,flip) [FromYesNo [lindex $xar $i]]
		}
	    }
	    $var(proc,updategraph) $varname
	}
	format {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		x {incr i; set var(graph,x,format) [lindex $xar $i]}
		y {incr i; set var(graph,y,format) [lindex $xar $i]}
	    }
	    $var(proc,updategraph) $varname
	}
	range {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		x {
		    incr i
		    switch -- [string tolower [lindex $xar $i]] {
			auto {incr i; set var(graph,x,auto) \
				  [FromYesNo [lindex $xar $i]]}
			min {incr i; set var(graph,x,min) [lindex $xar $i]}
			max {incr i; set var(graph,x,max) [lindex $xar $i]}
		    }
		}
		y {
		    incr i
		    switch -- [string tolower [lindex $xar $i]] {
			auto {incr i; set var(graph,y,auto) \
				  [FromYesNo [lindex $xar $i]]}
			min {incr i; set var(graph,y,min) [lindex $xar $i]}
			max {incr i; set var(graph,y,max) [lindex $xar $i]}
		    }
		}
	    }
	    $var(proc,updategraph) $varname
	}
	labels {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		title {incr i; set var(graph,title) [lindex $xar $i]}
		xaxis {incr i; set var(graph,xaxis) [lindex $xar $i]}
		yaxis {incr i; set var(graph,yaxis) [lindex $xar $i]}
	    }
	    $var(proc,updategraph) $varname
	}
    }
}

proc ProcessPlotFont  {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    switch -- [string tolower [lindex $xar $i]] {
	numbers {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		font {incr i; set var(numlabFont) [lindex $xar $i]}
		size {incr i; set var(numlabSize) [lindex $xar $i]}
		weight {incr i; set var(numlabWeight) [lindex $xar $i]}
		slant {incr i; set var(numlabSlant) [lindex $xar $i]}
		style {
		    incr i
		    switch [string tolower [lindex $xar $i]] {
			normal {
			    set var(numlabWeight) normal
			    set var(numlabSlant) roman
			}
			bold {
			    set var(numlabWeight) bold
			    set var(numlabSlant) roman
			}
			italic {
			    set var(numlabWeight) normal
			    set var(numlabSlant) italic
			}
		    }
		}
	    }
	}
	labels {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		font {incr i; set var(textlabFont) [lindex $xar $i]}
		size {incr i; set var(textlabSize) [lindex $xar $i]}
		weight {incr i; set var(textlabWeight) [lindex $xar $i]}
		slant {incr i; set var(textlabSlant) [lindex $xar $i]}
		style {
		    incr i
		    switch [string tolower [lindex $xar $i]] {
			normal {
			    set var(textlabWeight) normal
			    set var(textlabSlant) roman
			}
			bold {
			    set var(textlabWeight) bold
			    set var(textlabSlant) roman
			}
			italic {
			    set var(textlabWeight) normal
			    set var(textlabSlant) italic
			}
		    }
		}
	    }
	}
	title {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		font {incr i; set var(titleFont) [lindex $xar $i]}
		size {incr i; set var(titleSize) [lindex $xar $i]}
		weight {incr i; set var(titleWeight) [lindex $xar $i]}
		slant {incr i; set var(titleSlant) [lindex $xar $i]}
		style {
		    incr i
		    switch [string tolower [lindex $xar $i]] {
			normal {
			    set var(titleWeight) normal
			    set var(titleSlant) roman
			}
			bold {
			    set var(titleWeight) bold
			    set var(titleSlant) roman
			}
			italic {
			    set var(titleWeight) normal
			    set var(titleSlant) italic
			}
		    }
		}
	    }
	}
    }
    $var(proc,updategraph) $varname
}

proc PlotProcessDataset  {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    set  var(data,current) [lindex $xar $i]
    PlotCurrentData $varname
}

proc PlotProcessView  {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    switch -- [string tolower [lindex $xar $i]] {
	discrete {incr i; set var(discrete) [FromYesNo [lindex $xar $i]]}
	line -
	linear {incr i; set var(linear) [FromYesNo [lindex $xar $i]]}
	step {incr i; set var(step) [FromYesNo [lindex $xar $i]]}
	quadratic {incr i; set var(quadratic) [FromYesNo [lindex $xar $i]]}
	error -
	errorbar {incr i; set var(error) [FromYesNo [lindex $xar $i]]}
    }

    $var(proc,updateelement) $varname
}

proc PlotProcessColor  {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    switch -- [string tolower [lindex $xar $i]] {
	discrete {
	    incr i
	    set var(discrete,color) [lindex $xar $i]
	    PlotUpdateElementDiscrete $varname
	}
	line -
	linear {
	    incr i
	    set var(linear,color) [lindex $xar $i]
	    PlotUpdateElementLinear $varname
	}
	step {
	    incr i
	    set var(step,color) [lindex $xar $i]
	    PlotUpdateElementStep $varname
	}
	quadratic {
	    incr i
	    set var(quadratic,color) [lindex $xar $i]
	    PlotUpdateElementQuadratic $varname
	}
	error -
	errorbar {
	    incr i
	    set var(error,color) [lindex $xar $i]
	    PlotUpdateElementError $varname
	}
	bar {
	    incr i
	    set var(bar,color) [lindex $xar $i]
	    PlotUpdateElementBar $varname
	}
    }
}

proc PlotProcessLine  {varname xarname iname} {
    upvar #0 $varname var
    global $varname

    upvar 2 $xarname xar
    upvar 2 $iname i

    switch -- [string tolower [lindex $xar $i]] {
	discrete {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		symbol {
		    incr i
		    set var(discrete,symbol) [lindex $xar $i]
		}
		fill {
		    incr i
		    set var(linear,fill) [lindex $xar $i]}
		default {
		    set var(discrete,symbol) [lindex $xar $i]
		}
	    }
	    PlotUpdateElementDiscrete $varname
	}
	line -
	linear {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		width {incr i; set var(linear,width) [lindex $xar $i]}
		dash {
		    incr i
		    set var(linear,dash) [lindex $xar $i]}
	    }
	    PlotUpdateElementLinear $varname
	}
	step {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		width {incr i; set var(step,width) [lindex $xar $i]}
		dash {
		    incr i
		    set var(step,dash) [lindex $xar $i]}
	    }
	    PlotUpdateElementStep $varname
	}
	quadratic {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		width {incr i; set var(quadratic,width) [lindex $xar $i]}
		dash {
		    incr i
		    set var(quadratic,dash) [lindex $xar $i]}
	    }
	    PlotUpdateElementQuadratic $varname
	}
	error -
	errorbar {
	    incr i
	    switch -- [string tolower [lindex $xar $i]] {
		width {incr i; set var(error,width) [lindex $xar $i]}
		style {
		    # backward compatibility
		    incr i;
		}
	    }
	    PlotUpdateElementError $varname
	}
    }
}