saods9-data 7.2+dfsg-4 / usr / share / saods9 / src / crop.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 CropDef {} {
    global crop
    global icrop

    set icrop(top) .cr
    set icrop(mb) .crmb

    set crop(lock) none

    set crop(system) wcs
    set crop(sky) fk5
    set crop(skyformat) degrees
    set crop(dcoord) wcs
    set crop(dformat) degrees
    set crop(rcoord) wcs
}

proc CropReset {} {
    global current

    if {$current(frame) != {}} {
	$current(frame) crop
	UpdateCrop $current(frame)
    }
}

proc ButtonCrop {which x y} {
    global rgb
    RGBEvalLock rgb(lock,crop) $which [list $which crop begin $x $y]
}

proc MotionCrop {which x y} {
    $which crop motion $x $y
}

proc ReleaseCrop {which x y} {
    global rgb
    RGBEvalLock rgb(lock,crop) $which [list $which crop end $x $y]
    UpdateCrop $which
}

proc ButtonCrop3d {which x y zz} {
    $which crop 3d begin $x $y $zz
}

proc MotionCrop3d {which x y zz} {
    $which crop 3d motion $x $y $zz
}

proc ReleaseCrop3d {which x y zz} {
    $which crop 3d end $x $y $zz
    UpdateCrop $which
}

proc UpdateCrop {which} {
    global current

    global debug
    if {$debug(tcl,update)} {
	puts stderr "UpdateCrop"
    }

    LockCrop $which
    UpdateGraphXAxis $which
    UpdateCropDialog
    UpdateCubeDialog
    UpdateScaleDialog
    UpdateMain
    GridUpdateZoom
}

proc CropDialog {} {
    global crop
    global icrop
    global dcrop
    global ds9
    global current

    # see if we already have a window visible
    if [winfo exists $icrop(top)] {
	raise $icrop(top)
	return
    }

    # create the window
    set w $icrop(top)
    set mb $icrop(mb)

    Toplevel $w $mb 6 [msgcat::mc {Crop Parameters}] \
	CropDestroyDialog

    # for CoordMenuButton
    set crop(frame) $current(frame)

    $mb add cascade -label [msgcat::mc {File}] -menu $mb.file
    $mb add cascade -label [msgcat::mc {Edit}] -menu $mb.edit

    menu $mb.file
    $mb.file add command -label [msgcat::mc {Apply}] -command CropApplyDialog
    $mb.file add separator
    $mb.file add command -label [msgcat::mc {Reset}] -command CropReset
    $mb.file add separator
    $mb.file add command -label [msgcat::mc {Close}] -command CropDestroyDialog

    EditMenu $mb icrop

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

    ttk::label $f.title -text [msgcat::mc {Center}]
    ttk::entry $f.x -textvariable dcrop(x) -width 14
    ttk::entry $f.y -textvariable dcrop(y) -width 14
    set dcrop(cb) $f.center 
    CoordMenuButton $dcrop(cb) crop system 1 sky skyformat UpdateCropDialog

    ttk::label $f.stitle -text [msgcat::mc {Size}]
    ttk::entry $f.w -textvariable dcrop(w) -width 14
    ttk::entry $f.h -textvariable dcrop(h) -width 14
    set dcrop(db) $f.size 
    DistMenuButton $dcrop(db) crop dcoord 1 dformat UpdateCropDialog

    ttk::label $f.rtitle -text [msgcat::mc {3D}]
    ttk::entry $f.from -textvariable dcrop(zmin) -width 14
    ttk::entry $f.to -textvariable dcrop(zmax) -width 14
    set dcrop(rb) $f.range
    CoordMenuButton $dcrop(rb) crop rcoord 2 {} {} UpdateCropDialog

    grid $f.title $f.x $f.y $dcrop(cb) -padx 2 -pady 2
    grid $f.stitle $f.w $f.h $dcrop(db) -padx 2 -pady 2

    # Buttons
    set f [ttk::frame $w.buttons]
    ttk::button $f.apply -text [msgcat::mc {Apply}] -command CropApplyDialog
    ttk::button $f.reset -text [msgcat::mc {Reset}] -command CropReset
    ttk::button $f.close -text [msgcat::mc {Close}] \
	-command CropDestroyDialog
    pack $f.apply $f.reset $f.close -side left -expand true -padx 2 -pady 4

    # 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

    $w.param.x select range 0 end

    UpdateCropDialog
}

