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