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
|
include <error.h>
include <mach.h>
include "idsmtn.h"
# UNPK_VN_ID -- Unpack an ID string from an array of FORTH ascii characters,
# one 7-bit character per byte. The first byte contains the character
# count for the string.
procedure unpk_vn_id (varian, offset, output_string)
int varian[ARB] # Array with one byte per int
int offset # Word offset to first character to be unpacked
char output_string[SZ_IDS_ID] # Output array - one character per element
pointer sp, id
int nchars_id
begin
call smark (sp)
nchars_id = min (varian[offset], SZ_IDS_ID-1)
call salloc (id, nchars_id, TY_CHAR)
call achtic (varian[offset+1], Memc[id], nchars_id)
call strcpy (Memc[id], output_string, nchars_id)
call sfree (sp)
end
# VN_RRAW -- Read Varian long (32-bit) integers from a packed bit array.
# Raw pixels are written as Varian long integers. Each pixel is
# 32-bits with bit 1 least significant, bit 16 unused and bit 32 the
# sign bit. The bits are extracted and reassembled to form a real array of
# IDS pixels, one pixel per array element.
procedure vn_rraw (varian, offset, pixels, nwords)
int varian[ARB] # Pointer to array of packed IDS record
int offset # Word offset to first word to unpack
real pixels[nwords] # Output array of unpacked IDS pixels
int nwords # Number of values to unpack
int ip, op, bytes[4], int_value
include "lut.com"
begin
ip = offset
for (op = 1; op <= nwords; op = op + 1) {
call amovi (varian[ip], bytes, 4)
if (bytes[1] < 127)
int_value = bytes[4] + (bytes[3] * (2 ** 8)) + (bytes[2] *
(2 ** 15)) + (bytes[1] * (2 ** 23))
else {
bytes[1] = neg_lut8[bytes[1]] * (2 ** 23)
bytes[2] = neg_lut8[bytes[2]] * (2 ** 15)
bytes[3] = neg_lut7[bytes[3]] * (2 ** 8)
bytes[4] = neg_lut8[bytes[4]]
int_value = -1 * (bytes[1] + bytes[2] + bytes[3] + bytes[4] + 1)
}
pixels[op] = real (int_value)
ip = ip + 4
}
end
# VN_RRED -- Read 32-bit floating point pixels from a packed bit array.
# The values are written in special (Jan Schwitters) 2 word Varian floating
# point. Reduced pixels are written in this format.
procedure vn_rred (varian, offset, pixels, nwords)
int varian[ARB] # Array of packed varian values
int offset # Word offset to first value to unpack
real pixels[nwords] # Output array of unpacked values
int nwords # Number of values to unpack
int ip, op, mantissa, exp, bytes[4]
include "lut.com"
include "powersof2.com"
begin
ip = offset
do op = 1, nwords {
call amovi (varian[ip], bytes, 4)
if (mod (bytes[1], 2) == 0)
mantissa = bytes[4] + (bytes[3] * (2**8)) + (bytes[2] * (2**15))
else {
bytes[4] = neg_lut8[bytes[4]]
bytes[3] = neg_lut7[bytes[3]] * (2 ** 8)
bytes[2] = neg_lut8[bytes[2]] * (2 ** 15)
mantissa = -1 * (bytes[4] + bytes[3] + bytes[2] + 1)
}
# Divide out mantissa sign bit
exp = bytes[1]/2
if (bytes[1] > 127)
exp = -1 * (neg_lut6[exp] + 1)
# Reconstruct the floating point number as a SPP real. Powers of
# two are stored in the tbl[] array where 2 ** n = tbl[n + 129].
# The mantissa is divided by 2 ** 23 to move the binary point
# above bit 23.
exp = exp + 129 - 23
if (exp <= 0)
pixels[op] = 0.0
else if (exp > 255)
pixels[op] = MAX_REAL
else if (exp > 0 && exp <= 255)
pixels[op] = real (mantissa) * tbl [exp]
# Increment the input pointer for the next word to be unpacked
ip = ip + 4
}
end
|