proc CropApplyDialog {} {
    global crop
    global icrop
    global dcrop
    global current

    if {$current(frame) != {}} {
	$current(frame) crop center $dcrop(x) $dcrop(y) \
	    $crop(system) $crop(sky) \
	    $dcrop(w) $dcrop(h) $crop(dcoord) $crop(dformat)

	if {[$current(frame) has fits cube]} {
	    $current(frame) crop 3d $dcrop(zmin) $dcrop(zmax) $crop(rcoord)
	}
	UpdateCrop $current(frame)
    }
}

proc CropDestroyDialog {} {
    global icrop
    global dcrop

    if {[winfo exists $icrop(top)]} {
	destroy $icrop(top)
	destroy $icrop(mb)
    }

    unset dcrop
}

proc UpdateCropMenu {} {
    # can be changed by wcs
    SetCoordSystem crop system sky skyformat
}

proc UpdateCropDialog {} {
    global crop
    global icrop
    global dcrop
    global current

    global debug
    if {$debug(tcl,update)} {
	puts stderr "UpdateCropDialog"
    }

    if {![winfo exists $icrop(top)]} {
	return
    }

    set w $icrop(top)

    if {$current(frame) != {}} {
	set crop(frame) $current(frame)

	if {[$current(frame) has fits]} {
	    # now make sure we have the coord systems
	    AdjustCoordSystem crop system
	    CoordMenuEnable $dcrop(cb).menu crop system 1 sky skyformat
	    CoordMenuButtonCmd crop system sky {}

	    AdjustCoordSystem crop dcoord
	    DistMenuEnable $dcrop(db).menu crop dcoord 1 dformat
	    DistMenuButtonCmd crop dcoord dformat {}

	    AdjustCoordSystem3d crop rcoord
	    CoordMenuEnable $dcrop(rb).menu crop rcoord 2 {} {}
	    CoordMenuButtonCmd crop rcoord {} {}

	    set rr [$current(frame) get crop center \
			$crop(system) $crop(sky) $crop(skyformat) \
			$crop(dcoord) $crop(dformat)]
	    set dcrop(x) [lindex $rr 0]
	    set dcrop(y) [lindex $rr 1]
	    set dcrop(w) [lindex $rr 2]
	    set dcrop(h) [lindex $rr 3]

	    if {[$current(frame) has fits cube]} {
		set ss [$current(frame) get crop 3d $crop(rcoord)]
		set dcrop(zmin) [lindex $ss 0]
		set dcrop(zmax) [lindex $ss 1]

		grid $w.param.rtitle $w.param.from $w.param.to $dcrop(rb) \
		    -padx 2 -pady 2
	    } else {
		set dcrop(zmin) {}
		set dcrop(zmax) {}

		grid forget $w.param.rtitle $w.param.from $w.param.to $dcrop(rb)
	    }

	    return
	}
    }

    grid forget $w.param.rtitle $w.param.from $w.param.to $dcrop(rb)

    CoordMenuReset $dcrop(cb).menu crop system 1 sky skyformat
    DistMenuReset $dcrop(db).menu crop dcoord 1 dformat
    CoordMenuReset $dcrop(rb).menu crop rcoord 2 {} {}

    set dcrop(x) {}
    set dcrop(y) {}
    set dcrop(w) {}
    set dcrop(h) {}
    set dcrop(zmin) {}
    set dcrop(zmax) {}
}

proc MatchCropCurrent {sys} {
    global current

    if {$current(frame) != {}} {
	MatchCrop $current(frame) $sys
    }
}

