-- beadsFall4.mesa September 15, 1979 1:16 PM
-- long pointers

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

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

freeNoodleChain:PUBLIC CARDINAL;

--////// UTILITIES //////

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

StartBentWire:PUBLIC PROCEDURE[i:CARDINAL,bw:BentWire] =BEGIN OPEN bw;
bpi:BeadPtr←Get[i]; wpi:WorkPtr←GetW[i];
oldOld← old←topNoodle; this←bpi.noodle; next←noodleChain[this];
oldX← firstX← thisX←bpi.x-bpi.h; lastX←bpi.x+bpi.w;
oldY← thisY←wpi.newY;
olddx← olddy←0;
dx←noodleDX[this]; dy←noodleDY[this];
IF this=topNoodle THEN dx←lastX-thisX;
nextX← thisX+ dx; nextY← thisY+ dy;
nextdx←noodleDX[ next]; nextdy←noodleDY[ next];
END;

AdvanceBentWire:PUBLIC PROCEDURE[bw:BentWire] =BEGIN OPEN bw;
oldOld←old; old← this; this← next; next←noodleChain[this];
oldX← thisX; oldY← thisY;
thisX← nextX; thisY← nextY;
dx←noodleDX[this]; dy←noodleDY[this];
IF this=topNoodle THEN dx←lastX-thisX;
olddx←noodleDX[ old]; olddy←noodleDY[ old];
nextX← thisX+ dx; nextY← thisY+ dy;
nextdx←noodleDX[ next]; nextdy←noodleDY[ next];
END;


GetFreeNoodle:PROCEDURE RETURNS[a:CARDINAL] =BEGIN
a←freeNoodleChain;
IF a>=topNoodle-1 THEN Error;--not enough noodles
freeNoodleChain←noodleChain[a];
END;

ReleaseNoodle:PROCEDURE[a:CARDINAL] =BEGIN
IF a>topNoodle THEN Error;
noodleChain[a]←freeNoodleChain;
freeNoodleChain←a;
END;

ChangeNoodle:PROCEDURE[this,chain:CARDINAL,x,y:INTEGER] =BEGIN
IF this=topNoodle THEN Error;
IF chain>topNoodle THEN Error;
noodleDY[this]←y;
noodleDX[this]←x;
noodleChain[this]←chain;
END;

IncrementNoodle:PROCEDURE[this:CARDINAL,x,y:INTEGER] =BEGIN
IF this=topNoodle THEN RETURN;
noodleDY[this]←noodleDY[this]+y;
noodleDX[this]←noodleDX[this]+x;
END;

ChangeNoodleChain:PROCEDURE[this,chain:CARDINAL] =BEGIN
IF this>=topNoodle THEN Error;
IF chain>topNoodle THEN Error;
noodleChain[this]←chain;
END;

MergeLeft:PUBLIC PROCEDURE[j,old:CARDINAL]=BEGIN
this:CARDINAL;
this←IF old=topNoodle THEN Get[j].noodle ELSE noodleChain[old];
IncrementNoodle[old,noodleDX[this],noodleDY[this]];
ReleaseLink[j,old];
END;

MergeRight:PUBLIC PROCEDURE[j,old:CARDINAL]=BEGIN
this:CARDINAL←IF old=topNoodle THEN Get[j].noodle ELSE noodleChain[old];
IF this>=topNoodle THEN Error;
IncrementNoodle[noodleChain[this],noodleDX[this],0];
IncrementNoodle[old,0,noodleDY[this]];
ReleaseLink[j,old];
END;

ReleaseLink:PUBLIC PROCEDURE[j,old:CARDINAL]=BEGIN
this:CARDINAL; bpj:BeadPtr;
IF old>topNoodle THEN Error;
IF old=topNoodle
THEN BEGIN bpj←Get[j]; bpj.noodle←noodleChain[this←bpj.noodle]; END
ELSE noodleChain[old]←noodleChain[this←noodleChain[old]];
IF this>=topNoodle THEN Error;
ReleaseNoodle[this];
END;

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

Fall:PUBLIC PROCEDURE= BEGIN
seen2←0;
ResetBelow[];
EnumerateSortedBottomUp[FallOne];
END;

FallOne:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
IF bpi.wire AND bpi.beadR=noBead THEN RETURN;
UNTIL IF bpi.wire THEN ~WireFall[i] ELSE ~BeadFall[i,0]
DO ENDLOOP;
END;

