-- beadsFall.mesa
-- consists of 4 independent parts: Fall, Scavage, FixWires, Noodles To Beads

DIRECTORY IODefs:FROM"IODefs",
BeadsInlines:FROM"BeadsInlines",
InlineDefs:FROM"InlineDefs",
BeadsDefs:FROM"BeadsDefs";
BeadsFall:PROGRAM IMPORTS BeadsInlines, InlineDefs, IODefs, BeadsDefs
EXPORTS BeadsDefs=
BEGIN OPEN BeadsDefs, BeadsInlines;

Error:SIGNAL=CODE;
NoMoreBeads:SIGNAL=CODE;

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

--////// FALL //////

TrueFall:PUBLIC PROCEDURE= BEGIN
EnumerateBeads[NewYGetsY];
ResetBelow[];
EnumerateSortedBottomUp[FallOne];
FixWires[];
END;

FallTwo:PUBLIC PROCEDURE[j:Desc,hm:INTEGER]=
BEGIN IF BeadFall[j,hm] THEN FallOne[j]; END;

FallOne:PUBLIC PROCEDURE[i:Desc]= BEGIN
IF VerticalWire[i] THEN RETURN;
UNTIL IF i.p.wire THEN ~WireFall[i] ELSE ~BeadFall[i,0] DO ENDLOOP;
END;

