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
|
include <evexpr.h>
include "keyselect.h"
#* HISTORY *
#* B.Simon 12-Mar-1992 Original
#* Phil Hodge 4-Mar-2002 Free memory allocated by evexpr.
# EVAL_EXPR -- Evaluate a boolean expression using image header keywords
bool procedure eval_expr (im, expr)
pointer im # i: image descriptor
char expr[ARB] # i: boolean expression
#--
include "keyselect.com"
pointer op, sp, errmsg
string badtype "Expression is not of boolean type"
string badname "Warning: header keyword %s not found in %s\n"
int errget()
pointer evexpr(), locpr()
extern fun_expr, var_expr
begin
call smark (sp)
call salloc (errmsg, SZ_LINE, TY_CHAR)
img = im
iferr {
op = evexpr (expr, locpr(var_expr), locpr (fun_expr))
} then {
if (errget(Memc[errmsg], SZ_LINE) == ERR_SYNTAX) {
call xer_reset
call error (ERR_SYNTAX, Memc[errmsg])
} else {
call xer_reset
call eprintf ("Warning: %s\n")
call pargstr (Memc[errmsg])
call mfree (op, TY_STRUCT)
return (false)
}
}
if (O_TYPE(op) != TY_BOOL)
call error (ERR_SYNTAX, badtype)
call xev_freeop (op)
call mfree (op, TY_STRUCT)
call sfree (sp)
return (O_VALB(op))
end
# FMT_EXPR -- Format an expression to make it easier to parse
procedure fmt_expr (expr)
char expr[ARB] # i: expression
#--
int ic, jc
begin
# Find first non-white character
for (ic = 1; expr[ic] != EOS; ic = ic + 1) {
if (expr[ic] > ' ')
break
}
# Copy remaining characters, replacing newlines with blanks
jc = 1
for ( ; expr[ic] != EOS; ic = ic + 1) {
if (expr[ic] == '\n') {
expr[jc] = ' '
} else if (jc < ic) {
expr[jc] = expr[ic]
}
jc = jc + 1
}
expr[jc] = EOS
end
# FUN_EXPR -- Evaluate non-standard functions used in expression
procedure fun_expr (func, argptr, nargs, op)
char func[ARB] # i: function name
pointer argptr[ARB] # i: pointers to function arguments
int nargs # i: number of function arguments
pointer op # o: structure containing function value
#--
include "keyselect.com"
int arg
pointer sp, errmsg
string flist "find"
string badfun "Unknown function name (%s)"
string badtyp "Invalid argument type for %s"
int word_match(), imaccf()
begin
call smark (sp)
call salloc (errmsg, SZ_LINE, TY_CHAR)
switch (word_match (func, flist)) {
case 0: # unrecognized function name
call sprintf (Memc[errmsg], SZ_LINE, badfun)
call pargstr (func)
call error (ERR_SYNTAX, Memc[errmsg])
case 1: # find keyword in header ?
call xev_initop (op, 0, TY_BOOL)
O_VALB(op) = true
do arg = 1, nargs {
if (O_TYPE(argptr[arg]) != TY_CHAR) {
call sprintf (Memc[errmsg], SZ_LINE, badtyp)
call pargstr (func)
call error (ERR_SYNTAX, Memc[errmsg])
}
if (imaccf (img, O_VALC(argptr[arg])) == NO)
O_VALB(op) = false
}
}
call sfree (sp)
end
# VAR_EXPR -- Retrieve keyword used in expression
procedure var_expr (name, op)
char name[ARB] # i: keyword name
pointer op # o: structure containing value of variable
#--
include "keyselect.com"
int ic, dtype, type, length, junk
pointer sp, value
string badname "Expression cannot be evaluated because keyword not found"
bool streq()
int ctoi(), ctor()
begin
call smark(sp)
call salloc (value, SZ_BIGCOL, TY_CHAR)
# Retrieve keyword value from image header
call get_keyword (img, name, dtype, Memc[value], SZ_BIGCOL)
# Allocate structure to hold value
if (dtype == 0) {
call error (ERR_NOFIND, badname)
} else if (dtype < 0) {
type = TY_CHAR
length = - dtype
} else {
type = dtype
length = 0
}
call xev_initop (op, length, type)
# Copy value to structure
switch (type) {
case TY_BOOL:
O_VALB(op) = streq (Memc[value], "yes")
case TY_CHAR:
call strcpy (Memc[value], O_VALC(op), length)
case TY_SHORT,TY_INT,TY_LONG:
ic = 1
junk = ctoi (Memc[value], ic, O_VALI(op))
case TY_REAL,TY_DOUBLE:
ic = 1
junk = ctor (Memc[value], ic, O_VALR(op))
}
call sfree(sp)
end
|
