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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
# 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 VectorDialog {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(arrow) [$var(frame) get marker $var(id) vector arrow]
# procs
set var(which) vector
set var(proc,apply) VectorApply
set var(proc,close) VectorClose
set var(proc,coordCB) VectorCoordCB
set var(proc,editCB) VectorEditCB
set var(proc,distCB) VectorDistCB
# base
MarkerBaseDialog $varname
# analysis
$var(mb) add cascade -label [msgcat::mc {Analysis}] -menu $var(mb).analysis
menu $var(mb).analysis
# plot2d
MarkerAnalysisPlot2dDialog $varname
# raise plot?
global marker
set var(plot2d) $marker(plot2d)
# init
VectorDistCB $varname
# callbacks
$var(frame) marker $var(id) callback move "VectorEditCB" $varname
$var(frame) marker $var(id) callback edit "VectorEditCB" $varname
set f $var(top).param
# Point
ttk::label $f.tpt -text [msgcat::mc {Point}]
ttk::entry $f.x -textvariable ${varname}(x) -width 13
ttk::entry $f.y -textvariable ${varname}(y) -width 13
CoordMenuButton $f.upt $varname system 1 sky skyformat \
[list $var(proc,coordCB) $varname]
# Length
ttk::label $f.tdist -text [msgcat::mc {Length}]
ttk::entry $f.dist -textvariable ${varname}(dist) -width 13
DistMenuButton $f.udist $varname dcoord 1 dformat \
[list VectorDistCB $varname]
DistMenuEnable $f.udist.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}]
# Arrow
ttk::label $f.tarrow -text [msgcat::mc {Arrow}]
ttk::checkbutton $f.arrow -variable ${varname}(arrow) \
-command "VectorArrow $varname"
grid $f.tpt $f.x $f.y $f.upt -padx 2 -pady 2 -sticky w
grid $f.tdist $f.dist $f.udist -padx 2 -pady 2 -sticky w
grid $f.tangle $f.angle $f.uangle -padx 2 -pady 2 -sticky w
grid $f.tarrow $f.arrow -padx 2 -pady 2 -sticky w
}
# actions
proc VectorClose {varname} {
upvar #0 $varname var
global $varname
$var(frame) marker $var(id) delete callback move "VectorEditCB"
$var(frame) marker $var(id) delete callback edit "VectorEditCB"
MarkerBaseClose $varname
}
proc VectorApply {varname} {
upvar #0 $varname var
global $varname
$var(frame) marker $var(id) vector point $var(system) $var(sky) \
$var(x) $var(y) $var(dcoord) $var(dformat) $var(dist) $var(angle)
MarkerBaseLineApply $varname
}
proc VectorArrow {varname} {
upvar #0 $varname var
global $varname
$var(frame) marker $var(id) vector arrow $var(arrow)
}
# callbacks
proc VectorCoordCB {varname {dummy {}}} {
upvar #0 $varname var
global $varname
global debug
if {$debug(tcl,marker)} {
puts stderr "VectorCoordCB"
}
MarkerAnalysisPlot2dSystem $varname
MarkerBaseCoordCB $varname
VectorEditCB $varname
}
proc VectorEditCB {varname {dummy {}}} {
upvar #0 $varname var
global $varname
global debug
if {$debug(tcl,marker)} {
puts stderr "VectorEditCB"
}
set p [$var(frame) get marker $var(id) vector point \
$var(system) $var(sky) $var(skyformat)]
set var(x) [lindex $p 0]
set var(y) [lindex $p 1]
set var(dist) [$var(frame) get marker $var(id) vector length \
$var(dcoord) $var(dformat)]
set var(angle) [$var(frame) get marker $var(id) angle \
$var(system) $var(sky)]
}
proc VectorDistCB {varname {dummy {}}} {
upvar #0 $varname var
global $varname
global debug
if {$debug(tcl,marker)} {
puts stderr "VectorDistCB"
}
set var(dist) [$var(frame) get marker $var(id) vector length \
$var(dcoord) $var(dformat)]
}
|
