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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
# 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 LoadMultiFrameFile {fn} {
set path {}
if {[string range $fn 0 4] == "stdin" ||
[string range $fn 0 4] == "STDIN" ||
[string range $fn 0 0] == "-"} {
set path [tmpnam {.fits}]
catch {
set ch [open "$path" w]
fconfigure stdin -translation binary -encoding binary
fconfigure $ch -translation binary -encoding binary
puts -nonewline $ch [read stdin]
close $ch
}
}
LoadMultiFrameAlloc $path $fn
}
proc LoadMultiFrameSocket {sock fn} {
set path [tmpnam {.fits}]
catch {
set ch [open "$path" w]
fconfigure $ch -translation binary -encoding binary
fconfigure $sock -translation binary -encoding binary
puts -nonewline $ch [read $sock]
close $ch
}
set rr [LoadMultiFrameAlloc $path $fn]
if {!$rr} {
if {$path != {}} {
catch {file delete -force $path}
}
}
return $rr
}
proc LoadMultiFrameAlloc {path fn} {
global loadParam
global current
global ds9
set ext 0
set cnt 0
set did 0
set need 0
# start with new frame?
if {$current(frame) != {}} {
switch -- [$current(frame) get type] {
base {
if {[$current(frame) has fits]} {
CreateFrame
set did 1
}
}
rgb -
3d {
CreateFrame
set did 1
}
}
} else {
CreateFrame
}
while {1} {
# create a new frame
if {$need} {
CreateFrame
set did 1
}
# ProcessLoad will clear loadParam each time
# can be gz, so use allocgz
set loadParam(file,type) fits
set loadParam(file,mode) {}
set loadParam(load,type) allocgz
set loadParam(load,layer) {}
if {$path != {}} {
set loadParam(file,name) "stdin\[$ext\]"
set loadParam(file,fn) "$path\[$ext\]"
} else {
set loadParam(file,name) "$fn\[$ext\]"
set loadParam(file,fn) "$fn\[$ext\]"
}
if {![ProcessLoad 0]} {
if {$ext} {
InitError xpa
if {$did} {
DeleteCurrentFrame
incr ds9(next,num) -1
}
if {!$cnt} {
Error "[msgcat::mc {Unable to load}] $loadParam(file,type) $loadParam(file,mode) $loadParam(file,name)"
return 0
}
break;
}
} else {
# ignore any bin tables
if {![$current(frame) has fits bin]} {
incr cnt
set need 1
} else {
set need 0
}
}
incr ext
}
if {$path != {}} {
catch {file delete -force $path}
}
# go into tile mode if more than one
if {$cnt && $current(display) != "tile"} {
set current(display) tile
DisplayMode
}
return 1
}
proc ProcessMultiFrameCmd {varname iname sock fn} {
upvar $varname var
upvar $iname i
global debug
if {$debug(tcl,parser)} {
global parse
set parse(sock) $sock
set parse(fn) $fn
multiframe::YY_FLUSH_BUFFER
multiframe::yy_scan_string [lrange $var $i end]
multiframe::yyparse
incr i [expr $multiframe::yycnt-1]
} else {
switch -- [string tolower [lindex $var $i]] {
new {
incr i
# not supported
}
mask {
incr i
# not supported
}
slice {
incr i
# not supported
}
}
set param [lindex $var $i]
if {$sock != {}} {
# xpa
global tcl_platform
switch $tcl_platform(os) {
Linux -
Darwin -
SunOS {
if {![LoadMultiFrameSocket $sock $param]} {
InitError xpa
LoadMultiFrameFile $param
}
}
{Windows NT} {LoadMultiFrameFile $param}
}
} else {
# comm
if {$fn != {}} {
LoadMultiFrameAlloc $fn $param
} else {
LoadMultiFrameFile $param
}
}
FinishLoad
}
}
proc MultiframeCmdLoad {param} {
global parse
if {$parse(sock) != {}} {
# xpa
global tcl_platform
switch $tcl_platform(os) {
Linux -
Darwin -
SunOS {
if {![LoadMultiFrameSocket $parse(sock) $param]} {
InitError xpa
LoadMultiFrameFile $param
}
}
{Windows NT} {LoadMultiFrameFile $param}
}
} else {
# comm
if {$parse(fn) != {}} {
LoadMultiFrameAlloc $parse(fn) $param
} else {
LoadMultiFrameFile $param
}
}
FinishLoad
}
|