WireFall:PUBLIC PROCEDURE[j:CARDINAL] RETURNS[BOOLEAN]= BEGIN
bpj:BeadPtr←Get[j];
w:INTEGER←bpj.h;
bw:BentWireData;
right:CARDINAL←bpj.beadR;
bpr:BeadPtr←Get[right];
left:CARDINAL←bpj.beadL;
bpl:BeadPtr←Get[left];
bot:INTEGER←bpr.y;
top:INTEGER←bot+bpr.h-w;
transRight:BOOLEAN←SELECT bpr.t FROM tt,dd,ttV,ddV=>TRUE, ENDCASE=>FALSE;
transLeft :BOOLEAN←SELECT bpl.t FROM tt,dd,ttV,ddV=>TRUE, ENDCASE=>FALSE;
IF bpj.t=none THEN Error;
BEGIN OPEN bw; GetW[j].newY←bpj.y; StartBentWire[j,@bw];
--here belongs the drop slide
-- IF j=211 THEN Error;
IF this#topNoodle THEN BEGIN
IF thisY>nextY AND dx#0 AND ~transLeft AND DropSeg[j,thisX,nextX+w,nextY]
THEN BEGIN
IncrementNoodle[this,-dx,0]; IncrementNoodle[next,dx,0]; RETURN[TRUE];
END;

UNTIL this=topNoodle DO IF old#topNoodle THEN BEGIN
IF thisY>oldY AND DropSeg[j,thisX,nextX+w,oldY] OR thisY=oldY
THEN BEGIN MergeLeft[j,old]; RETURN[TRUE]; END;
IF thisY>nextY AND DropSeg[j,thisX,nextX+w,nextY]
THEN BEGIN MergeRight[j,old]; RETURN[TRUE]; END;
END;
AdvanceBentWire[@bw];
ENDLOOP;

IF old#topNoodle AND ~transRight THEN BEGIN
return:BOOLEAN←TRUE;
SELECT TRUE FROM
thisX=lastX AND oldOld#topNoodle=>ReleaseLink[j,oldOld];
thisY IN [bot..top] AND thisY=oldY=>ReleaseLink[j,oldOld];
thisY>oldY AND DropSeg[j,thisX,lastX+w,oldY]=>
IF thisX=lastX THEN IncrementNoodle[old,0,oldY-thisY]
ELSE IncrementNoodle[old,lastX-thisX,0];
thisY>top AND DropSeg[j,thisX,lastX+w,top]=>
IncrementNoodle[old,0,top-thisY];
thisY>bot AND bot>=oldY AND DropSeg[j,thisX,lastX+w,bot]=>
IncrementNoodle[old,0,bot-thisY];
ENDCASE=>return←FALSE;
IF return THEN RETURN[TRUE];
END;
END;
RETURN[bot>thisY -- AND DropSeg[j,thisX,lastX+w,thisY] --
AND BeadFall[right,bot-thisY]];
END; END;

