1 files changed, 111 insertions, 0 deletions
diff --git a/ipl/gprogs/dd2draft.icn b/ipl/gprogs/dd2draft.icn
new file mode 100644
index 0000000..f98c247
--- /dev/null
+++ b/ipl/gprogs/dd2draft.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     dd2draft.icn
+#
+#	Subject:  Program to create draft information from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 16, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a drawdown in terms of rows of zeros and ones from
+#  standard input and outputs draft information in textual form.
+#
+#  It also accepts BLPs as input.
+#
+############################################################################
+#
+#   Links:  patutils. patxform
+#
+############################################################################
+
+link patutils
+link patxform
+
+record analysis(rows, sequence, patterns)
+
+procedure main()
+   local threading, treadling, rows, columns,  pattern, i
+   local symbols, symbol, tieup, line
+
+   line := read() | stop("empty file")
+
+   if upto("#", line) then rows := pat2rows(line)
+   else {
+      rows := [line]
+      while put(rows, read())	# read in row pattern
+      }
+
+   write("Drawdown:")
+   write()
+   every write(!rows)
+   write()
+
+   treadling := analyze(rows)
+   write("Treadling:")
+   write()
+   every writes(!treadling.sequence, ", ")
+   write()
+   write()
+
+   columns := protate(rows)	# rotate 90 degrees
+
+   threading := analyze(columns)
+   write("Threading:")
+   write()
+   every writes(!threading.sequence, ", ")
+   write()
+   write()
+
+   # Now do the tie-up.
+
+   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)
+   tieup := []
+
+   while get(symbols) do
+      put(tieup, get(symbols))
+
+   write("Tie-up:")
+   write()
+   every write(!tieup)
+
+end
+
+procedure analyze(drawdown)
+   local sequence, rows, row, count, patterns
+
+   sequence := []
+   patterns := []
+
+   rows := table()
+
+   count := 0
+
+   every row := !drawdown do {
+      if /rows[row] then {
+         rows[row] := count +:= 1
+         put(patterns, row)
+         }
+      put(sequence, rows[row])
+      }
+
+   return analysis(rows, sequence, patterns)
+
+end