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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include "oif.h"
# IMFDIR -- Routines for setting or retrieving the "imdir" (pixel file storage
# directory) for IMFORT.
#
# im[sg]dir (dir) # set/get imdir - F77 versions
# imsdirx (dir) # set imdir - SPP version
# nch = imgdirx (dir, maxch) # get imdir - SPP version
#
# By default, pixel files are stored in the same directory as the header file,
# using a HDR$ pathname in the image header. If the user wishes they can
# explicitly set the directory into which all further pixel files will be
# placed, until another call to the set-imdir routine.
# IMSDIR -- Set the value of `imdir' for imfort.
procedure imsdir (dir)
% character*(*) dir
char imdir[SZ_PATHNAME]
common /imdcom/ imdir
begin
call imdinit()
call f77upk (dir, imdir, SZ_PATHNAME)
end
# IMGDIR -- Get the value of `imdir' for imfort.
procedure imgdir (dir)
% character*(*) dir
char imdir[SZ_PATHNAME]
common /imdcom/ imdir
begin
call imdinit()
call f77pak (imdir, dir, len(dir))
end
# IMSDIRX -- Set the value of `imdir' for imfort, SPP version.
procedure imsdirx (dir)
char dir[ARB] #I new value of imdir
char imdir[SZ_PATHNAME]
common /imdcom/ imdir
begin
call imdinit()
call strcpy (dir, imdir, SZ_PATHNAME)
end
# IMGDIRX -- Get the value of `imdir' for imfort, SPP version.
int procedure imgdirx (dir, maxch)
char dir[maxch] #O receives value of imdir
int maxch
int gstrcpy()
char imdir[SZ_PATHNAME]
common /imdcom/ imdir
begin
call imdinit()
return (gstrcpy (imdir, dir, maxch))
end
# IMDINIT -- Runtime initialization of the imdir common.
procedure imdinit()
int status
char envvar[5]
bool first_time
data first_time /true/
char imdir[SZ_PATHNAME]
common /imdcom/ imdir
begin
if (first_time) {
# Check the host environment for the default IMDIR.
call strpak ("imdir", envvar, 5)
call zgtenv (envvar, imdir, SZ_PATHNAME, status)
if (status < 0) {
call strpak ("IMDIR", envvar, 5)
call zgtenv (envvar, imdir, SZ_PATHNAME, status)
}
# Use the builtin default HDR$ if not defined in host enviroment.
if (status < 0)
call strcpy (HDR, imdir, SZ_PATHNAME)
else
call strupk (imdir, imdir, SZ_PATHNAME)
first_time = false
}
end
|
