############################################################################
#
# File: isd2ill.icn
#
# Subject: Program to create images from ISDs
#
# Author: Ralph E. Griswold
#
# Date: April 23, 2000
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This program creates Encapsulated PostScript and GIF image files from
# ISDs.
#
# The following options are supported:
#
# -g draw grid lines on drawdown
# -h hold windows open in visible (-v) mode
# -p add showpage for printing
# -s i cell size, default 6
# -v show images during creation; default, don't
#
# Other options to be added include the control of layout and orientation.
#
# Names of ISDs are taken from the command line. For each, six Encap-
# PostScript files are created:
#
# _tieup.eps (if given)
# _liftplan.eps (if given)
# _threading.eps
# _treadling.eps
# _drawdown.eps
# _pattern.eps (colored "drawdown")
#
# Corresponding GIFs also are produced.
#
# Future plans call for handling "shaftplans" specifying what diagrams
# are wanted.
#
############################################################################
#
# Requires: Version 9 graphics
#
############################################################################
#
# Links: basename, interact, options, psrecord, weavutil, xcode
#
############################################################################
link basename
link interact
link options
link psrecord
link weavutil
link xcode
global canvas
global cellsize
global gridlines
global hold
global name
global printing
global draft
$define CellSize 6
procedure main(args)
local opts, input, file
isd
opts := options(args, "ghps+v")
if /opts["p"] then printing := 1
if \opts["v"] then {
canvas := "canvas=normal"
hold := opts["h"] # only if images are visible
}
else canvas := "canvas=hidden"
gridlines := opts["g"]
cellsize := \opts["s"] | CellSize
while file := get(args) do {
input := open(file) | {
Notice("Cannot open " || file)
next
}
name := basename(file, ".isd")
draft := xdecode(input)
draw_panes()
close(input)
}
end
procedure clear_pane(win, n, m, size)
local x, y, width, height, save_fg
width := n * size + 1
height := m * size + 1
save_fg := Fg(win)
Fg(win, "black")
every x := 0 to width by size do
DrawLine(win, x, 0, x, height)
every y := 0 to height by size do
DrawLine(win, 0, y, width, y)
Fg(win, save_fg)
return
end
procedure draw_panes()
local i, j, x, y, treadle, k, treadle_list, c, color
local tieup_win, threading_win, treadling_win, liftplan_win
local drawdown_win, pattern_win
if \draft.tieup then {
tieup_win := WOpen(canvas, "width=" || (cellsize * draft.treadles + 1),
"height=" || (cellsize * draft.shafts + 1))
PSStart(tieup_win, name || "_tieup.eps")
clear_pane(tieup_win, draft.treadles, draft.shafts, cellsize)
every i := 1 to draft.shafts do
every j := 1 to draft.treadles do {
if draft.tieup[j, i] == "1" then
fillcell(tieup_win, j, i, "black")
}
PSDone(printing)
WriteImage(tieup_win, name || "_tieup.gif")
}
if *\draft.liftplan > 0 then {
liftplan_win := WOpen(canvas, "width=" || (cellsize * draft.shafts + 1),
"height=" || (cellsize * *draft.treadling + 1))
PSStart(liftplan_win, name || "_liftplan.eps")
clear_pane(liftplan_win, draft.shafts, *draft.treadling, cellsize)
every i := 1 to *draft.treadling do
every j := 1 to draft.treadles do {
if draft.liftplan[i, j] == "1" then
fillcell(liftplan_win, j, i, "black")
}
PSDone(printing)
WriteImage(liftplan_win, name || "_liftplan.gif")
}
threading_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
"height=" || (cellsize * draft.shafts) + 1)
PSStart(threading_win, name || "_threading.eps")
clear_pane(threading_win, *draft.threading, draft.shafts + 1, cellsize)
every i := 1 to *draft.threading do
fillcell(threading_win, i, draft.threading[i], "black")
PSDone(printing)
WriteImage(threading_win, name || "_threading.gif")
treadling_win := WOpen(canvas, "height=" || (cellsize * *draft.treadling + 1),
"width=" || (cellsize * draft.treadles + 1))
PSStart(treadling_win, name || "_treadling.eps")
clear_pane(treadling_win, draft.treadles + 1, *draft.treadling, cellsize)
every i := 1 to *draft.treadling do
fillcell(treadling_win, draft.treadling[i], i, "black")
PSDone(printing)
WriteImage(treadling_win, name || "_treadling.gif")
pattern_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
"height=" || (cellsize * *draft.treadling + 1))
PSStart(pattern_win, name || "_pattern.eps")
clear_pane(pattern_win, draft.shafts, draft.treadles, cellsize)
if *cset(draft.warp_colors) = 1 then { # warp solid black
Fg(pattern_win, draft.color_list[draft.warp_colors[1]])
FillRectangle(pattern_win, 0, 0, *draft.threading * cellsize,
*draft.treadling * cellsize)
}
else {
every i := 0 to *draft.threading - 1 do { # warp striped
Fg(pattern_win, draft.color_list[draft.warp_colors[i]])
FillRectangle(pattern_win, i * cellsize, 0, cellsize - 1,
*draft.treadling * cellsize)
}
}
Fg(pattern_win, "black")
treadle_list := list(draft.treadles)
every !treadle_list := []
every i := 1 to draft.treadles do
every j := 1 to draft.shafts do
if draft.tieup[i, j] == "1" then
every k := 1 to *draft.threading do
if draft.threading[k] == j then
put(treadle_list[i], k, 0)
every y := 1 to *draft.treadling do {
treadle := draft.treadling[y]
color := draft.color_list[draft.weft_colors[y]]
if *treadle_list[treadle] = 0 then next # blank pick
every i := 1 to *treadle_list[treadle] by 2 do
fillcell(pattern_win, treadle_list[treadle][i], y, color)
}
Fg(pattern_win, "black")
if \gridlines then {
every x := 0 to WAttrib(pattern_win, "width") by cellsize do
DrawLine(pattern_win, x, 0, x, WAttrib(pattern_win, "height"))
every y := 0 to WAttrib(pattern_win, "height") by cellsize do
DrawLine(pattern_win, 0, y, WAttrib(pattern_win, "width"), y)
}
PSDone(printing)
WriteImage(pattern_win, name || "_pattern.gif")
drawdown_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
"height=" || (cellsize * *draft.treadling + 1))
PSStart(drawdown_win, name || "_drawdown.eps")
clear_pane(drawdown_win, draft.shafts, draft.treadles, cellsize)
Fg(drawdown_win, "white")
FillRectangle(drawdown_win, 0, 0, *draft.threading * cellsize,
*draft.treadling * cellsize)
treadle_list := list(draft.treadles)
every !treadle_list := []
every i := 1 to draft.treadles do
every j := 1 to draft.shafts do
if draft.tieup[i, j] == "1" then
every k := 1 to *draft.threading do
if draft.threading[k] == j then
put(treadle_list[i], k, 0)
every y := 1 to *draft.treadling do {
treadle := draft.treadling[y]
if *treadle_list[treadle] = 0 then next # blank pick
every i := 1 to *treadle_list[treadle] by 2 do
fillcell(drawdown_win, treadle_list[treadle][i], y, "black")
}
Fg(drawdown_win, "black")
if \gridlines then {
every x := 0 to WAttrib(drawdown_win, "width") by cellsize do
DrawLine(drawdown_win, x, 0, x, WAttrib(drawdown_win, "height"))
every y := 0 to WAttrib(drawdown_win, "height") by cellsize do
DrawLine(drawdown_win, 0, y, WAttrib(drawdown_win, "width"), y)
}
PSDone(printing)
WriteImage(drawdown_win, name || "_drawdown.gif")
if \hold then {
repeat {
if Event(Active()) === "q" then break
}
}
every WClose(tieup_win | \liftplan_win | threading_win | treadling_win |
pattern_win, drawdown_win)
return
end
procedure fillcell(win, n, m, color)
local save_fg
save_fg := Fg(win)
Fg(win, color)
FillRectangle(win, (n - 1) * cellsize, (m - 1) * cellsize, cellsize,
cellsize)
Fg(win, save_fg)
return
end