-- LoomDisplay.mesa Edited by Sweet on June 13, 1979 11:18 AM

DIRECTORY
DisplayDefs: FROM "displaydefs" USING [Dimension, GrayArray],
IODefs: FROM "iodefs" USING [CR, SP],
LoomDefs: FROM "loomdefs",
ParameterDefs: FROM "ParameterDefs" USING [
ParameterItemDescriptor],
ProcessDefs: FROM "processdefs" USING [Detach, InitializeCondition, MsecToTicks, Yield],
StreamDefs: FROM "streamdefs" USING [StreamHandle],
StringDefs: FROM "StringDefs" USING [AppendChar, AppendString, StringToDecimal],
SystemDefs: FROM "SystemDefs" USING [
AllocateHeapNode, AllocateHeapString, FreeHeapNode, FreeHeapString],
ToolsDefs: FROM "ToolsDefs" USING [
FreeToolsNode],
WindowDefs: FROM "WindowDefs" USING [
DrawWindowNameFrame, PaintWindow,
ShadeBoxInSubwindow, SubwindowHandle, SubwindowPlace, WindowBox,
WindowHandle];

LoomDisplay: MONITOR
IMPORTS LoomDefs, ProcessDefs,
StringDefs, SystemDefs, ToolsDefs, WindowDefs
EXPORTS LoomDefs =

BEGIN OPEN DisplayDefs, ParameterDefs, WindowDefs, LoomDefs;

-- loom model

GrayData: PUBLIC ARRAY ColorName OF GrayArray ← [
[0, 0, 0, 0],
[0, 10020B, 0, 401B],
[0, 42104B, 0, 10421B],
[21042B, 0, 104210B, 10421B],
[104210B, 21042B, 42104B, 10421B],
[104210B, 21042B, 104210B, 52525B],
[21042B, 52525B, 104210B, 52525B],
[105212B, 52525B, 124250B, 52525B],
[125252B, 52525B, 125252B, 52525B],
[125252B, 53527B, 125252B, 72565B],
[125252B, 73567B, 125252B, 156735B],
[125252B, 156735B, 73567B, 156735B],
[73567B, 156735B, 135673B, 167356B],
[177777B, 156735B, 135673B, 73567B],
[177777B, 73567B, 177777B, 156735B],
[177777B, 176775B, 177777B, 157737B],
[177777B, 177777B, 177777B, 177777B]];

tieup: PUBLIC ARRAY Pedal OF STRING;
pulls: ARRAY Pedal OF ARRAY Harness OF BOOLEAN;
warpOrder: DESCRIPTOR FOR ARRAY OF Harness;
pedalOrder: DESCRIPTOR FOR ARRAY OF Pedal;
woBase, poBase: PUBLIC POINTER ← NIL;
woMax, poMax: CARDINAL ← 200;
warpSize, weftSize: PUBLIC CARDINAL ← 8;
overlap: ARRAY ColorName OF POINTER TO OverlapRec ← ALL[NIL];

warpColor: ColorDesc ← [0,DESCRIPTOR[NIL,0]];
weftColor: ColorDesc ← [0,DESCRIPTOR[NIL,0]];
woString, poString: PUBLIC STRING ← NIL;
warpColorString, weftColorString: PUBLIC STRING ← NIL;
warpSizeString, weftSizeString: PUBLIC STRING ← NIL;
overlapString: PUBLIC STRING ← NIL;

weaveWindow: PUBLIC WindowHandle;

ActionChanged: CONDITION;
paint: PaintAction;

PausePainting: PUBLIC ENTRY PROCEDURE [
sw: SubwindowHandle, items: ParameterItemDescriptor ← NULL, index: CARDINAL ← NULL] =
BEGIN
PostLine[NIL];
paint ← pause;
END;


ResumePainting: PUBLIC ENTRY PROCEDURE [
sw: SubwindowHandle, items: ParameterItemDescriptor ← NULL, index: CARDINAL ← NULL] =
BEGIN
PostLine[NIL];
paint ← run;
NOTIFY ActionChanged;
END;


CancelPainting: PUBLIC ENTRY PROCEDURE [
sw: SubwindowHandle, items: ParameterItemDescriptor ← NULL, index: CARDINAL ← NULL] =
BEGIN
PostLine[NIL];
paint ← stop;
NOTIFY ActionChanged;
END;

