-- beadscleanupSil.mesa

DIRECTORY IODefs:FROM"IODefs",
          SystemDefs:FROM"SystemDefs",
          StringDefs:FROM"StringDefs",
          StreamDefs:FROM"StreamDefs";
CreateBeads:PROGRAM
  IMPORTS SystemDefs,StringDefs,StreamDefs,IODefs =
  BEGIN

Error:SIGNAL=CODE;

inputStream:StreamDefs.DiskHandle;
outputStream:StreamDefs.DiskHandle;


BigArray:TYPE=ARRAY [0..maxStick] OF UnPackedSticks;
allSticks:POINTER TO BigArray;
topStick:CARDINAL;
maxStick:CARDINAL=1000;

PackedSticks:TYPE=MACHINE DEPENDENT RECORD[w1,w2,w3,w4:CARDINAL];
UnPackedSticks:TYPE=MACHINE DEPENDENT RECORD[
    n1:[0..16),x:[0..4096),
    n2:[0..16),yMax:[0..4096),
    c:[0..16),xMax:[0..4096),
    f:[0..16),y:[0..4096)];
dummyStick:UnPackedSticks=[15,2047,15,2047,15,2047,15,2047];
Color:TYPE={black,red,yellow,green,cyan,violet,magenta,white,
      brown,orange,lime,turquoise,aqua,ultraviolet,pink,smoke};


FromInputToBeads:PROCEDURE[fileName:STRING]=BEGIN
  inputFileName:STRING_[40];
  outputFileName:STRING_[40];
  CopyString[from:fileName,to:inputFileName];
  CopyString[from:fileName,to:outputFileName];
  StringDefs.AppendString[inputFileName,".sil"];
  StringDefs.AppendString[outputFileName,".stick"];
  allSticks_SystemDefs.AllocateSegment[SIZE[BigArray]];
  FromSilFileToSticks[inputFileName,outputFileName];
  ModifySticks[];
  WriteOutSticks[];
  END;

CopyString:PROCEDURE[from,to:STRING]=BEGIN
  i:CARDINAL;
  l:CARDINAL_MIN[from.length,to.maxlength];
  FOR i IN [0..l) DO to[i]_from[i]; ENDLOOP;
  to.length_l;
  END;


FromSilFileToSticks:PROCEDURE[inName,outName:STRING]=BEGIN
  i,s:CARDINAL;
  mBase:PackedSticks;
  m:POINTER TO PackedSticks=@mBase;
  n:POINTER TO UnPackedSticks=LOOPHOLE[m];
  string:STRING_[100];
  inputStream_StreamDefs.NewWordStream[inName,StreamDefs.Read];
  outputStream_StreamDefs.NewWordStream[outName,StreamDefs.Write+StreamDefs.Append];
  i_RW[]; SELECT i FROM 34562B,34563B=>NULL; ENDCASE=>Error;
  WW[i];
  topStick_0;
  UNTIL inputStream.endof[inputStream] DO
    IF RW[]#177777B THEN Error; -- type non-macro
    m.w1_RW[]; m.w2_RW[]; m.w3_RW[]; m.w4_RW[];
    IF n.f<=13
      THEN BEGIN WB[s_RB[]]; FOR i IN [0..s) DO WB[RB[]]; ENDLOOP; END;
    IF (n.c=1 OR n.c=2 OR n.c=3 OR n.c=4) AND n.f=14 THEN BEGIN
      allSticks[topStick]_n^;
      topStick_topStick+1;
      IF topStick>maxStick THEN Error;
      END
    ELSE BEGIN WW[177777B]; WW[m.w1]; WW[m.w2]; WW[m.w3]; WW[m.w4]; END;
    ENDLOOP;
    topStick_topStick-1;
    inputStream.destroy[inputStream];
  END;

right:BOOLEAN;
left:BOOLEAN_TRUE;
PackedBytes:TYPE=RECORD[a,b:Byte];
Byte:TYPE=[0..256);
pieces,piecesout:PackedBytes;

RW:PROCEDURE RETURNS[CARDINAL]=
 BEGIN right_FALSE; RETURN[inputStream.get[inputStream]]; END;

