############################################################################ # # File: dd2wif.icn # # Subject: Program to produce a WIF from drawdown # # Author: Ralph E. Griswold # # Date: July 4, 2002 # ############################################################################ # # This file is in the public domain. # ############################################################################ # # This program reads BLPs that represent drawdowns. The names of BLP # files are given on the command line. WIF files are output. # # The following option is supported: # # -w make Web page; default don't # # If Web pages are being produced, the extension "html" is used; otherwise # "wif". # ############################################################################ # # Links: basename, options, pattread, patutils # ############################################################################ link basename link options link pattread link patutils procedure main(args) local rows, cols, treadling, threading, count, tieup, line, opts, lt, ext local shafts, treadles, i, tie_line, row, treadle, draft, title, web local name, input, output opts := options(args, "w") title := \opts["t"] | "example" web := \opts["w"] if \web then { # make Web page lt := "
" ext := ".html" } else ext := ".wif" every name := !args do { input := open(name) | stop("Cannot open ", name) rows := pattread(input) close(input) output := open(basename(name, ".blp") || ext, "w") | stop("Cannot open file for writing.") write(output, "") write(output, "") cols := rot(rows) # rotate to get columns treadles := examine(rows) # get treadles shafts := examine(cols) # get shafts treadling := [] # construct treadling sequence every put(treadling, treadles[!rows]) threading := [] # construct threading sequence every put(threading, shafts[!cols]) tieup := table() every row := key(treadles) do { # get unique rows treadle := treadles[row] # assigned treadle number tie_line := repl("0", *shafts) # blank tie-up line every i := 1 to *row do # go through row if row[i] == "1" then # if warp on top tie_line[threading[i]] := "1" # mark shaft position tieup[treadle] := tie_line # add line to tie-up } write(output, "[WIF]", lt) write(output, "Version=1.1", lt) write(output, "Date=" || &dateline, lt) write(output, "Developers=ralph@cs.arizona.edu", lt) write(output, "Source Program=dd2wif.icn", lt) write(output, "[CONTENTS]", lt) write(output, "Color Palette=yes", lt) write(output, "Text=yes", lt) write(output, "Weaving=yes", lt) write(output, "Tieup=yes", lt) write(output, "Color Table=yes", lt) write(output, "Threading=yes", lt) write(output, "Treadling=yes", lt) write(output, "Warp colors=yes", lt) write(output, "Weft colors=yes", lt) write(output, "Warp=yes", lt) write(output, "Weft=yes", lt) write(output, "[COLOR PALETTE]", lt) write(output, "Entries=2", lt) write(output, "Form=RGB", lt) write(output, "Range=0," || 2 ^ 16 - 1, lt) write(output, "[TEXT]", lt) write(output, "Title=", basename(name, ".blp"), lt) write(output, "Author=Ralph E. Griswold", lt) write(output, "Address=5302 E. 4th St., Tucson, AZ 85711-2304", lt) write(output, "EMail=ralph@cs.arizona.edu", lt) write(output, "Telephone=520-881-1470", lt) write(output, "FAX=520-325-3948", lt) write(output, "[WEAVING]", lt) write(output, "Shafts=", *shafts, lt) write(output, "Treadles=", *treadles, lt) write(output, "Rising shed=yes", lt) write(output, "[WARP]", lt) write(output, "Threads=", *threading, lt) write(output, "Units=Decipoints", lt) write(output, "Thickness=10", lt) write(output, "Color=1", lt) write(output, "[WEFT]", lt) write(output, "Threads=", *treadling, lt) write(output, "Units=Decipoints", lt) write(output, "Thickness=10", lt) write(output, "Color=2", lt) write(output, "[WARP THICKNESS]", lt) write(output, "[WEFT THICKNESS]", lt) write(output, "[COLOR TABLE]", lt) write(output, "1=0,0,0", lt) write(output, "2=65535,65535,65535", lt) write(output, "[THREADING]", lt) every i := 1 to *threading do write(output, i, "=", threading[i], lt) write(output, "[TREADLING]", lt) every i := 1 to *treadling do write(output, i, "=", treadling[i], lt) write(output, "[TIEUP]", lt) every i := 1 to *tieup do write(output, i, "=", tromp(tieup[i]), lt) if \web then { write(output, "") write(output, "") } close(output) } end procedure tromp(treadle) local result result := "" treadle ? { every result ||:= upto("1") || "," } return result[1:-1] end procedure examine(array) local count, lines, line lines := table() # table to be keyed by line patterns count := 0 every line := !array do # process lines /lines[line] := (count +:= 1) # if new line, insert with new number return lines end procedure rot(rows) local cols, row, grid, i cols := list(*rows[1], "") every row := !rows do { i := 0 every grid := !row do cols[i +:= 1] := grid || cols[i] } return cols end