home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / gprocs / weavegif.icn < prev    next >
Text File  |  2001-06-10  |  4KB  |  133 lines
  1. ############################################################################
  2. #
  3. #    File:     weavegif.icn
  4. #
  5. #    Subject:  Procedure to produce a woven image from a draft
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     June 10, 2001
  10. #
  11. ############################################################################
  12. #
  13. #  This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This procedure produces a woven image from a pattern-form draft, which
  18. #  is passed to it as it's first argument.  Window attributes may be
  19. #  passed as a list in the second argument
  20. #
  21. ############################################################################
  22. #
  23. #  Requires:  Version 9 graphics  
  24. #
  25. ############################################################################
  26. #
  27. #  Links: tables, wopen
  28. #
  29. ############################################################################
  30. #
  31. #  Links: wopen
  32. #
  33. ############################################################################
  34.  
  35. link wopen
  36.  
  37. link tables, wopen
  38.  
  39. procedure weavegif(draft, attribs)    #: create GIF from ISD
  40.    local x, y, color, treadle, i, j, treadle_list, k
  41.    local win, treadle_colors, lst, s
  42.  
  43.    /attribs := []
  44.  
  45.    /draft.width := *draft.threading
  46.    /draft.height := *draft.treadling
  47.  
  48.    put(attribs, "label=" || draft.name, "size=" || draft.width || "," ||
  49.       draft.height)
  50.  
  51.    win := (WOpen ! attribs) | {
  52.       write(&errout, "Cannot open window for woven image.")
  53.       fail
  54.       }
  55.  
  56.    #  Draw warp threads as "background".
  57.  
  58.    if \draft.color_list then {
  59.       if *set(draft.warp_colors) = 1 then {        # solid warp ground
  60.          Fg(draft.color_list[draft.warp_colors[1]])
  61.          FillRectangle()
  62.          }
  63.       every i := 1 to draft.width do {
  64.          Fg(win, draft.color_list[draft.warp_colors[i]])
  65.          DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
  66.          }
  67.       }
  68.    else {
  69.       every i := 1 to draft.width do {
  70.          Fg(win, draft.warp_colors[i])
  71.          DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
  72.          }
  73.       }
  74.  
  75.    #  Precompute points at which weft threads are on top.
  76.  
  77.    treadle_list := list(draft.treadles)
  78.    
  79.    every !treadle_list := [win]
  80.  
  81.    every i := 1 to draft.treadles do {
  82.       every j := 1 to draft.shafts do
  83.          if draft.tieup[j, i] == "0" then
  84.             every k := 1 to *draft.threading do
  85.                if draft.threading[k] = j then
  86.                   put(treadle_list[i], k - 1, 0)
  87.       }
  88.  
  89.    if \draft.color_list then {
  90.       treadle_colors := list(*draft.color_list)
  91.       every !treadle_colors := []
  92.       every i := 1 to draft.height do {
  93.          j := draft.weft_colors[i]
  94.          put(treadle_colors[j], i)
  95.          }
  96.       }
  97.    else {
  98.       treadle_colors := table()
  99.       every i := 1 to draft.width do {
  100.          j := draft.weft_colors[i]
  101.          /treadle_colors[j] := []
  102.          put(treadle_colors[j], i)
  103.          }
  104.       }
  105.    
  106.       #  "Overlay" weft threads.
  107.    
  108.    if \draft.color_list then {
  109.       every i := 1 to *treadle_colors do {
  110.          Fg(win, draft.color_list[i]) | stop("bogon")
  111.          every y := !treadle_colors[i] do {
  112.             WAttrib(win, "dy=" || (y - 1))
  113.             if *treadle_list[draft.treadling[y]] = 1 then next    # blank pick
  114.             DrawPoint ! treadle_list[draft.treadling[y]]
  115.             }
  116.          }
  117.       }
  118.    else {
  119.       every s := !keylist(treadle_colors) do {
  120.          Fg(win, s) | stop("bogon")
  121.          lst := treadle_colors[s]
  122.          every y := !lst do {
  123.             WAttrib(win, "dy=" || (y - 1))
  124.             if *treadle_list[draft.treadling[y]] = 1 then next    # blank pick
  125.             DrawPoint ! treadle_list[draft.treadling[y]]
  126.             }
  127.          }
  128.       }
  129.  
  130.    return win
  131.  
  132. end
  133.