RB:PROCEDURE RETURNS[Byte]=BEGIN
  IF right THEN  pieces.a_pieces.b ELSE pieces_LOOPHOLE[RW[]];
  right_~right; RETURN[pieces.a]; END;

WW:PROCEDURE[w:CARDINAL]= BEGIN
 IF ~left THEN outputStream.put[outputStream,piecesout];
 left_TRUE;
 outputStream.put[outputStream,w]
 END;

WB:PROCEDURE [byte:Byte]=BEGIN
  IF left THEN piecesout.a_byte ELSE piecesout.b_byte;
  IF ~left THEN outputStream.put[outputStream,piecesout];
  left_~left;
  END;

WriteOutSticks:PROCEDURE=BEGIN i:CARDINAL;
  m:POINTER TO PackedSticks;
  n:POINTER TO UnPackedSticks;
  FOR i IN [0..topStick] DO
    n_@allSticks[i];
    IF n^=dummyStick THEN LOOP;
    m_LOOPHOLE[n];
    WW[177777B]; WW[m.w1]; WW[m.w2]; WW[m.w3]; WW[m.w4];
    ENDLOOP;
  outputStream.destroy[outputStream];
  END;

ModifySticks:PROCEDURE=BEGIN i,j:CARDINAL;
  m,n:POINTER TO UnPackedSticks;
  mh,mw,nh,nw:INTEGER;
  nhor,mhor:BOOLEAN;
  FOR i IN [0..topStick] DO
  m_@allSticks[i];
  IF m^=dummyStick THEN LOOP;
  mh_m.y-m.yMax;
  mw_m.xMax-m.x;
  mhor_mw>mh;
  FOR j IN [0..topStick] DO
    n_@allSticks[j];
    IF n^=dummyStick THEN LOOP;
    IF m.y+1<n.yMax OR n.y+1<m.yMax OR m.xMax+1<n.x OR n.xMax+1<m.x
      THEN LOOP;
    nh_n.y-n.yMax;
    nw_n.xMax-n.x;
    nhor_nw>nh;
    IF mhor=FALSE AND nhor=mhor AND m.c=n.c AND
       m.y>n.y AND n.yMax<m.yMax AND m.xMax=n.xMax AND n.x=m.x
      THEN BEGIN n.y_m.y; m^_dummyStick; LOOP; END;
    IF mhor=FALSE AND nhor=mhor AND m.c=n.c AND
       n.y>m.y AND m.yMax<n.yMax AND m.xMax=n.xMax AND n.x=m.x
      THEN BEGIN n.yMax_m.yMax; m^_dummyStick; LOOP; END;
    IF mhor=TRUE AND nhor=mhor AND m.c=n.c AND
       n.xMax>m.xMax AND m.x<n.x AND m.y=n.y AND n.yMax=m.yMax
      THEN BEGIN n.x_m.x; m^_dummyStick; LOOP; END;
    IF mhor AND ~nhor
      AND n.yMax IN [m.yMax-1..m.y+1] AND n.xMax>=m.x-1 AND n.x<=m.xMax+1
      THEN BEGIN n.yMax_m.yMax; LOOP; END;
    IF mhor AND ~nhor
      AND n.y IN [m.yMax-1..m.y+1] AND n.xMax>=m.x-1 AND n.x<=m.xMax+1
      THEN BEGIN n.y_m.yMax; LOOP; END;
    IF ~mhor AND nhor
      AND n.x IN [m.x-1..m.xMax+1] AND n.y>=m.yMax-1 AND n.yMax<=m.y+1
      THEN BEGIN n.x_m.x; LOOP; END;
    IF ~mhor AND nhor
      AND n.xMax IN [m.x-1..m.xMax+1] AND n.y>=m.yMax-1 AND n.yMax<=m.y+1
      THEN BEGIN n.xMax_m.x; LOOP; END;
    ENDLOOP;
    IF mhor THEN m.y_m.yMax+1 ELSE m.xMax_m.x+1;
    ENDLOOP;
  END;


KeepMesaHappy:PROCEDURE=BEGIN IODefs.WriteChar[' ]; END;

FromInputToBeads["test"];

END..


(1792)\2422i1I