BeadFall:PUBLIC PROCEDURE[i:CARDINAL,s:INTEGER] RETURNS[BOOLEAN]= BEGIN
bw:BentWireData;
BEGIN OPEN bw;
bpi:BeadPtr←Get[i];
right:CARDINAL←bpi.beadR; bpr:BeadPtr←Get[right];
dblRight:CARDINAL←bpr.beadR; bprr:BeadPtr←Get[dblRight];
left:CARDINAL←bpi.beadL;
down:CARDINAL←bpi.beadD;
noLeft:BOOLEAN←left=noBead;
IF bpi.t=none THEN Error;
IF bpi.beadT#noBead THEN RETURN[FALSE];
IF down=noBead THEN-- IF s=0 THEN RETURN[FALSE] ELSE-- drop←maxY
ELSE BEGIN
deltaY:INTEGER;
dblDown:CARDINAL←Get[down].beadD;
bpdd:BeadPtr←Get[dblDown];
[,deltaY]←Deltas[i,dblDown];
drop←bpi.y-bpdd.y-bpdd.h-deltaY;
END;
IF s#0 THEN drop←MIN[s,drop];
IF drop<0 THEN Error;
IF (noLeft AND s=0 OR s#0 AND ~noLeft) AND right#noBead THEN BEGIN
GetW[right].newY←bpr.y;
StartBentWire[right,@bw];
IF this=topNoodle OR next=topNoodle AND nextX=lastX THEN dy←bprr.y-thisY;
IF --this#topNoodle AND-- dy<0 THEN BEGIN
drop←MIN[-dy,drop];
IF drop#0 AND DropSeg[right,thisX,nextX,bpr.y-drop]
AND DropBead[i,bpi.y-drop] THEN BEGIN
bpi.y←bpi.y-drop;
bpr.y←bpr.y-drop;
IF bpi.y<0 OR bpr.y<0 THEN Seen2[];
Track[i," dropped to ",bpi.y];
Track[right," dropped to ",bpr.y];
IF drop=-dy AND this#topNoodle THEN BEGIN
bpr.noodle←next;
IncrementNoodle[next,dx,0];
ReleaseNoodle[this];
END
ELSE IncrementNoodle[this,0,drop];
RETURN[TRUE];
END;
END;
END;
IF s#0 AND (right=noBead OR noLeft)
AND drop#0 AND DropBead[i,bpi.y-drop] THEN BEGIN
bpi.y←bpi.y-drop;
IF bpi.y<0 THEN Error;
Track[i," dropped to ",bpi.y];
IF noLeft THEN BEGIN
this:CARDINAL←GetFreeNoodle[];
bpr.y←bpr.y-drop;
IF bpr.y<0 THEN Error;
Track[right," dropped to ",bpr.y];
ChangeNoodle[this,bpr.noodle,0,drop];
bpr.noodle←this;
END;
RETURN[TRUE];
END;
RETURN[FALSE];
END; END;

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

Track: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;

okL,okR,okY:INTEGER;

DropBead:PROCEDURE[i:CARDINAL,y:INTEGER] RETURNS[BOOLEAN]=BEGIN
bpi:BeadPtr←Get[i];
okL←bpi.x; okR←okL+bpi.w; okY←y;
RETURN[TryAllBelow[i,FallOk]];
END;

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

FallOk:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN] =BEGIN
bpi:BeadPtr←Get[i];
bpj:BeadPtr←Get[j];
deltaX,deltaY:INTEGER;
-- IF bendingWires AND i=761 AND j=551 THEN Error;
IF j=noBead
OR i=j
OR bpj.wire AND bpj.beadR=noBead
OR desP[bpi.t].lessLevel#desP[bpj.t].lessLevel
OR bpi.beadL=bpj.beadR
OR bpi.beadR=bpj.beadL
OR j=bpi.beadR
OR j=bpi.beadL
THEN RETURN[TRUE];
IF bpj.wire AND TestWireSegment[j,i,okL,okR,okY] THEN
BEGIN Track[i," not prevented from falling by ",j]; RETURN[TRUE]; END;
[deltaX,deltaY]←Deltas[i,j];
IF deltaX<0 THEN deltaX←0;
IF ~bpj.wire AND
~(bpj.x<okR+deltaX AND bpj.x+bpj.w>okL-deltaX AND bpj.y+bpj.h>okY-deltaY)
THEN RETURN[TRUE];
Track[i," prevented from falling by ",j];
RETURN[FALSE];
END;

TestWireSegment:PROCEDURE[i,j:CARDINAL,l,r,y:INTEGER] RETURNS[BOOLEAN] =BEGIN
--i is a wire, j is not
--why right edge and left edge?
bpi:BeadPtr←Get[i];
bw:BentWireData;
BEGIN OPEN bw;
w:INTEGER←bpi.h;
deltaX,deltaY,range1,range2,leftEdge,rightEdge:INTEGER;
GetW[i].newY←bpi.y;
StartBentWire[i,@bw];
leftEdge←firstX+IfTrans[bpi.beadL,w+2];
rightEdge←lastX-IfTrans[bpi.beadR,w+2];
[deltaX,deltaY]←Deltas[i,j];
IF deltaX<0 THEN deltaX←0;
range1←l-w-deltaX;
range2←r+deltaX;
y←y-w-deltaY;
UNTIL this=topNoodle DO
IF thisX<range2 AND nextX>range1 AND thisY>y THEN RETURN[FALSE];
-- IF MAX[thisX,leftEdge]<range2 AND MIN[nextX,rightEdge]>range1
-- AND thisY>y THEN RETURN[FALSE];
AdvanceBentWire[@bw];
ENDLOOP;
IF thisX<range2 AND lastX>range1 AND thisY>y THEN RETURN[FALSE];
-- IF MAX[thisX,leftEdge]<range2 AND MIN[r,rightEdge]>range1
-- AND thisY>y THEN RETURN[FALSE];
RETURN[TRUE];
END; END;


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

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

