############################################################################
#
#	File:     rows2isd.icn
#
#	Subject:  Program to produce a ISD from bi-level pattern
#
#	Author:   Ralph E. Griswold
#
#	Date:     November 16, 2001
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This program takes a row file or BLP from standard input
#  and writes an ISD for a draft to standard output.
#
############################################################################
#
#  Links:  weavutil, xcode, patutils, patxform
#
############################################################################

link patutils
link patxform
link weavutil
link xcode

procedure main(args)
   local rows, cols, treadling, threading, count, tieup, y, width, height
   local shafts, treadles, i, tie_line, row, treadle, draft, p, line

   line := read() | stop("empty file")

   if upto("#", line) then rows := pat2rows(line)
   else {
      rows := [line]
      while put(rows, read())	# read in row pattern
      }

   cols := protate(rows)	# rotate to get columns

   treadles := examine(rows)	# get treadles
   shafts := examine(cols)	# get shafts

   treadling := []		# construct treadling sequence
   every put(treadling, treadles[!rows])

   threading := []		# construct threading sequence
   every put(threading, shafts[!cols])

   tieup := []

   every row := key(treadles) do {		# get unique rows
      treadle := treadles[row]			# assigned treadle number
      tie_line := repl("0", *shafts)		# blank tie-up line
      every i := 1 to *row do			# go through row
         if row[i] == "1" then			#    if warp on top
            tie_line[threading[i]] := "1"	#       mark shaft position
      put(tieup, tie_line)			# add line to tie-up
      }

   draft := isd("rows2isd")

   draft.threading := threading
   draft.treadling := treadling
   draft.shafts := *shafts
   draft.treadles := *treadles
   draft.width := *shafts
   draft.height := *treadles
   draft.tieup := tieup
   draft.color_list := ["black", "white"]
   draft.warp_colors := list(*threading, 1)
   draft.weft_colors := list(*treadling, 2)

   write(xencode(draft))

end

procedure tromp(treadle)
   local result

   result := ""
   
   treadle ? {
      every result ||:= upto("1") || ","
      }

   return result[1:-1]

end

procedure examine(array)
   local count, lines, line

   lines := table()			# table to be keyed by line patterns
   count := 0

   every line := !array do		# process lines
      /lines[line] := (count +:= 1)	# if new line, insert with new number

   return lines

end