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
|
############################################################################
#
# File: extweave.icn
#
# Subject: Program to extract weaving specifications from weave file
#
# Author: Ralph E. Griswold
#
# Date: September 17, 1998
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This program extracts the weaving specifications from a Macintosh
# Painter 5 weave file in MacBinary format. (It might work on Painter 4
# weave files; this has not been tested.)
#
# The file is read from standard input.
#
# The output consists of seven lines for each weaving specification in the
# file:
#
# wave name
# warp expression
# warp color expression
# weft expression
# weft color expression
# tie-up
# blank separator
#
# The tie-up is a 64-character string of 1s and 0s in column order. That
# is, the first 8 character represent the first column of the tie-up. A
# 1 indicates selection, 0, non-selection.
#
# This program does not produce the colors for the letters in color
# expressions. We know where they are located but haven't yet figured
# out how to match letters to colors.
#
# See Advanced Weaving, a PDF file on the Painter 5 CD-ROM.
#
############################################################################
$define Offset 401 # offset to the first expression
procedure main(args)
local hex, tieup, i, binary, expr, name, namechars, tartans_list
namechars := &letters ++ &digits ++ ' -&'
tartans_list := []
binary := ""
while binary ||:= reads(, 10000) # read the whole file
# Get names.
binary ? {
tab(find("FSWI") + 4) # find names
while tab(upto(namechars)) do { # not robust
name := tab(many(namechars))
if (*name > 3) | (name == "Op") then # "heuristic"
put(tartans_list, name)
tab(upto(namechars)) | break
tab(many(namechars))
}
}
binary ? {
move(400) | stop("delta move error")
hex := move(4400) | stop("short file")
write(get(tartans_list)) | stop("short name list")
hex ? { # get the four expressions
every i := (0 to 3) do {
tab(i * 2 ^ 10 + 1)
expr := tab(upto('\x00')) | stop("no null character")
if *expr = 0 then stop("no expression") # no expression
write(expr)
}
tieup := ""
tab(4101) # now the tie-up
every 1 to 8 do {
tieup ||:= map(move(8), "\x0\x1", "01")
move(24)
}
write(decol(tieup))
write()
}
}
binary ? {
while tab(find(".KWROYL")) do {
move(4908) | stop("delta move error")
hex := move(4400) | break
write(get(tartans_list)) | stop("short name list")
hex ? { # get the four expressions
every i := (0 to 3) do {
tab(i * 2 ^ 10 + 1)
expr := tab(upto('\x00')) | stop("no null character")
if *expr = 0 then break break # no expression
write(expr)
}
tieup := ""
tab(4101) # now the tie-up
every 1 to 8 do {
tieup ||:= map(move(8), "\x0\x1", "01")
move(24)
}
write(decol(tieup))
write()
}
}
}
if *tartans_list > 0 then {
write("Unresolved tartans:")
write()
while write(get(tartans_list))
}
end
procedure decol(s)
local parts, j, form
parts := list(8, "")
s ? {
repeat {
every j := 1 to 8 do {
(parts[j] ||:= move(1)) | break break
}
}
}
form := ""
every form ||:= !parts
return form
end
|