ShouldCancel: ENTRY PROCEDURE RETURNS [BOOLEAN] =
BEGIN -- paint = pause when called
IF paint # pause THEN RETURN[FALSE];
PaintCommands[pause];
WHILE paint = pause DO
WAIT ActionChanged;
ENDLOOP;
PaintCommands[paint];
RETURN [paint = stop];
END;

ReadFile: PUBLIC PROCEDURE [in: StreamDefs.StreamHandle] =
BEGIN
ACh: PROCEDURE [sp: POINTER TO STRING, ch: CHARACTER] =
BEGIN
IF sp.length = sp.maxlength THEN
BEGIN
ns: STRING ← SystemDefs.AllocateHeapString[sp.maxlength+20];
StringDefs.AppendString[ns, sp↑];
SystemDefs.FreeHeapString[sp↑];
sp↑ ← ns;
END;
StringDefs.AppendChar[sp↑, ch];
END;
RSt: PROCEDURE [sp: POINTER TO STRING] =
BEGIN
ch: CHARACTER;
sp.length ← 0;
WHILE ~in.endof[in] DO
ch ← in.get[in];
IF ch = IODefs.CR THEN RETURN;
ACh[sp, ch];
ENDLOOP;
END;
p: Pedal;

RSt[@titleString];
RSt[@woString];
RSt[@warpColorString];
RSt[@weftColorString];
RSt[@overlapString];
FOR p IN Pedal DO RSt[@tieup[p]]; ENDLOOP;
RSt[@poString];
in.destroy[in];
WindowDefs.PaintWindow[controlWindow];
END;

WriteFile: PUBLIC PROCEDURE [out: StreamDefs.StreamHandle] =
BEGIN
WSt: PROCEDURE [s: STRING] =
BEGIN
i: CARDINAL;
FOR i IN [0..s.length) DO out.put[out, s[i]]; ENDLOOP;
out.put[out, IODefs.CR];
END;
p: Pedal;
WSt[titleString];
WSt[woString];
WSt[warpColorString];
WSt[weftColorString];
WSt[overlapString];
FOR p IN Pedal DO WSt[tieup[p]]; ENDLOOP;
WSt[poString];
out.destroy[out];
END;


RunLength: PROCEDURE [s: STRING] RETURNS [l: CARDINAL] =
BEGIN
i: CARDINAL;
c, last: CHARACTER;

l ← 0; last ← ’1;
FOR i ← 0, i+1 WHILE i < s.length DO
c ← s[i];
IF c = ’- THEN
BEGIN
c ← s[i←i+1];
l ← l+ ABS[c-last];
END
ELSE l ← l+1;
last ← c;
ENDLOOP;
END;

ParseRuns: PROCEDURE [s: STRING, a: DESCRIPTOR FOR ARRAY OF [0..8)] =
BEGIN
i, n: CARDINAL;
c, last, jc: CHARACTER;

AddChar: PROCEDURE [ch: CHARACTER[’1..’8]] =
BEGIN
a[n] ← ch - ’1;
n ← n+1;
END;

n ← 0; last ← ’1;
FOR i ← 0, i+1 WHILE i < s.length DO
c ← s[i];
IF c = IODefs.SP THEN LOOP;
IF c = ’- THEN
BEGIN
c ← s[i←i+1];
IF c > last THEN
FOR jc IN (last..c] DO AddChar[jc]; ENDLOOP
ELSE
FOR jc DECREASING IN [c..last) DO AddChar[jc]; ENDLOOP;
END
ELSE AddChar[c];
last ← c;
ENDLOOP;
END;

SyntaxError: ERROR = CODE;

ParseColor: PROCEDURE [s: STRING] RETURNS [cd: ColorDesc] =
BEGIN
i, n, count: CARDINAL;

n ← 0;
FOR i IN [0..s.length) DO
IF s[i] IN ColorName THEN n ← n+1;
ENDLOOP;
IF n = 0 THEN GO TO badSyntax;
cd.d ← DESCRIPTOR[SystemDefs.AllocateHeapNode[n*SIZE[ColorChunk]], n];
cd.repeat ← i ← n ← count ← 0;
WHILE i < s.length DO
SELECT s[i] FROM
IN [’0..’9] =>
BEGIN
IF count # 0 THEN GO TO badSyntax;
count ← s[i] - ’0;
DO
i ← i+1;
IF i = s.length THEN GO TO badSyntax;
IF s[i] ~ IN [’0..’9] THEN EXIT;
count ← 10*count + s[i] - ’0;
ENDLOOP;
END;
IODefs.SP => i ← i+1;
’r =>
BEGIN
IF count # 0 THEN GO TO badSyntax;
count ← LENGTH [warpOrder]; i ← i+1;
END;
ENDCASE =>
BEGIN
cd.d[n] ← [s[i], MAX[count, 1]];
cd.repeat ← cd.repeat + MAX[count, 1];
count ← 0;
n ← n+1;
i ← i+1;
END;
ENDLOOP;
EXITS
badSyntax =>
BEGIN
PostLine["malformed color description"];
ERROR SyntaxError;
END;
END;

