############################################################################
#
#	File:     weavegif.icn
#
#	Subject:  Procedure to produce a woven image from a draft
#
#	Author:   Ralph E. Griswold
#
#	Date:     June 10, 2001
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This procedure produces a woven image from a pattern-form draft, which
#  is passed to it as it's first argument.  Window attributes may be
#  passed as a list in the second argument
#
############################################################################
#
#  Requires:  Version 9 graphics  
#
############################################################################
#
#  Links: tables, wopen
#
############################################################################
#
#  Links: wopen
#
############################################################################

link wopen

link tables, wopen

procedure weavegif(draft, attribs)	#: create GIF from ISD
   local x, y, color, treadle, i, j, treadle_list, k
   local win, treadle_colors, lst, s

   /attribs := []

   /draft.width := *draft.threading
   /draft.height := *draft.treadling

   put(attribs, "label=" || draft.name, "size=" || draft.width || "," ||
      draft.height)

   win := (WOpen ! attribs) | {
      write(&errout, "Cannot open window for woven image.")
      fail
      }

   #  Draw warp threads as "background".

   if \draft.color_list then {
      if *set(draft.warp_colors) = 1 then {		# solid warp ground
         Fg(draft.color_list[draft.warp_colors[1]])
         FillRectangle()
         }
      every i := 1 to draft.width do {
         Fg(win, draft.color_list[draft.warp_colors[i]])
         DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
         }
      }
   else {
      every i := 1 to draft.width do {
         Fg(win, draft.warp_colors[i])
         DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
         }
      }

   #  Precompute points at which weft threads are on top.

   treadle_list := list(draft.treadles)
   
   every !treadle_list := [win]

   every i := 1 to draft.treadles do {
      every j := 1 to draft.shafts do
         if draft.tieup[j, i] == "0" then
            every k := 1 to *draft.threading do
               if draft.threading[k] = j then
                  put(treadle_list[i], k - 1, 0)
      }

   if \draft.color_list then {
      treadle_colors := list(*draft.color_list)
      every !treadle_colors := []
      every i := 1 to draft.height do {
         j := draft.weft_colors[i]
         put(treadle_colors[j], i)
         }
      }
   else {
      treadle_colors := table()
      every i := 1 to draft.width do {
         j := draft.weft_colors[i]
         /treadle_colors[j] := []
         put(treadle_colors[j], i)
         }
      }
   
      #  "Overlay" weft threads.
   
   if \draft.color_list then {
      every i := 1 to *treadle_colors do {
         Fg(win, draft.color_list[i]) | stop("bogon")
         every y := !treadle_colors[i] do {
            WAttrib(win, "dy=" || (y - 1))
            if *treadle_list[draft.treadling[y]] = 1 then next	# blank pick
            DrawPoint ! treadle_list[draft.treadling[y]]
            }
         }
      }
   else {
      every s := !keylist(treadle_colors) do {
         Fg(win, s) | stop("bogon")
         lst := treadle_colors[s]
         every y := !lst do {
            WAttrib(win, "dy=" || (y - 1))
            if *treadle_list[draft.treadling[y]] = 1 then next	# blank pick
            DrawPoint ! treadle_list[draft.treadling[y]]
            }
         }
      }

   return win

end