############################################################################
#
#	File:     isd2wif.icn
#
#	Subject:  Program to produce WIF from ISD
#
#	Author:   Ralph E. Griswold
#
#	Date:     April 14, 2002
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This program produces a WIF from an ISD.
#
############################################################################
#
#  Links:  patxform, weavutil, xcode
#
############################################################################

link patxform
link weavutil
link xcode

procedure main()
   local draft, i, lift_table, line

   isd				# protect from linker

   draft := xdecode(&input) | stop("*** cannot decode ISD")

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

   write("[CONTENTS]")
   write("Color Palette=yes")
   write("Text=yes")
   write("Notes=yes")
   write("Weaving=yes")
   write("Tieup=yes")
   write("Color Table=yes")
   write("Threading=yes")
   write("Treadling=yes")
   write("Warp colors=yes")
   write("Weft colors=yes")
   write("Warp=yes")
   write("Weft=yes")

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

   write("[TEXT]")
   write("Title=", draft.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("[NOTES]")
   write("1=")


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

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

   write("[WEFT]")
   write("Threads=", *draft.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 *draft.color_list do
      write(i, "=", ColorValue(draft.color_list[i]))

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

   write("[TREADLING]")
   every i := 1 to *draft.treadling do
      write(i, "=", draft.treadling[i])

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

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

   draft.tieup := protate(draft.tieup)

   write("[TIEUP]")
   every i := 1 to *draft.tieup do
      write(i, "=", tromp(draft.tieup[i]))

end

procedure tromp(treadle)
   local result

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

   return result[1:-1]

end