proc MatchCrop {which sys} {
    global ds9
    global rgb

    # make sure matrices have been updated
    RealizeDS9

    set tt [$which has crop]
    set datasec [$which get datasec]

    if {$tt} {
	switch -- $sys {
	    image -
	    physical -
	    amplifier -
	    detector {
		set rr [$which get crop center $sys fk5 degrees $sys degrees]
		set r(x) [lindex $rr 0]
		set r(y) [lindex $rr 1]
		set r(w) [lindex $rr 2]
		set r(h) [lindex $rr 3]
		set qq [$which get crop 3d image]

		foreach ff $ds9(frames) {
		    if {$ff != $which} {
			RGBEvalLock rgb(lock,crop) $ff [list $ff datasec $datasec]
			RGBEvalLock rgb(lock,crop) $ff [list $ff crop center $r(x) $r(y) $sys fk5 $r(w) $r(h) $sys degrees]
			RGBEvalLock rgb(lock,crop) $ff [list $ff crop 3d $qq image]
		    }
		}
	    }
	    wcs {
		set ss [lindex [$which get wcs] 0]
		if {[$which has wcs $ss]} {
		    set rr [$which get crop center $ss fk5 degrees $ss degrees]
		    set r(x) [lindex $rr 0]
		    set r(y) [lindex $rr 1]
		    set r(w) [lindex $rr 2]
		    set r(h) [lindex $rr 3]
		    set qq [$which get crop 3d $ss]

		    foreach ff $ds9(frames) {
			if {$ff != $which} {
			    if {[$ff has wcs $ss]} {
				RGBEvalLock rgb(lock,crop) $ff [list $ff crop center $r(x) $r(y) $ss fk5 $r(w) $r(h) $ss degrees]
				RGBEvalLock rgb(lock,crop) $ff [list $ff crop 3d $qq $ss]
			    }
			}
		    }
		}
	    }
	}
    } else {
	foreach ff $ds9(frames) {
	    if {$ff != $which} {
		RGBEvalLock rgb(lock,crop) $ff [list $ff crop]
		RGBEvalLock rgb(lock,crop) $ff [list $ff crop 3d]
	    }
	}
    }
}

proc LockCropCurrent {} {
    global current
    
    if {$current(frame) != {}} {
	LockCrop $current(frame)
    }
}

proc LockCrop {which} {
    global crop

    switch -- $crop(lock) {
	none {}
	default {MatchCrop $which $crop(lock)}
    }
}

proc CropBackup {ch which} {
    switch [$which get type] {
	base -
	3d {CropBackupBase $ch $which}
	rgb {CropBackupRGB $ch $which}
    }
}

proc CropBackupBase {ch which} {
    if {[$which has crop]} {
	set rr [$which get crop physical fk5 degrees] 
	puts $ch "$which crop $rr physical fk5"

	if {[$which has fits cube]} {
	    set ss [$which get crop 3d image]
	    puts $ch "$which crop 3d $ss image"
	}
    }
}

proc CropBackupRGB {ch which} {
    set sav [$which get rgb channel]
    foreach cc {red green blue} {
	$which rgb channel $cc
	puts $ch "$which rgb channel $cc"
	CropBackupBase $ch $which
    }
    $which rgb channel $sav
    puts $ch "$which rgb channel $sav"
}

# Process Cmds

proc ProcessCropCmd {varname iname} {
    upvar $varname var
    upvar $iname i

    # we need to be realized
    ProcessRealizeDS9

    global crop
    global current
    switch -- [string tolower [lindex $var $i]] {
	match {
	    incr i
	    MatchCropCurrent [lindex $var $i]
	}
	lock {
	    incr i
	    set crop(lock) [lindex $var $i]
	    LockCropCurrent
	}
	open {CropDialog}
	close {CropDestroyDialog}
	reset {CropReset}
	3d {
	    incr i 1
	    set zmin [lindex $var [expr $i+0]]
	    set zmax [lindex $var [expr $i+1]]
	    set sys [lindex $var [expr $i+2]]

	    incr i 1
	    incr i [FixSpecSystem sys physical]

	    $current(frame) crop 3d $zmin $zmax $sys
	}
	default {
	    set x [lindex $var [expr $i+0]]
	    set y [lindex $var [expr $i+1]]
	    set w [lindex $var [expr $i+2]]
	    set h [lindex $var [expr $i+3]]
	    set sys [lindex $var [expr $i+4]]
	    set sky [lindex $var [expr $i+5]]
	    set dformat [lindex $var [expr $i+6]]

	    incr i 3
	    incr i [FixSpec sys sky dformat physical fk5 degrees]

	    $current(frame) crop center $x $y $sys $sky $w $h $sys $dformat
	}
    }
}

proc ProcessSendCropCmd {proc id param} {
    global crop
    global current

    switch -- [string tolower [lindex $param 0]] {
	lock {$proc $id "$crop(lock)\n"}
	3d {
	    set sys [lindex $param 1]
	    FixSpecSystem sys physical

	    if {$current(frame) != {}} {
		$proc $id "[$current(frame) get crop 3d $sys]\n"
	    }
	}
	default {
	    set sys [lindex $param 0]
	    set sky [lindex $param 1]
	    set format [lindex $param 2]
	    set dformat [lindex $param 3]
	    FixSpec sys sky format physical fk5 degrees
	    
	    if {$current(frame) != {}} {
		$proc $id "[$current(frame) get crop center $sys $sky $format $sys $dformat]\n"
	    }
	}
    }
}