-- 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

(1792)