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
|
############################################################################
#
# File: colorup.icn
#
# Subject: Program to produce a weave structure from unravel data
#
# Author: Ralph E. Griswold
#
# Date: April 18, 2000
#
############################################################################
#
# This file is in the public domain.
#
#############################################################################
#
# Input is expected to be the output of unravel -r.
#
#############################################################################
#
# This program takes information from a image solved by unravel.icn to
# produce a draft.
#
# The option -o i determines how optional choices at intersections are
# handled:
#
# 0 random (default)
# 1 warp
# 2 weft
# 3 alternating
#
############################################################################
#
# Links: numbers, options, weavutil, patxform, patutils, xcode
#
############################################################################
link numbers
link options
link patutils
link patxform
link weavutil
link xcode
link ximage
procedure main(args)
local warp, weft, pattern, rows, i, j, count, opts
local threading, treadling, color_list, colors, choice
local symbols, symbol, drawdown, draft, warp_colors, weft_colors, pixels
opts := options(args, "o+")
choice := opts["o"] | 0
(warp := read() & weft := read() & pattern := read()) |
stop("*** short file")
pixels := real(*pattern)
colors := warp ++ weft
color_list := []
every put(color_list, PaletteColor("c1", !colors))
warp_colors := []
every put(warp_colors, upto(!warp, colors))
weft_colors := []
every put(weft_colors, upto(!weft, colors))
drawdown := []
pattern ? {
while put(drawdown, move(*warp))
}
count := 0
every i := 1 to *weft do { # row
every j := 1 to *warp do { # column
if weft[i] == warp[j] then { # option point
count +:= 1
drawdown[i, j] := case choice of {
0 : ?2 - 1 # random
1 : "1" # warp
2 : "0" # weft
3 : if count % 2 = 0 then "1" else "2" # alternative
}
}
else if drawdown[i, j] == weft[i] then drawdown[i, j] := "0"
else drawdown[i, j] := "1"
}
}
treadling := analyze(drawdown)
drawdown := protate(drawdown, "cw")
threading := analyze(drawdown)
symbols := table("")
every pattern := !treadling.patterns do {
symbol := treadling.rows[pattern]
symbols[symbol] := repl("0", *threading.rows)
pattern ? {
every i := upto('1') do
symbols[symbol][threading.sequence[i]] := "1"
}
}
symbols := sort(symbols, 3)
rows := []
while get(symbols) do
put(rows, get(symbols))
draft := isd()
draft.name := "colorup"
draft.threading := threading.sequence
draft.treadling := treadling.sequence
draft.warp_colors := warp_colors
draft.weft_colors := weft_colors
draft.color_list := color_list
draft.shafts := *threading.rows
draft.treadles := *treadling.rows
draft.tieup := rows
xencode(draft, &output)
end
|
