summaryrefslogtreecommitdiffstats
path: root/ds9/library/ellipse.tcl
blob: 2307c7355e1b7b34fafe20b12c29151fb10de8b0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
#  Copyright (C) 1999-2018
#  Smithsonian Astrophysical Observatory, Cambridge, MA, USA
#  For conditions of distribution and use, see copyright notice in "copyright"

package provide DS9 1.0

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

    global pmarker

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

    # variables
    set rr [$var(frame) get wcs]
    set var(dcoord) [lindex $rr 0]
    set var(dformat) $pmarker(dformat)
    AdjustCoordSystem $varname dcoord
    set var(fill) [$var(frame) get marker $var(id) ellipse fill]

    # procs
    set var(proc,apply) EllipseApply
    set var(proc,close) EllipseClose
    set var(proc,coordCB) EllipseCoordCB

    # base
    MarkerBaseCenterDialog $varname

    # menu
    $var(mb).width add separator
    $var(mb).width add checkbutton -label [msgcat::mc {Fill}] \
	-variable ${varname}(fill) -command [list EllipseFill $varname]

    # analysis
    $var(mb) add cascade -label [msgcat::mc {Analysis}] -menu $var(mb).analysis
    menu $var(mb).analysis

    MarkerAnalysisStatsDialog $varname
    MarkerAnalysisHistogramDialog $varname
    MarkerAnalysisPlot3dDialog $varname

    # init
    EllipseEditCB $varname
    MarkerBaseCenterRotateCB $varname

    # callbacks
    $var(frame) marker $var(id) callback edit EllipseEditCB $varname
    $var(frame) marker $var(id) callback rotate \
	MarkerBaseCenterRotateCB $varname

    set f $var(top).param

    # Radius
    ttk::label $f.tradius -text Radius
    ttk::entry $f.radius1 -textvariable ${varname}(radius1) -width 13 
    ttk::entry $f.radius2 -textvariable ${varname}(radius2) -width 13 
    DistMenuButton $f.uradius $varname dcoord 1 dformat \
	[list EllipseEditCB $varname]
    DistMenuEnable $f.uradius.menu $varname dcoord 1 dformat

    # Angle
    ttk::label $f.tangle -text [msgcat::mc {Angle}]
    ttk::entry $f.angle -textvariable ${varname}(angle) -width 13 
    ttk::label $f.uangle -text [msgcat::mc {Degrees}]

    grid $f.tradius $f.radius1 $f.radius2 $f.uradius -padx 2 -pady 2 -sticky w
    grid $f.tangle $f.angle $f.uangle -padx 2 -pady 2 -sticky w
}

# actions

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

    $var(frame) marker $var(id) delete callback edit EllipseEditCB
    $var(frame) marker $var(id) delete callback rotate MarkerBaseCenterRotateCB

    MarkerBaseCenterClose $varname
}

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

    if {$var(radius1) != {} &&
	$var(radius2) !={}} {
	$var(frame) marker $var(id) ellipse radius \
	    $var(radius1) $var(radius2) $var(dcoord) $var(dformat)
    }

    MarkerBaseCenterRotate $varname
    MarkerBaseCenterApply $varname
}

# support

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

    $var(frame) marker $var(id) ellipse fill $var(fill)
}

# callbacks

proc EllipseCoordCB {varname {dummy {}}} {
    upvar #0 $varname var
    global $varname

    global debug
    if {$debug(tcl,marker)} {
	puts stderr "EllipseCoordCB"
    }

    MarkerAnalysisStatsSystem $varname
    MarkerAnalysisPlot3dSystem $varname
    MarkerBaseCoordCB $varname
    MarkerBaseCenterMoveCB $varname
    MarkerBaseCenterRotateCB $varname
}

proc EllipseEditCB {varname {dummy {}}} {
    upvar #0 $varname var
    global $varname

    global debug
    if {$debug(tcl,marker)} {
	puts stderr "EllipseEditCB"
    }

    set r [$var(frame) get marker $var(id) ellipse radius \
	       $var(dcoord) $var(dformat)]
    set var(radius1) [lindex $r 0]
    set var(radius2) [lindex $r 1]
}