summaryrefslogtreecommitdiff
path: root/ipl/gprogs/isd2ill.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/gprogs/isd2ill.icn')
-rw-r--r--ipl/gprogs/isd2ill.icn321
1 files changed, 321 insertions, 0 deletions
diff --git a/ipl/gprogs/isd2ill.icn b/ipl/gprogs/isd2ill.icn
new file mode 100644
index 0000000..0bc9532
--- /dev/null
+++ b/ipl/gprogs/isd2ill.icn
@@ -0,0 +1,321 @@
+############################################################################
+#
+# 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:
+#
+# <base name>_tieup.eps (if given)
+# <base name>_liftplan.eps (if given)
+# <base name>_threading.eps
+# <base name>_treadling.eps
+# <base name>_drawdown.eps
+# <base name>_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
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-17 09:37:31 +0000