1 files changed, 134 insertions, 0 deletions
diff --git a/ipl/gprogs/isd2wif.icn b/ipl/gprogs/isd2wif.icn
new file mode 100644
index 0000000..874998c
--- /dev/null
+++ b/ipl/gprogs/isd2wif.icn
@@ -0,0 +1,134 @@
+############################################################################
+#
+#	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