badForm: SIGNAL = CODE;
ParseOverlap: PROCEDURE =
BEGIN
ENABLE badForm => GO TO badSyntax;
FreeList: PROCEDURE [p: POINTER TO OverlapRec] =
BEGIN
next: POINTER TO OverlapRec;
UNTIL p = NIL DO
next ← p.next;
SystemDefs.FreeHeapNode[p];
p ← next;
ENDLOOP;
END;
i: CARDINAL ← 0;
Col: PROCEDURE RETURNS [c: ColorName] =
BEGIN
SkipBlanks[];
IF i = overlapString.length OR
(c ← overlapString[i]) ~ IN ColorName THEN
SIGNAL badForm;
i ← i+1;
END;
SkipBlanks: PROCEDURE =
BEGIN
WHILE i < overlapString.length AND overlapString[i] = IODefs.SP DO
i ← i+1;
ENDLOOP;
END;
SkipOver: PROCEDURE [ch: CHARACTER] =
BEGIN
SkipBlanks[];
IF i = overlapString.length OR
overlapString[i] # ch THEN
SIGNAL badForm;
i ← i+1;
END;
c, top, bottom, show: ColorName;
p: POINTER TO OverlapRec;

FOR c IN ColorName DO
FreeList[overlap[c]]; overlap[c] ← NIL;
ENDLOOP;
IF overlapString = NIL THEN RETURN;
DO
SkipBlanks[];
IF i = overlapString.length THEN RETURN;
top ← Col[];
SkipOver[’/];
bottom ← Col[];
SkipOver[’=];
show ← Col[];
p ← SystemDefs.AllocateHeapNode[SIZE[OverlapRec]];
p↑ ← [next: overlap[top], under: bottom, show: show];
overlap[top] ← p;
ENDLOOP;
EXITS
badSyntax =>
BEGIN
PostLine["malformed overlap description"];
ERROR SyntaxError;
END;
END;

Color: PROCEDURE [cd: ColorDesc, i: CARDINAL] RETURNS [ColorName] =
BEGIN
n, j: CARDINAL;
i ← i MOD cd.repeat;
FOR j IN [0..LENGTH[cd.d]) DO
n ← cd.d[j].count;
IF i < n THEN RETURN [cd.d[j].color];
i ← i-n;
ENDLOOP;
ERROR;
END;

ParseParameters: PROCEDURE =
BEGIN
l: CARDINAL;

l ← RunLength[woString];
IF l > woMax THEN
BEGIN OPEN SystemDefs;
[] ← ToolsDefs.FreeToolsNode[woBase];
woBase ← AllocateHeapNode[woMax ← l];
END;
IF woBase = NIL THEN woBase ← SystemDefs.AllocateHeapNode[woMax];
warpOrder ← DESCRIPTOR[woBase, l];
ParseRuns[woString, warpOrder];

warpColor ← ParseColor[warpColorString];
weftColor ← ParseColor[weftColorString];
ParseOverlap[];

BEGIN
i: Pedal;
j: CARDINAL;
s: STRING;
p: POINTER TO ARRAY Harness OF BOOLEAN;
pulls ← ALL[ALL[FALSE]];
FOR i IN Pedal DO
s ← tieup[i]; p ← @pulls[i];
FOR j IN [0..s.length) DO
p[s[j]-’1] ← TRUE;
ENDLOOP;
ENDLOOP;
END;

warpSize ← StringDefs.StringToDecimal[warpSizeString];
weftSize ← StringDefs.StringToDecimal[weftSizeString];

l ← RunLength[poString];
IF l > poMax THEN
BEGIN OPEN SystemDefs;
[] ← ToolsDefs.FreeToolsNode[poBase];
poBase ← AllocateHeapNode[poMax ← l];
END;
IF poBase = NIL THEN poBase ← SystemDefs.AllocateHeapNode[woMax];
pedalOrder ← DESCRIPTOR[poBase, l];
ParseRuns[poString, pedalOrder];
END;

