summaryrefslogtreecommitdiffstats
path: root/ds9/library/multiframe.tcl
blob: a9171c9427a4d1177af16a762550d64a0ed5a667 (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
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
#  Copyright (C) 1999-2017
#  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
	set loadParam(file,type) fits
	set loadParam(file,mode) {}
	if {$path != {}} {
	    set loadParam(load,type) allocgz
	    set loadParam(file,name) "stdin\[$ext\]"
	    set loadParam(file,fn) "$path\[$ext\]"
	} else {
	    set loadParam(load,type) mmapincr
	    set loadParam(file,name) "$fn\[$ext\]"
	}
	set loadParam(load,layer) {}

	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

    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
}