diff options
Diffstat (limited to 'ipl/progs/extweave.icn')
-rw-r--r-- | ipl/progs/extweave.icn | 145 |
1 files changed, 145 insertions, 0 deletions
diff --git a/ipl/progs/extweave.icn b/ipl/progs/extweave.icn new file mode 100644 index 0000000..577318c --- /dev/null +++ b/ipl/progs/extweave.icn @@ -0,0 +1,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 |