IncMod: PROCEDURE [i, m: CARDINAL] RETURNS [CARDINAL] = INLINE
BEGIN
RETURN [IF i+1 = m THEN 0 ELSE i+1];
END;

DecMod: PROCEDURE [i, m: CARDINAL] RETURNS [CARDINAL] = INLINE
BEGIN
RETURN [IF i = 0 THEN m-1 ELSE i-1];
END;


RepaintAllWeave: PUBLIC PROCEDURE =
BEGIN
title: STRING ← [100];
box: WindowBox;
x2, y2: CARDINAL;
warpSize ← StringDefs.StringToDecimal[warpSizeString];
weftSize ← StringDefs.StringToDecimal[weftSizeString];
StringDefs.AppendString[title, "Weaving: "L];
StringDefs.AppendString[title, titleString];
DrawWindowNameFrame[weaveWindow, title];
box ← weaveWindow.subwindowChain.box;
x2 ← (box.dims.w+warpSize-1)/warpSize;
y2 ← (box.dims.h+weftSize-1)/weftSize;
ProcessDefs.Detach[FORK RepaintPart[0, x2, 0, y2]];
END;

RepaintSquare: PROCEDURE [x, y: CARDINAL, top, bottom: ColorName] =
BEGIN
myGray: GrayArray;
rawGray: POINTER TO GrayArray;
p: POINTER TO OverlapRec;
ydelta: CARDINAL;
show: ColorName;

FOR p ← overlap[top], p.next UNTIL p = NIL DO
IF p.under = bottom THEN BEGIN show ← p.show; EXIT END;
REPEAT
FINISHED => show ← top;
ENDLOOP;
IF show = ’A THEN RETURN;
rawGray ← @GrayData[show];
ydelta ← (y*weftSize) MOD 4;

myGray[0] ← rawGray[ydelta];
myGray[1] ← rawGray[(ydelta+1) MOD 4];
myGray[2] ← rawGray[(ydelta+2) MOD 4];
myGray[3] ← rawGray[(ydelta+3) MOD 4];
ShadeBoxInSubwindow[weaveWindow.subwindowChain,
[[x*warpSize, y*weftSize], [warpSize, weftSize]],
myGray];
RETURN
END;

RepaintPart: PUBLIC PROCEDURE [x1, x2, y1, y2: CARDINAL]=
BEGIN
pedalPulls: POINTER TO ARRAY Harness OF BOOLEAN;
x, y, xModWarp: CARDINAL;
thisWeft, thisWarp: ColorName;

paint ← run; PaintCommands[run];
IF woString = NIL OR woString.length = 0 THEN RETURN;
ParseParameters[!SyntaxError => GO TO badData];

FOR y IN [y1..y2] DO
pedalPulls ← @pulls[pedalOrder[y MOD LENGTH[pedalOrder]]];
thisWeft ← Color[weftColor, y];
IF y MOD 2 = 0 THEN
BEGIN
xModWarp ← x1 MOD LENGTH[warpOrder];
FOR x IN [x1..x2] DO
thisWarp ← Color[warpColor, x];
IF pedalPulls[warpOrder[xModWarp]] THEN
RepaintSquare[x, y, thisWarp, thisWeft]
ELSE
RepaintSquare[x, y, thisWeft, thisWarp];
xModWarp ← IncMod[xModWarp, LENGTH[warpOrder]];
ENDLOOP;
END
ELSE
BEGIN
xModWarp ← x2 MOD LENGTH[warpOrder];
FOR x DECREASING IN [x1..x2] DO
thisWarp ← Color[warpColor, x];
IF pedalPulls[warpOrder[xModWarp]] THEN
RepaintSquare[x, y, thisWarp, thisWeft]
ELSE
RepaintSquare[x, y, thisWeft, thisWarp];
xModWarp ← DecMod[xModWarp, LENGTH[warpOrder]];
ENDLOOP;
END;
ProcessDefs.Yield[];
IF paint = pause AND ShouldCancel[] THEN EXIT;
ENDLOOP;
PaintCommands[stop];
EXITS
badData => RETURN;
END;

ProcessDefs.InitializeCondition[@ActionChanged, ProcessDefs.MsecToTicks[500]];
END. -- of LoomDisplay