############################################################################
#
#	File:     pfd2wif.icn
#
#	Subject:  Program to produce WIF from PFD
#
#	Author:   Ralph E. Griswold
#
#	Date:     March 21, 1999
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This program produces a WIF from a pattern-form draft.
#
############################################################################
#
#  Links:  expander
#
############################################################################
#
#  Includes:  weavdefs.icn
#
############################################################################

link expander

$include "weavdefs.icn"

procedure main()
   local i, name, threading, treadling, warp_colors, weft_colors, tieup
   local palette, line, chars, mask, shafts, treadles, liftplan, lift_table

   mask := Mask

   name := read()

   threading := pfl2str(read()) | stop("*** short file")
   treadling := pfl2str(read()) | stop("*** short file")

   shafts := *cset(threading)

   warp_colors := map(pfl2str(read()), C1In, C1Ex) | stop("*** short file")
   if *warp_colors = 0 then warp_colors := "0"		# drawdown mode
   if *warp_colors < *threading then
      warp_colors := Extend(warp_colors, *threading)

   weft_colors := map(pfl2str(read()), C1In, C1Ex) | stop("*** short file")
   if *warp_colors = 0 then warp_colors := "0"		# drawdown mode
   if *weft_colors < *treadling then
      weft_colors := Extend(weft_colors, *treadling)

   palette := read() | stop("*** shoft file")
   chars := warp_colors ++ weft_colors

   tieup := read() | stop("*** short file")

   treadles := *tieup / shafts

   if liftplan := read() then {		 	# missing in older pfds.
      lift_table := table()
      i := 0
      liftplan ? {
         while line := tromp(move(shafts)) do {
            i +:= 1
            lift_table[mask[i]] := line
            }
         }
      }

   write("[WIF]")
   write("Version=1.1")
   write("Date=" || &dateline)
   write("Developers=ralph@cs.arizona.edu")
   write("Source Program=pfd2wif.icn")

   write("[CONTENTS]")
   write("Color Palette=yes")
   write("Text=yes")
   write("Weaving=yes")
   write("Tieup=yes")
   write("Color Table=yes")
   write("Threading=yes")
   if /liftplan then write("Treadling=yes")
   write("Warp colors=yes")
   write("Weft colors=yes")
   write("Warp=yes")
   write("Weft=yes")
   if \liftplan then write("Liftplan=yes")

   write("[COLOR PALETTE]")
   write("Entries=", *chars)
   write("Form=RGB")
   write("Range=0," || 2 ^ 16 - 1)

   write("[TEXT]")
   write("Title=", name)
   write("Author=Ralph E. Griswold")
   write("Address=5302 E. 4th St., Tucson, AZ 85711-2304")
   write("EMail=ralph@cs.arizona.edu")
   write("Telephone=520-881-1470")
   write("FAX=520-325-3948")

   write("[WEAVING]")
   write("Shafts=", shafts)
   write("Treadles=", treadles)
   write("Rising shed=yes")

   write("[WARP]")
   write("Threads=", *threading)
   write("Units=Decipoints")
   write("Thickness=10")

   write("[WEFT]")
   write("Threads=", *treadling)
   write("Units=Decipoints")
   write("Thickness=10")

   #  These are provided to produce better initial configurations when
   #  WIFs are imported to some weaving programs.

   write("[WARP THICKNESS]")
   write("[WEFT THICKNESS]")

   write("[COLOR TABLE]")

   every i := 1 to *chars do
      write(i, "=", PaletteColor(palette, chars[i]))

   write("[THREADING]")
   every i := 1 to *threading do
      write(i, "=", upto(threading[i], mask))

   if /liftplan then {
      write("[TREADLING]")
      every i := 1 to *treadling do
         write(i, "=", upto(treadling[i], mask))
      }

   write("[WARP COLORS]")
   every i := 1 to *warp_colors do
      write(i, "=", upto(warp_colors[i], chars))

   write("[WEFT COLORS]")
   every i := 1 to *weft_colors do
      write(i, "=", upto(weft_colors[i], chars))

   write("[TIEUP]")
   tieup ? {
      every i := 1 to treadles do
         write(i, "=", tromp(move(shafts)))
      }

   if \liftplan then {
      write("[LIFTPLAN]")
      liftplan ? {
         every i := 1 to *treadling do
            write(i, "=", lift_table[treadling[i]])
         }
      }

end

procedure tromp(treadle)
   local result

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

   return result[1:-1]

end