WireFall:PUBLIC PROCEDURE[j:Desc] RETURNS[BOOLEAN]= BEGIN
w:INTEGER←Height[j];
bw:BentWireData;
r:Desc←DescR[j];
l:Desc←DescL[j];
IF Type[j]=none OR ~j.p.wire THEN Error;
BEGIN OPEN bw;
NoName:PROCEDURE=BEGIN
SELECT TRUE FROM
(thisY>oldY AND DropSeg[j,thisX,nextX+w,oldY] OR thisY=oldY)
AND old#topNoodle=>{MergeL[@bw]; done←TRUE};
thisY>nextY AND DropSeg[j,thisX,nextX+w,nextY]
AND (old#topNoodle OR ~Trans[l])=>{MergeR[@bw]; done←TRUE};
ENDCASE;
END;
Getw[j].newY←Bot[j];
StartBentWire[j.z,@bw];
--here belongs the drop slide
IF this#topNoodle THEN BEGIN
FollowNoodle[j,@bw,NoName];
IF done THEN RETURN[TRUE];
IF old#topNoodle AND ~Trans[r] THEN
BEGIN nextY←Top[r]-w; NoName[]; IF done THEN RETURN[TRUE];
nextY←Bot[r]; NoName[]; IF done THEN RETURN[TRUE]; END;
END;
RETURN[Bot[r]>thisY -- AND DropSeg[j,thisX,lastX+w,thisY] --
AND BeadFall[r,Bot[r]-thisY]];
END; END;

BeadFall:PUBLIC PROCEDURE[i:Desc,s:INTEGER] RETURNS[BOOLEAN]= BEGIN
bw:BentWireData;
BEGIN OPEN bw;
r:Desc←DescR[i];
d:Desc←DescD[i];
rr:Desc←DescR[r];
noLeft:BOOLEAN←NoBeadL[i];
IF Type[i]=none THEN Error;
IF ~NoBeadT[i] THEN RETURN[FALSE];
IF NoBead[d] THEN-- IF s=0 THEN RETURN[FALSE] ELSE-- drop←maxY
ELSE {dd:Desc←DescD[d]; drop←Bot[i]-Top[dd]-Delta[i,dd].y};
IF s#0 THEN drop←MIN[s,drop];
IF drop<0 THEN Error;
IF noLeft = (s=0) AND ~NoBead[r] THEN BEGIN
Getw[r].newY←Bot[r];
StartBentWire[r.z,@bw];
IF this=topNoodle OR next=topNoodle AND nextX=lastX THEN dy←Bot[rr]-thisY;
IF --this#topNoodle AND-- dy<0 THEN BEGIN
drop←MIN[-dy,drop];
IF drop#0 AND DropSeg[r,thisX,nextX,Bot[r]-drop]
AND DropBead[i,Bot[i]-drop] THEN BEGIN
MakeNewY[i];
MakeNewY[r];
IF drop=-dy AND this#topNoodle THEN BEGIN
IncrementNoodle[next,dx,0];
ReleaseNoodle[this,topNoodle,r];
END
ELSE IncrementNoodle[this,0,drop];
RETURN[TRUE];
END;
END;
END;
IF s#0 AND (NoBead[r] OR noLeft)
AND drop#0 AND DropBead[i,Bot[i]-drop] THEN BEGIN
MakeNewY[i];
IF noLeft THEN {[]←MakeNewNoodle[topNoodle,r.p,0,drop]; MakeNewY[r]};
RETURN[TRUE];
END;
RETURN[FALSE];
END; END;

MakeNewY:PROCEDURE[b:Desc]=BEGIN
IncrementY[b,-drop];
IF Bot[b]<0 THEN Seen2[];
Track[b.z," dropped to ",Bot[b]];
END;

Seen2:PROCEDURE=
BEGIN IF seen2=0 THEN Error; IF (seen2←seen2+1)>5000 THEN seen2←0; END;

Track:PUBLIC PROCEDURE[i:CARDINAL,s:STRING,y:INTEGER]=BEGIN OPEN IODefs;
IF i#trackBead THEN RETURN;
WriteChar[CR];
WriteNumber[i, [10,FALSE,TRUE,5]];
WriteString[s];
WriteNumber[y, [10,FALSE,TRUE,5]];
END;

drop,seen2:INTEGER←0;

okL,okR,okY:INTEGER;

DropBead:PROCEDURE[i:Desc,y:INTEGER] RETURNS[BOOLEAN]=INLINE
BEGIN RETURN[DropSeg[i,Lfm[i],Rtm[i],y]]; END;

DropSeg:PROCEDURE[i:Desc,l,r,y:INTEGER] RETURNS[BOOLEAN]= BEGIN
okL←l; okR←r; okY←y;
RETURN[l=r OR TryAllBelow[i,FallOk]];
END;

FallOk:PROCEDURE[ii,jj:CARDINAL] RETURNS[BOOLEAN] =BEGIN
IF jj=noBead OR ii=jj THEN RETURN[TRUE];
BEGIN
i:Desc←GetDesc[ii];
j:Desc←GetDesc[jj];
IF VerticalWire[j] OR Unrelated[i,j] OR LeftOf[i,j] OR LeftOf[j,i]
THEN RETURN[TRUE];
IF j.p.wire AND TestWireSegment[j,i,okL,okR,okY] THEN
BEGIN Track[i.z," not prevented from falling by ",j.z]; RETURN[TRUE]; END;
BEGIN
delta:Coord←Delta[i,j];
IF delta.x<0 THEN delta.x←0;
IF ~j.p.wire AND
~(Lfm[j]<okR+delta.x AND Rtm[j]>okL-delta.x AND Top[j]>okY-delta.y)
THEN RETURN[TRUE];
Track[i.z," prevented from falling by ",j.z];
RETURN[FALSE];
END; END; END;

TestWireSegment:PROCEDURE[i,j:Desc,l,r,y:INTEGER] RETURNS[BOOLEAN] =BEGIN
--i is a wire, j is not
--why right edge and left edge?
bw:BentWireData;
BEGIN OPEN bw;
w:INTEGER←Height[i];
delta:Coord←Delta[i,j];
IF delta.x<0 THEN delta.x←0;
y←y-w-delta.y;
Getw[i].newY←Bot[i];
StartBentWire[i.z,@bw];
BEGIN
leftEdge:INTEGER←firstX+IfTranL[i,w+2];
rightEdge:INTEGER←lastX-IfTranR[i,w+2];
range1:INTEGER←l-w-delta.x;
range2:INTEGER←r+delta.x;
NoName:PROCEDURE=BEGIN
IF thisX<range2 AND nextX>range1 AND thisY>y THEN done←TRUE;
-- IF MAX[thisX,leftEdge]<range2 AND MIN[nextX,rightEdge]>range1
-- AND thisY>y THEN {done←FALSE; RETURN};
END;
FollowNoodle[i,@bw,NoName];
IF ~done THEN NoName[];
RETURN[~done];
END; END; END;


--////// FIX WIRES //////

FixWires:PUBLIC PROCEDURE= BEGIN EnumerateBeads[FixWire]; END;

FixWire:PUBLIC PROCEDURE[i:Desc]=BEGIN
IF VerticalWire[i]
THEN {SetY[i,Top[DescD[i]]]; SetH[i,Bot[DescU[i]]-Bot[i]]};
IF HorizontalWire[i]
THEN {SetX[i,Rtm[DescL[i]]]; SetW[i,Lfm[DescR[i]]-Lfm[i]]};
END;

--////// TURN NOODLES TO BEADS //////

TurnWiresToBeads:PUBLIC PROCEDURE= BEGIN EnumerateBeads[TurnWire]; END;

TurnWire:PUBLIC PROCEDURE[i:Desc]= BEGIN
IF HorizontalWire[i] THEN BEGIN
w:INTEGER=Height[i];
type:BeadType←Type[i];
jct:BeadType←SELECT type FROM wireR=>jctnR, wireB=>jctnB, ENDCASE=>jctnG;
DO
chn:CARDINAL; dx,dy:INTEGER;
this:CARDINAL←i.p.noodle;
l:Desc←DescL[i];
r:Desc←DescR[i];
IF this=topNoodle THEN BEGIN
dy1:INTEGER←Bot[r]-Bot[i];
dy2:INTEGER←Top[r]-Top[i];
dy←MIN[MAX[dy1,dy2],MAX[dy1,0], MAX[dy2,0]];
dx←Lfm[r]-Lfm[i]+w;
END
ELSE [dx,dy,chn]←GetNoodle[this];
BEGIN
short:BOOLEAN← dx=0 AND this#topNoodle
AND (IF dy<0 THEN NoBeadD[l] ELSE NoBeadU[l]);
IF dx=0 AND this#topNoodle AND Height[l]#w THEN BEGIN
Jig:PROCEDURE[a:INTEGER]={IncrementNoodle[this,0,-a]; IncrementY[i,a]};
dy1:INTEGER←Bot[l]-Bot[i];
dy2:INTEGER←Top[l]-Top[i];
IF dy<0 AND dy1<0 THEN {Jig[MAX[dy,dy1]]; LOOP};
IF dy>0 AND dy2>0 THEN {Jig[MIN[dy,dy2]]; LOOP};
END;
IF dy=0 AND this=topNoodle AND ~short THEN EXIT;
IF (dy#0 OR dx#0) AND (this=topNoodle OR Lfm[i]+dx#Lfm[r]+w) THEN BEGIN
n:Desc=GetDesc[noBead];
a:Desc←IF short THEN n ELSE MakeBead[type,i];
b:Desc←IF short THEN l ELSE MakeBead[jct ,i];
c:Desc←IF dy=0 THEN n ELSE MakeBead[type,i];
d:Desc←IF dy=0 THEN b ELSE MakeBead[jct ,i];
l.p.beadR←noBead;
i.p.beadL←d.z; d.p.beadR←i.z;
IF ~NoBead[a] THEN {HookLR[l,a]; HookLR[a,b]};
IF ~NoBead[c] THEN BEGIN
IF dy<0 THEN {HookUD[d,c]; HookUD[c,b]}
ELSE {HookUD[b,c]; HookUD[c,d]};
END;
IF ~NoBead[a] THEN {b.p.x←Lfm[i]+dx-w; a.p.y←b.p.y←Bot[i]; FixWire[a]};
IF ~NoBead[c] THEN {c.p.x←d.p.x←Lfm[i]+dx-w;d.p.y←Bot[i]+dy;FixWire[c]};
IncrementY[i,dy];
FixWire[i];
END;
IF this=topNoodle THEN EXIT;
i.p.noodle←chn;
END; ENDLOOP;
END; END;


-- //////// MAKING AND DESTROYING BEADS ////////
-- //// GetFreeBead - the bead is trash
-- //// ReleaseBead
-- //// ScavageBeads - scavage the tables
-- //// MakeBead[type,bpi,i] gets a bead similar to bpi

MakeBead:PROCEDURE[type:BeadType,i:Desc] RETURNS[k:Desc]= BEGIN
k←GetFreeBead[];
k.p.t←type;
k.p.w←k.p.h←Height[i];
k.p.wire←Wire[k];
k.p.circuit←i.p.circuit;
END;

GetFreeBead:PUBLIC PROCEDURE RETURNS[i:Desc]=BEGIN
i←GetDesc[freeBeadList];
IF i.z NOT IN [0..noBead] THEN Error;
IF freeBeadList#noBead THEN
BEGIN i←GetDesc[freeBeadList];
freeBeadList←i.p.beadT; topBead←MAX[topBead,i.z]; END
ELSE BEGIN
Error;
IF topBead=noBead-1 THEN SIGNAL NoMoreBeads ELSE topBead←topBead+1;
i←GetDesc[topBead];
END;
i.p.noodle←topNoodle;
i.p.nextBelow←noBelow;
i.p.beadR←i.p.beadL←i.p.beadU←i.p.beadD←i.p.beadT←noBead;
i.p.external←0;
END;

END..