Initial commit

1 files changed, 274 insertions, 0 deletions

diff --git a/ds9/library/markerbaseannulus.tcl b/ds9/library/markerbaseannulus.tcl
new file mode 100644
index 0000000..6253f8b
--- /dev/null
+++ b/ds9/library/markerbaseannulus.tcl
@@ -0,0 +1,274 @@
+#  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 MarkerBaseAnnulusDialog {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    set t [$var(frame) get marker $var(id) type]
+    switch -- $t {
+	ellipseannulus {set type "Ellipse Annulus"}
+	boxannulus {set type "Box Annulus"}
+	default {set type [string totitle $t]}
+    }
+
+    # variables
+    set rr [$var(frame) get wcs]
+    set var(system) [lindex $rr 0]
+    set var(sky) [lindex $rr 1]
+    set var(skyformat) [lindex $rr 2]
+    AdjustCoordSystem $varname system
+
+    set var(x) 0
+    set var(y) 0
+
+    # init
+    MarkerBaseTextCB $varname
+    MarkerBaseColorCB $varname
+    MarkerBaseLineWidthCB $varname
+    MarkerBasePropertyCB $varname
+    MarkerBaseFontCB $varname
+    $var(proc,coordCB) $varname
+
+    MarkerBaseCenterMoveCB $varname
+
+    # callbacks
+    $var(frame) marker $var(id) callback delete MarkerBaseDeleteCB $varname
+    $var(frame) marker $var(id) callback text MarkerBaseTextCB $varname
+    $var(frame) marker $var(id) callback color MarkerBaseColorCB $varname
+    $var(frame) marker $var(id) callback width MarkerBaseLineWidthCB $varname
+    $var(frame) marker $var(id) callback property MarkerBasePropertyCB $varname
+    $var(frame) marker $var(id) callback font MarkerBaseFontCB $varname
+
+    $var(frame) marker $var(id) callback move MarkerBaseCenterMoveCB $varname
+
+    # window
+    Toplevel $var(top) $var(mb) 6 [msgcat::mc "$type"] \
+	"$var(proc,close) $varname"
+
+    # menus
+    MarkerBaseMenu $varname
+    MarkerBaseAnnulusFileMenu $varname
+    EditMenu $var(mb) $varname
+    ColorMenu $var(mb).color $varname color [list MarkerBaseColor $varname]
+    WidthDashMenu $var(mb).width $varname linewidth dash \
+	[list MarkerBaseLineWidth $varname] \
+	[list MarkerBaseProperty $varname dash]
+    MarkerBasePropertyMenu $varname
+    FontMenu $var(mb).font $varname font font,size font,weight \
+	font,slant [list MarkerBaseFont $varname]
+
+    # Param
+    set f [ttk::labelframe $var(top).param -text [msgcat::mc "Parameters"] \
+	       -padding 2]
+
+    ttk::label $f.tid -text [msgcat::mc {Number}]
+    ttk::label $f.id -text "$var(id)"
+    ttk::label $f.ttext -text [msgcat::mc {Text}]
+    ttk::entry $f.text -textvariable ${varname}(text) -width 45
+    ttk::label $f.tcenter -text [msgcat::mc {Center}]
+    ttk::entry $f.centerx -textvariable ${varname}(x) -width 13
+    ttk::entry $f.centery -textvariable ${varname}(y) -width 13
+    CoordMenuButton $f.ucenter $varname system 1 sky skyformat \
+	[list $var(proc,coordCB) $varname]
+    CoordMenuEnable $f.ucenter.menu $varname system 1 sky skyformat
+
+    grid $f.tid $f.id -padx 2 -pady 2 -sticky w
+    grid $f.ttext $f.text - - - -padx 2 -pady 2 -sticky w
+    grid $f.tcenter $f.centerx $f.centery $f.ucenter \
+	-padx 2 -pady 2 -sticky w
+
+    # Buttons
+    set f [ttk::frame $var(top).buttons]
+    ttk::button $f.apply -text [msgcat::mc {Apply}] \
+	-command "$var(proc,apply) $varname"
+    ttk::button $f.generate -text [msgcat::mc {Generate}] \
+	-command "$var(proc,generate) $varname"
+    ttk::button $f.close -text [msgcat::mc {Close}] \
+	-command "$var(proc,close) $varname"
+    pack $f.apply $f.generate $f.close -side left -expand true -padx 2 -pady 4
+
+    bind $var(top) <Return> "$var(proc,apply) $varname"
+
+    # Fini
+    grid $var(top).param -sticky news
+    grid $var(top).buttons - - -sticky ew
+
+    # some window managers need a hint
+    raise $var(top)
+}
+
+proc MarkerBaseAnnulusFileMenu {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    menu $var(mb).file
+    $var(mb).file add command -label [msgcat::mc {Apply}] \
+	-command "$var(proc,apply) $varname"
+    $var(mb).file add command -label [msgcat::mc {Generate}] \
+	-command "$var(proc,generate) $varname"
+    $var(mb).file add separator
+    $var(mb).file add command -label [msgcat::mc {Close}] \
+	-command "$var(proc,close) $varname"
+}
+
+proc MarkerBaseAnnulusMethodMenu {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    $var(mb) add cascade -label [msgcat::mc {Method}] -menu $var(mb).method
+    menu $var(mb).method
+    $var(mb).method add radiobutton -label [msgcat::mc {Equal Distance}] \
+	-variable ${varname}(method) -value dist
+    $var(mb).method add radiobutton -label [msgcat::mc {Equal Area}] \
+	-variable ${varname}(method) -value area
+}
+
+proc MarkerBaseAnnulusGenerateCircle {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    $var(annulitxt) delete 1.0 end
+
+    if {$var(annuli) < 1} {
+	set var(annuli) 1
+    }
+
+    set inner $var(inner)
+    set outer $var(outer)
+    set annuli $var(annuli)
+
+    if {($inner != {}) && ($outer != {}) && ($annuli != {})} {
+	switch -- $var(method) {
+	    dist {
+		for {set i 0} {$i<=$annuli} {incr i} {
+		    $var(annulitxt) insert end \
+ 		    "[expr ((($outer-$inner)/double($annuli))*$i)+$inner]\n"
+		}
+	    }
+
+	    area {
+		set pi 3.14159265358979323846
+		set area [expr $pi*(($outer*$outer)-($inner*$inner))/$annuli]
+
+		set r0 $inner
+		$var(annulitxt) insert end "$r0\n"
+		for {set i 0} {$i<$annuli} {incr i} {
+		    set r1 [expr sqrt(($area+($pi*$r0*$r0))/$pi)]
+		    $var(annulitxt) insert end \
+			[format "%.4f\n" $r1]
+		    set r0 $r1
+		}
+	    }
+	}
+    }
+}
+
+proc MarkerBaseAnnulusGenerateEllipse {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    $var(annulitxt) delete 1.0 end
+
+    if {$var(annuli) < 1} {
+	set var(annuli) 1
+    }
+
+    set radius1 $var(radius1)
+    set radius2 $var(radius2)
+    set radius3 $var(radius3)
+    set annuli $var(annuli)
+
+    if {($radius1 != {}) && ($radius2 != {}) && \
+        ($radius3 != {}) && ($annuli != {})} {
+
+	switch -- $var(method) {
+	    dist {
+		for {set i 0} {$i<=$annuli} {incr i} {
+		    set major [expr ((($radius1-$radius3)/double($annuli))*$i)\
+				   +$radius3]
+		    set minor [expr $major*$radius2/$radius1]
+		    $var(annulitxt) insert end "$major $minor\n"
+		}
+	    }
+
+	    area {
+		set pi 3.14159265358979323846
+		set r [expr double($radius2)/$radius1]
+		set area [expr $pi*(($radius1*$radius2)-($radius3*$radius3*$r))\
+			      /$annuli]
+
+		set major0 $radius3
+		set minor0 [expr $radius3*$r]
+		$var(annulitxt) insert end "$major0 $minor0\n"
+		for {set i 0} {$i<$annuli} {incr i} {
+		    set major1 [expr sqrt(($area+($pi*$major0*$minor0)) / \
+					      ($pi*$r))]
+		    set minor1 [expr $major1*$r]
+		    $var(annulitxt) insert end \
+			[format "%.4f %.4f\n" $major1 $minor1]
+		    set major0 $major1
+		    set minor0 $minor1
+		}
+	    }
+	}
+    }
+}
+
+proc MarkerBaseAnnulusGenerateBox {varname} {
+    upvar #0 $varname var
+    global $varname
+
+    $var(annulitxt) delete 1.0 end
+
+    if {$var(annuli) < 1} {
+	set var(annuli) 1
+    }
+
+    set radius1 $var(radius1)
+    set radius2 $var(radius2)
+    set radius3 $var(radius3)
+    set annuli $var(annuli)
+
+    if {($radius1 != {}) && ($radius2 != {}) && \
+        ($radius3 != {}) && ($annuli != {})} {
+
+	if {$radius1<=0} {
+	    set radius1 1
+	}
+	if {$radius2<=0} {
+	    set radius2 1
+	}
+
+	switch -- $var(method) {
+	    dist {
+		for {set i 0} {$i<=$annuli} {incr i} {
+		    set major [expr ((($radius1-$radius3)/$annuli)*$i)+$radius3]
+		    set minor [expr $major*$radius2/$radius1]
+		    $var(annulitxt) insert end "$major $minor\n"
+		}
+	    }
+
+	    area {
+		set r [expr double($radius2)/$radius1]
+		set area [expr (($radius1*$radius2)-($radius3*$radius3*$r)) \
+			      /$annuli]
+
+		set major0 $radius3
+		set minor0 [expr $radius3*$r]
+		$var(annulitxt) insert end "$major0 $minor0\n"
+		for {set i 0} {$i<$annuli} {incr i} {
+		    set major1 [expr sqrt(($area+($major0*$minor0))/$r)]
+		    set minor1 [expr $major1*$r]
+		    $var(annulitxt) insert end \
+			[format "%.4f %.4f\n" $major1 $minor1]
+		    set major0 $major1
+		    set minor0 $minor1
+		}
+	    }
+	}
+    }
+}