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 / gprogs / gif2wif.icn < prev    next >
Text File  |  2001-06-10  |  5KB  |  197 lines
  1. ############################################################################
  2. #
  3. #    File:     gif2wif.icn
  4. #
  5. #    Subject:  Program to produce a WIF from black & white image
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     May 7, 2001
  10. #
  11. ############################################################################
  12. #
  13. #  This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program takes the name of a GIF file for a black & white image
  18. #  and outputs a WIF for a corresponding draft.  If the GIF is not
  19. #  strictly black & white, all non-black pixels are interpreted as
  20. #  white.
  21. #
  22. ############################################################################
  23. #
  24. #  Links:  graphics
  25. #
  26. ############################################################################
  27. #
  28. #  Requires:  Version 9 graphics
  29.  
  30. ############################################################################
  31.  
  32. link graphics
  33.  
  34. procedure main(args)
  35.    local rows, cols, treadling, threading, count, tieup, y, width, height
  36.    local shafts, treadles, i, tie_line, row, treadle, draft, p
  37.  
  38.    WOpen("image=" || args[1], "canvas=hidden") |
  39.       stop("*** cannot open image")
  40.  
  41.    width := WAttrib("width")
  42.    height := WAttrib("height")
  43.  
  44.    rows := []            # start with empty list
  45.  
  46.    every y := 0 to height - 1 do {
  47.       row := ""
  48.       every p := Pixel(0, y, width, 1) do
  49.          if ColorValue(p) == "0,0,0" then row ||:= "1"
  50.             else row ||:= "0"
  51.       put(rows, row)
  52.       }
  53.  
  54.    cols := rot(rows)        # rotate to get columns
  55.  
  56.    treadles := examine(rows)    # get treadles
  57.    shafts := examine(cols)    # get shafts
  58.  
  59.    treadling := []        # construct treadling sequence
  60.    every put(treadling, treadles[!rows])
  61.  
  62.    threading := []        # construct threading sequence
  63.    every put(threading, shafts[!cols])
  64.  
  65.    tieup := table()
  66.  
  67.    every row := key(treadles) do {        # get unique rows
  68.       treadle := treadles[row]            # assigned treadle number
  69.       tie_line := repl("0", *shafts)        # blank tie-up line
  70.       every i := 1 to *row do            # go through row
  71.          if row[i] == "1" then            #    if warp on top
  72.             tie_line[threading[i]] := "1"    #       mark shaft position
  73.       tieup[treadle] := tie_line        # add line to tie-up
  74.       }
  75.  
  76.    #  Now output the WIF.
  77.  
  78.    write("[WIF]")
  79.    write("Version=1.1")
  80.    write("Date=" || &dateline)
  81.    write("Developers=ralph@cs.arizona.edu")
  82.    write("Source Program=gif2wif.icn")
  83.  
  84.    write("[CONTENTS]")
  85.    write("Color Palette=yes")
  86.    write("Text=yes")
  87.    write("Weaving=yes")
  88.    write("Tieup=yes")
  89.    write("Color Table=yes")
  90.    write("Threading=yes")
  91.    write("Treadling=yes")
  92.    write("Warp colors=yes")
  93.    write("Weft colors=yes")
  94.    write("Warp=yes")
  95.    write("Weft=yes")
  96.  
  97.    write("[COLOR PALETTE]")
  98.    write("Entries=2")
  99.    write("Form=RGB")
  100.    write("Range=0," || 2 ^ 16 - 1)
  101.  
  102.    write("[TEXT]")
  103.    write("Title=example")
  104.    write("Author=Ralph E. Griswold")
  105.    write("Address=5302 E. 4th St., Tucson, AZ 85711")
  106.    write("EMail=ralph@cs.arizona.edu")
  107.    write("Telephone=520-881-1470")
  108.    write("FAX=520-325-3948")
  109.  
  110.    write("[WEAVING]")
  111.    write("Shafts=", *shafts)
  112.    write("Treadles=", *treadles)
  113.    write("Rising shed=yes")
  114.  
  115.    write("[WARP]")
  116.    write("Threads=", *threading)
  117.    write("Units=Decipoints")
  118.    write("Thickness=10")
  119.    write("Color=1")
  120.  
  121.    write("[WEFT]")
  122.    write("Threads=", *treadling)
  123.    write("Units=Decipoints")
  124.    write("Thickness=10")
  125.    write("Color=2")
  126.  
  127.    write("[COLOR TABLE]")
  128.    write("1=0,0,0")
  129.    write("2=65535,65535,65535")
  130.  
  131.    write("[THREADING]")
  132.    every i := 1 to *threading do
  133.       write(i, "=", threading[i])
  134.  
  135.    write("[TREADLING]")
  136.    every i := 1 to *treadling do
  137.       write(i, "=", treadling[i])
  138.  
  139.    write("[TIEUP]")
  140.    every i := 1 to *tieup do
  141.       write(i, "=", tromp(tieup[i]))
  142.  
  143. end
  144.  
  145. #procedure tromp(treadle)
  146. #   local result
  147. #
  148. #   result := ""
  149. #   
  150. #   treadle ? {
  151. #      every result ||:= upto("1") || ","
  152. #      }
  153. #
  154. #   return result[1:-1]
  155. #
  156. #end
  157. #
  158. procedure tromp(treadle)
  159.    local result, i
  160.  
  161.    result := ""
  162.    
  163.    every i := 1 to *treadle do
  164.       if treadle[i] == 1 then result ||:= i || ","
  165.  
  166.    return result[1:-1]
  167.  
  168. end
  169.  
  170. procedure examine(array)
  171.    local count, lines, line
  172.  
  173.    lines := table()            # table to be keyed by line patterns
  174.    count := 0
  175.  
  176.    every line := !array do        # process lines
  177.       /lines[line] := (count +:= 1)    # if new line, insert with new number
  178.  
  179.    return lines
  180.  
  181. end
  182.  
  183. procedure rot(rows)
  184.    local cols, row, grid, i
  185.  
  186.    cols := list(*rows[1], "")
  187.  
  188.    every row := !rows do {
  189.       i := 0
  190.       every grid := !row do
  191.          cols[i +:= 1] := grid || cols[i]
  192.       }
  193.  
  194.    return cols
  195.  
  196. end
  197.