FixWire:PUBLIC PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
IF ~bpi.wire THEN RETURN;
IF bpi.beadU#noBead THEN BEGIN
bpd:BeadPtr←Get[bpi.beadD];
bpi.y←bpd.y+bpd.h;
bpi.h←Get[bpi.beadU].y-bpi.y;
END ELSE BEGIN
bpl:BeadPtr←Get[bpi.beadL];
bpi.x←bpl.x+bpl.w;
bpi.w←Get[bpi.beadR].x-bpi.x;
END;
END;

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

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

TurnWire:PUBLIC PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
left,right,this:CARDINAL; dx,dy:INTEGER; short:BOOLEAN;
bpr,bpl:BeadPtr;
w:INTEGER←bpi.h;
type:BeadType←bpi.t;
jct:BeadType←SELECT type FROM wireR=>jctnR, wireB=>jctnB, ENDCASE=>jctnG;
IF ~(bpi.wire AND bpi.beadU=noBead) THEN RETURN;
DO
this←bpi.noodle;
left←bpi.beadL; bpl←Get[left];
right←bpi.beadR; bpr←Get[right];
IF this=topNoodle
THEN BEGIN
dy1:INTEGER←bpr.y-bpi.y;
dy2:INTEGER←dy1+bpr.h-bpi.h;
dy←MIN[MAX[dy1,dy2],MAX[dy1,0], MAX[dy2,0]];
dx←bpr.x-bpi.x+w;
END
ELSE BEGIN dx←noodleDX[this]; dy←noodleDY[this]; END;
short← dx=0 AND this#topNoodle
AND noBead=(IF dy<0 THEN bpl.beadD ELSE bpl.beadU);
IF dx=0 AND this#topNoodle AND bpl.h#w THEN BEGIN
dy1:INTEGER←bpl.y-bpi.y;
dy2:INTEGER←bpl.y+bpl.h-bpi.y-w;
IF dy<0 AND dy1<0 THEN BEGIN
noodleDY[this]←noodleDY[this]-MAX[dy,dy1];
bpi.y←bpi.y+MAX[dy,dy1];
LOOP;
END;
IF dy>0 AND dy2>0 THEN BEGIN
noodleDY[this]←noodleDY[this]-MIN[dy,dy2];
bpi.y←bpi.y+MIN[dy,dy2];
LOOP;
END;
END;
IF dy=0 AND this=topNoodle AND ~short THEN EXIT;
IF (dy#0 OR dx#0) AND (this=topNoodle OR bpi.x+dx#bpr.x+w)
THEN BEGIN
a:CARDINAL←IF short THEN noBead ELSE MakeBead[type,bpi,i];
b:CARDINAL←IF short THEN left ELSE MakeBead[jct,bpi,i];
c:CARDINAL←IF dy=0 THEN noBead ELSE MakeBead[type,bpi,i];
d:CARDINAL←IF dy=0 THEN b ELSE MakeBead[jct,bpi,i];
bpa:BeadPtr←Get[a];
bpb:BeadPtr←Get[b];
bpc:BeadPtr←Get[c];
bpd:BeadPtr←Get[d];
bpl.beadR←noBead;
bpi.beadL←d; bpd.beadR←i;
IF a#noBead THEN BEGIN
bpa.beadL←left; bpl.beadR←a;
bpb.beadL←a; bpa.beadR←b;
END;
IF c#noBead THEN BEGIN
IF dy<0 THEN BEGIN
bpc.beadU←b; bpb.beadD←c;
bpd.beadU←c; bpc.beadD←d;
END
ELSE BEGIN
bpc.beadD←b; bpb.beadU←c;
bpd.beadD←c; bpc.beadU←d;
END;
END;
IF a#noBead THEN BEGIN
bpb.x←bpi.x+dx-w;
bpa.y←bpb.y←bpi.y;
FixWire[a,bpa];
END;
IF c#noBead THEN BEGIN
bpc.x←bpd.x←bpi.x+dx-w;
bpd.y←bpi.y+dy;
FixWire[c,bpc];
END;
bpi.y←bpi.y+dy;
FixWire[i,bpi];
END;
IF this=topNoodle THEN EXIT;
bpi.noodle←noodleChain[this];
ENDLOOP;
END;

--/////////// SCOUR /////

ScourBeads:PUBLIC PROCEDURE=BEGIN
EnumerateBeads[ScourBead];
FixWires[];
END;

ScourBead:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
conu,cond,room:BOOLEAN;
up:CARDINAL←bpi.beadU;
down:CARDINAL←bpi.beadD;
bpu:BeadPtr←Get[up];
bpd:BeadPtr←Get[down];
IF bpi.t=none THEN Error;
IF ~bpi.wire THEN BEGIN
left:CARDINAL←bpi.beadL;
right:CARDINAL←bpi.beadR;
bpl:BeadPtr←Get[left];
bpr:BeadPtr←Get[right];
SELECT bpi.t FROM jctnG,jctnR,jctnB=>NULL; ENDCASE=>RETURN;
SELECT TRUE FROM
left=noBead AND right=noBead=>BEGIN
IF up=noBead OR down=noBead THEN Error;
bpd.beadU←bpu.beadU;
Get[bpd.beadU].beadD←down;
ReleaseBead[up];
FixWire[down,bpd];
END;
up=noBead AND down=noBead=>BEGIN
IF left=noBead OR right=noBead THEN Error;
bpl.beadR←bpr.beadR;
Get[bpl.beadR].beadL←left;
ReleaseBead[right];
FixWire[left,bpl];
END;
ENDCASE=>RETURN;
ReleaseBead[i];
RETURN;
END;
IF bpi.beadL#noBead THEN RETURN;
IF bpu.y>=bpd.y+bpd.h+8 THEN RETURN;
room←(bpu.beadL=noBead OR bpd.beadL=noBead)
AND (bpu.beadR=noBead OR bpd.beadR=noBead);
SELECT bpu.t FROM
jctnG,jctnR,jctnB=>conu←FALSE; bg,rb,bf=>conu←TRUE; ENDCASE=>RETURN;
SELECT bpd.t FROM
jctnG,jctnR,jctnB=>cond←FALSE; bg,rb,bf=>cond←TRUE; ENDCASE=>RETURN;
IF bpu.y+bpu.h<=bpd.y+bpd.h AND ~conu AND room THEN BEGIN
Fix[leftRight,up,down];
bpd.beadU←bpu.beadU;
Get[bpd.beadU].beadD←down;
ReleaseBead[up];
ReleaseBead[i];
RETURN;
END;
IF bpu.y<=bpd.y AND ~cond AND room THEN BEGIN
Fix[leftRight,down,up];
bpu.beadD←bpd.beadD;
Get[bpu.beadD].beadU←up;
ReleaseBead[down];
ReleaseBead[i];
RETURN;
END;
IF conu AND cond AND bpu.x=bpd.x AND bpu.y=bpd.y
AND bpu.h=bpd.h AND bpu.w=bpd.w
AND room THEN BEGIN
s:CARDINAL←bpu.beadT; bps:BeadPtr←Get[s];
t:CARDINAL←bpd.beadT; bpt:BeadPtr←Get[t];
hooked:BOOLEAN←bps.beadD=bpt.beadU AND bps.beadD#noBead;
IF bps.beadT=up AND bpt.beadT=down
AND (bps.beadL=noBead OR bpt.beadL=noBead)
AND (bps.beadR=noBead OR bpt.beadR=noBead)
AND (hooked OR (bps.beadU=noBead OR bpt.beadU=noBead)
AND (bps.beadD=noBead OR bpt.beadD=noBead))
THEN BEGIN
IF bps.beadD#noBead AND bpt.beadU#noBead AND bps.beadD#bpt.beadU
THEN RETURN;
Fix[leftRight,down,up];
bpu.beadD←bpd.beadD;
Get[bpu.beadD].beadU←up;
ReleaseBead[down];
ReleaseBead[i];
Fix[leftRight,t,s];
IF hooked THEN Get[bps.beadD←bpt.beadD].beadU←s
ELSE Fix[upDown,t,s];
IF hooked THEN ReleaseBead[bpt.beadU];
ReleaseBead[t];
END;
END;
END;

udlr:TYPE={leftRight,upDown};

Fix:PROCEDURE[dir:udlr,a,b:CARDINAL]=BEGIN try:CARDINAL;
bpa:BeadPtr←Get[a]; bpb:BeadPtr←Get[b];
SELECT dir FROM
leftRight=>BEGIN
IF (try←bpa.beadL)#noBead
THEN BEGIN Get[try].beadR←b; bpb.beadL←try; END;
IF (try←bpa.beadR)#noBead
THEN BEGIN Get[try].beadL←b; bpb.beadR←try; END;
END;
ENDCASE=>BEGIN
IF (try←bpa.beadU)#noBead
THEN BEGIN Get[try].beadD←b; bpb.beadU←try; END;
IF (try←bpa.beadD)#noBead
THEN BEGIN Get[try].beadU←b; bpb.beadD←try; END;
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

freeBeadList:CARDINAL;

MakeBead:PROCEDURE[type:BeadType,bpi:BeadPtr,i:CARDINAL] RETURNS[k:CARDINAL]= BEGIN
bpk:BeadPtr;
k←GetFreeBead[]; bpk←Get[k];
bpk.t←type;
bpk.beadR←bpk.beadL←bpk.beadU←bpk.beadD←bpk.beadT←noBead;
bpk.w←bpk.h←bpi.h;
bpk.wire←SELECT type FROM wireR, wireB, wireG=>TRUE, ENDCASE=>FALSE;
bpk.noodle←topNoodle;
bpk.nextBelow←noBelow;
bpk.circuit←bpi.circuit;
bpk.external←0;
END;

GetFreeBead:PROCEDURE RETURNS[i:CARDINAL]=BEGIN
i←freeBeadList;
IF i#noBead THEN freeBeadList←Get[i].beadT
ELSE BEGIN
IF topBead=noBead-1 THEN SIGNAL NoMoreBeads;
i←topBead←topBead+1;
END;
END;

ReleaseBead:PROCEDURE[i:CARDINAL]=BEGIN bpi:BeadPtr;
bpi←Get[i];
bpi.t←none;
bpi.beadT←freeBeadList;
bpi.wire←FALSE;
freeBeadList←i;
END;

ScavageBeads:PUBLIC PROCEDURE=BEGIN i:CARDINAL;
FOR i DECREASING IN [0..topBead]
DO IF Get[i].t=none THEN TrueReleaseBead[i]; ENDLOOP;
freeBeadList←noBead;
END;

TrueReleaseBead:PROCEDURE[i:CARDINAL]=BEGIN s,j:CARDINAL;
IF i>topBead THEN Error;
IF i#topBead THEN BEGIN
bpi:BeadPtr←Get[i];
bpi↑←Get[topBead]↑;
Get[bpi.beadR].beadL←i;
Get[bpi.beadL].beadR←i;
Get[bpi.beadU].beadD←i;
Get[bpi.beadD].beadU←i;
IF bpi.beadT#noBead THEN BEGIN
FOR s←i,j UNTIL (j←Get[s].beadT)=topBead DO ENDLOOP;
Get[s].beadT←i;
END;
END;
Track[i," released ",0];
Track[topBead," renamed to ",i];
--trackBead←SELECT trackBead FROM i=>noBead, topBead=>i, ENDCASE=>trackBead;
topBead←topBead-1;
END;


END..

IF bpi.t=wireR AND Get[j].t=wireG AND Get[j].w>32 AND bendingWires
AND FALSE THEN BEGIN
IODefs.WriteChar[CR];
IODefs.WriteNumber[j, [10,FALSE,TRUE,5]];
IODefs.WriteString[" width "];
IODefs.WriteNumber[Get[j].w, [10,FALSE,TRUE,5]];
IODefs.WriteString[" y "];
IODefs.WriteNumber[Get[j].y, [10,FALSE,TRUE,5]];
IODefs.WriteString[" pushing "];
IODefs.WriteNumber[i, [10,FALSE,TRUE,5]];
END;

Fall: The intent of Fall is to try to let each bead move down in such a way that horizontal wires get straightened out and vertical wires get shortened ( if that is convenient and legal) There are several reasons to implement fall:
1) a bent wire uses up more computer storage than a straight(er) one
2) some cases of fall produce less colored area locally, which is electrically better.
3) unnecessarily bent wires tend to inhibit further progress in compressing the diagram in the other dimension.

WireFall[i]: The intent of wire fall is to examine a horizontal wire for bends, and to straighten out the bends by dropping the higher wire segment if that is possible. There are three cases - a bend up, a bend down, and a bend of height 0 (not fundamental, but this is a good place to get rid of them). The details are complicated at each end by several constraints: a segment anchored to a transistor cannot drop, a segment anchored to a bead of larger width may slide along that bead, and should do so according to rules which depend on the next segment over, and one must watch out for zero width segments at the ends. WireFall mainpulates noodles directly.