summaryrefslogtreecommitdiffstats
path: root/ds9/library/nrrd.tcl
blob: e3246472c3f170259739f369b23616dea6d2fc54 (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
#  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 ImportNRRDFile {fn layer} {
    global loadParam

    set loadParam(file,type) nrrd
    set loadParam(file,mode) {}
    set loadParam(load,layer) $layer

    # find stdin
    if {[string range $fn 0 4] == "stdin" || 
	[string range $fn 0 4] == "STDIN" ||
	[string range $fn 0 0] == "-"} {
	set loadParam(load,type) alloc
	set loadParam(file,name) stdin
	set loadParam(file,fn) $loadParam(file,name)
    } else {
	set loadParam(load,type) mmap
	set loadParam(file,name) $fn
    }

    ProcessLoad
}

proc ImportNRRDAlloc {path fn layer} {
    global loadParam

    set loadParam(file,type) nrrd
    set loadParam(file,mode) {}
    set loadParam(load,type) alloc
    set loadParam(file,name) $fn
    set loadParam(file,fn) $path
    set loadParam(load,layer) $layer

    ProcessLoad
}

proc ImportNRRDSocket {sock fn layer} {
    global loadParam

    set loadParam(file,type) nrrd
    set loadParam(file,mode) {}
    set loadParam(load,type) socket
    set loadParam(file,name) $fn
    set loadParam(socket,id) $sock
    set loadParam(load,layer) $layer

    return [ProcessLoad 0]
}

proc ExportNRRDFile {fn opt} {
    global current

    if {$fn == {}} {
	return
    }
    if {$current(frame) == {}} {
	return
    }
    if {![$current(frame) has fits]} {
	return
    }

    $current(frame) save nrrd file "\{$fn\}" $opt
}

proc ExportNRRDSocket {sock opt} {
    global current

    if {$current(frame) == {}} {
	return
    }
    if {![$current(frame) has fits]} {
	return
    }

    $current(frame) save nrrd socket $sock $opt
}

proc ProcessNRRDCmd {varname iname sock fn} {
    upvar $varname var
    upvar $iname i

    global parse
    set parse(sock) $sock
    set parse(fn) $fn

    nrrd::YY_FLUSH_BUFFER
    nrrd::yy_scan_string [lrange $var $i end]
    nrrd::yyparse
    incr i [expr $nrrd::yycnt-1]
}

proc NRRDCmdLoad {param layer} {
    global parse
    
    if {$parse(sock) != {}} {
	# xpa
	if {![ImportNRRDSocket $parse(sock) $param $layer]} {
	    InitError xpa
	    ImportNRRDFile $param $layer
	}
    } else {
	# comm
	if {$parse(fn) != {}} {
	    ImportNRRDAlloc $parse(fn) $param $layer
	} else {
	    ImportNRRDFile $param $layer
	}
    }
    FinishLoad
}

proc ProcessSendNRRDCmd {proc id param sock fn} {
    global current

    if {$current(frame) == {}} {
	return
    }

    set opt [string tolower [lindex $param 0]]
    if {$sock != {}} {
	# xpa
	ExportNRRDSocket $sock $opt
    } elseif {$fn != {}} {
	# comm
	ExportNRRDFile $fn $opt
	$proc $id {} $fn
    }
}