summaryrefslogtreecommitdiff
path: root/ipl/gprogs/drawup.icn
blob: 4b9c0db09f0f3f209b9c31cfbc6d71c6bf3890cb (plain)
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
############################################################################
#
#	File:     drawup.icn
#
#	Subject:  Program to create draft from drawdown
#
#	Author:   Ralph E. Griswold
#
#	Date:     January 23, 2002
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This program produces an ISD from a bi-level image string or row file.
#
#  The following option is supported:
#
#	-n s	draft name, default "drawup"
#
#	-r	interpret input as row pattern; default image string
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################
#
#  Links:  options, patutils, patxform, weavutil, xcode
#
############################################################################

link options
link patutils
link patxform
link weavutil
link xcode

procedure main(args)
   local threading, treadling, rows, pattern, i
   local symbols, symbol, drawdown, draft, opts

   opts := options(args, "rn:")

   if \opts["r"] then {
      drawdown := []
      while put(drawdown, read())
      }
   else drawdown := pat2rows(read()) | stop("*** invalid input")

   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 := \opts["n"] | "drawup"
   draft.threading := threading.sequence
   draft.treadling := treadling.sequence
   draft.warp_colors := list(*threading.sequence, 1)
   draft.weft_colors := list(*treadling.sequence, 2)
   draft.color_list := ["black", "white"]
   draft.shafts := *threading.rows
   draft.treadles := *treadling.rows
   draft.tieup := rows

   xencode(draft, &output)

end