diff options
Diffstat (limited to 'ipl/gpacks/weaving/plotgrid.icn')
-rw-r--r-- | ipl/gpacks/weaving/plotgrid.icn | 194 |
1 files changed, 194 insertions, 0 deletions
diff --git a/ipl/gpacks/weaving/plotgrid.icn b/ipl/gpacks/weaving/plotgrid.icn new file mode 100644 index 0000000..df32112 --- /dev/null +++ b/ipl/gpacks/weaving/plotgrid.icn @@ -0,0 +1,194 @@ +############################################################################ +# +# File: plotgrid.icn +# +# Subject: Program to create grid plots for sequence drafts +# +# Author: Ralph E. Griswold +# +# Date: June 19, 1999 +# +############################################################################ +# +# This program produces grid plots as specificed in the include +# file, include.wvp, which is produced by seqdraft.icn. +# +############################################################################ +# +# Requires: Version 9 graphics and large integers +# +############################################################################ +# +# Links: cells, convert, expander, weaving, weavutil, lists, mirror, +# tieutils, wopen, numbers, weaveseq +# +############################################################################ +# +# Note: The include file may contain link declarations. +# +############################################################################ + +link convert +link expander +link weaving +link weavutil +link lists +link mirror +link numbers +link tieutils +link wopen +link weaveseq + +$include "include.wvp" + +$ifdef Link +Link +$endif + +global cmod +global colors +global height +global shafts +global width +global threading +global tieup +global tieups +global treadling +global treadles +global warp_colors +global weft_colors + +$define CellSize 4 + +procedure main() + + init() + + plot() + +end + +# Initialize the weaving. + +procedure init() + local m, n, v + + shafts := Shafts + treadles := Treadles + + colors := Colors + + height := Length + width := Breadth + + threading := [] + every put(threading, |sconvert(Threading, shafts)) \ width + + treadling := [] + every put(treadling, |sconvert(Treadling, treadles)) \ height + + warp_colors := [] + every put(warp_colors, |sconvert(WarpColors, *colors)) \ width + + weft_colors := [] + every put(weft_colors, |sconvert(WeftColors, *colors)) \ height + +$ifdef Reflect + threading |||:= lreverse(threading[1:-1]) + treadling |||:= lreverse(treadling[1:-1]) + warp_colors |||:= lreverse(warp_colors[1:-1]) + weft_colors |||:= lreverse(weft_colors[1:-1]) + width := 2 * width - 1 + height := 2 * height - 1 +$endif + +$ifdef DeBug + write(image(threading)) + write(image(treadling)) + write(image(warp_colors)) + write(image(weft_colors)) +$endif + + tieup := tie2tier(shafts, treadles, Tieup).matrix + + return + +end + +# Create the plots. + +procedure plot() + local threading_pane, warp_pane, treadling_pane, weft_pane, tieup_pane + local tr_width, th_width, tr_height, th_height, comp, i, j + + threading_pane := makepanel(*threading, shafts, CellSize) + + every i := 1 to *threading do + colorcell(threading_pane, i, threading[i], "black") + + WAttrib(threading_pane.window, "label=threading sequence") + + th_width := WAttrib(threading_pane.window, "width") + th_height := WAttrib(threading_pane.window, "height") + + warp_pane := makepanel(*warp_colors, shafts, CellSize) + + every i := 1 to *warp_colors do + colorcell(warp_pane, i, warp_colors[i], "black") + + treadling_pane := makepanel(treadles, *treadling, CellSize) + + tr_width := WAttrib(treadling_pane.window, "width") + tr_height := WAttrib(treadling_pane.window, "height") + + every i := 1 to *treadling do + colorcell(treadling_pane, treadles - treadling[i] + 1, i, "black") + + weft_pane := makepanel(treadles, *weft_colors, CellSize) + + every i := 1 to *weft_colors do + colorcell(weft_pane, treadles - weft_colors[i] + 1, i, "black") + + tieup_pane := makepanel(treadles, shafts, CellSize) + + every i := 1 to shafts do + every j := 1 to treadles do + if tieup[j, i] == "1" then + colorcell(tieup_pane, j, i, "black") + + comp := WOpen( + "canvas=hidden", + "width=" || (2 * tr_width + th_width), + "height=" || (2 * th_height + tr_height) + ) | stop("cannot open comp window") + + CopyArea(threading_pane.window, comp, , , , , tr_width, 0) + CopyArea(treadling_pane.window, comp, , , , , 0, th_height) + CopyArea(warp_pane.window, comp, , , , , tr_width, tr_height + th_height) + CopyArea(weft_pane.window, comp, , , , , th_width + tr_width, th_height) + CopyArea(tieup_pane.window, comp, , , , , 0, 0) + + WAttrib(comp, "canvas=normal") + + WDone(comp) + + return + +end + +procedure shortcuts(e) + + if &meta then case map(e) of { + "q" : exit() + "w" : weave() + } + + return + +end + +procedure sconvert(s, n) + + return abs(integer(s) % n) + 1 + +end |