-- beadsPut4.mesa
-- changed to uniform below

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

Error:SIGNAL=CODE;

howMuch:[0..256);
cnt1,cnt2,cnt3,cnt4,cnt5,cnt6,cnt7,cnt8:LONG CARDINAL;
from:INTEGER←0;--debugging aid
sep:INTEGER;--debugging aid
pushingY:[0..1024);
firstTime:BOOLEAN←TRUE;

-- ////// CONTROL ///////

PutTheBeadsWhereTheyBelong:PUBLIC PROCEDURE[b:BOOLEAN,h:[0..256)]=
--make b go away
BEGIN i:CARDINAL;
bendingWires←b; howMuch←h;
InitPut[]; FixWires[]; PositionBeads[]; AdjustTheBottom[]; FixWires[];
IF fallBack AND b AND firstTime THEN BEGIN
firstTime←TRUE;
FOR i IN [0..topBead] DO GetW[i].newY←Get[i].y; ENDLOOP;
Fall[]; FixWires[];
END;
PrintCounts[];
END;

AdjustTheBottom:PROCEDURE= BEGIN i,j:CARDINAL; gain:INTEGER←maxY;
bpi:BeadPtr;
FOR i IN [0..topBead] DO
bpi←Get[i];
IF bpi.t=none THEN LOOP;
IF ~(bpi.wire AND bpi.beadU#noBead) THEN BEGIN
iy:INTEGER←GetW[i].newY;
gain←MIN[gain,iy];
FOR j ← bpi.noodle, noodleChain[j] UNTIL j=topNoodle
DO iy←iy+noodleDY[j]; gain←MIN[gain,iy]; ENDLOOP;
END;
ENDLOOP;
FOR i IN [0..topBead] DO bpi←Get[i];
IF bpi.t=none THEN LOOP;
IF bpi.y#0
OR (SELECT bpi.t FROM endG,endB,endR,endO=>FALSE, ENDCASE=>TRUE)
OR bpi.beadU=noBead
THEN bpi.y←GetW[i].newY-gain
ELSE bpi.y←0; ENDLOOP;
END;

-- ////// DO THE WORK ///////

--i is the bead being processed (pushing j)
bi,bj:CARDINAL;
bpi,bpj:BeadPtr;
wpi,wpj:WorkPtr;
iy,ih,jy,jh:INTEGER;
deltaY,deltaX:INTEGER;

Push:PROCEDURE[i:INTEGER]=
BEGIN
wpi:WorkPtr←GetW[i];
y:INTEGER←wpi.backSort-1;
IF y<pushingY THEN BEGIN pushingY←y; cnt7←cnt7+1; END;
wpi.processed←FALSE;
END;

PositionBeads:PROCEDURE= BEGIN i:CARDINAL;
pushingY←0;
FOR i IN [0..topBead]
DO bpi←Get[i]; wpi←GetW[i]; GetW[wpi.sort].backSort←i;
wpi.processed←bpi.wire AND bpi.beadR=noBead;
ENDLOOP;
ResetBelow[];
UNTIL pushingY>topBead DO
bi←i←GetW[pushingY].sort; bpi←Get[i]; wpi←GetW[i]; iy←wpi.newY; ih←bpi.h;
IF ~wpi.processed AND bpi.t#none THEN
BEGIN cnt1←cnt1+1; []←TryAllBelow[i,Shoot]; END;
wpi.processed←TRUE;
pushingY←pushingY+1;
ENDLOOP;
END;

Shoot:PROCEDURE[i,j:CARDINAL] RETURNS[ok:BOOLEAN] =BEGIN
ok←TRUE;
bj←j; bpj←Get[j]; wpj←GetW[j]; jy←bpj.y; jh←bpj.h;
[deltaX,deltaY]←Deltas[bi,bj];
from←bi;
cnt2←cnt2+1;
-- IF j=211 AND (i=80 OR i=70) AND bendingWires THEN Error;
SELECT TRUE FROM
bpi.t=none OR bpj.t=none=>Error;
bpj.wire AND bpj.beadR=noBead=>RETURN;
bi=bpj.beadT OR bj=bpi.beadT=>TryT[];
desP[bpi.t].lessLevel#desP[bpj.t].lessLevel=>RETURN;
bpi.beadL=bpj.beadR AND bpi.beadL#noBead=>RETURN;
bpi.beadR=bpj.beadL AND bpi.beadR#noBead=>RETURN;
bj=bpi.beadR=>TryR[];
bj=bpi.beadL=>TryL[];
bpj.w<0 OR bpi.w<0=>RETURN;
ENDCASE=>
IF wpj.stiff
THEN IF wpi.stiff THEN Try1[] ELSE Try3[]
ELSE IF wpi.stiff THEN Try2[] ELSE Try4[];
IF i=trackBead OR j=trackBead THEN BEGIN
IODefs.WriteChar[CR];
IODefs.WriteNumber[i, [10,FALSE,TRUE,5]];
IODefs.WriteString[" put "];
IODefs.WriteNumber[j, [10,FALSE,TRUE,5]];
IODefs.WriteString[" at "];
IODefs.WriteNumber[wpj.newY, [10,FALSE,TRUE,5]];
END;
END;

TryT:PROCEDURE =BEGIN UpdateY[jy-bpi.y+jh]; END;

TryL:PROCEDURE =BEGIN
IF wpj.stiff THEN UpdateY[MAX[ih,jh]]
ELSE BEGIN
DoSegment[bpi.x+ih-IfTrans[bi,ih+2],maxX+1,iy+ih,bj];
CleanNoodle[bj];
END;
END;

TryR:PROCEDURE =BEGIN
this:CARDINAL;
endY:INTEGER←0;
IF ~wpi.stiff THEN
FOR this←bpi.noodle,noodleChain[this]
UNTIL this=topNoodle DO endY←endY+noodleDY[this]; ENDLOOP;
UpdateY[endY+MAX[ih,jh]];
END;

Try1:PROCEDURE =BEGIN f:INTEGER; t:CARDINAL;
--neither i nor j is a wire
ti:BeadType←bpi.t; tj:BeadType←bpj.t;
si:CARDINAL=desP[ti].short; sj:CARDINAL=desP[tj].short;
cnt3←cnt3+1;
IF bpj.x-bpi.x NOT IN (-bpj.w-Des6[sj][si]..bpi.w+Des6[sj][si]) THEN RETURN;
sep←deltaY;
t←32+deltaY-1;
f←t-(SELECT howMuch FROM
1=>0, 2=>t MOD 2, 4=>t MOD 4, 8=>t MOD 8, 16=>t MOD 16, ENDCASE=>ERROR);
f←MIN[f-32+howMuch,MAX[bpi.y-jy-jh,deltaY]];
UpdateY[-f];
END;

Try2:PROCEDURE =BEGIN
--j is a wire, i is not
del:INTEGER←MAX[0,deltaX];
cnt4←cnt4+1;
DoSegment[bpi.x-del,bpi.x+bpi.w+del,iy-deltaY,bj];
CleanNoodle[bj];
END;

Try3:PROCEDURE =BEGIN--much more complex than necessary!
--i is a wire, j is not
w:INTEGER←bpi.h;
thisX:INTEGER←bpi.x-w;
thisY:INTEGER←-deltaY;
jx:INTEGER←bpj.x;
lowestY:INTEGER←maxY;
this:CARDINAL;
range1,range2:INTEGER;
leftEdge:INTEGER←bpi.x-w+IfTrans[bpi.beadL,w+2];
rightEdge:INTEGER←bpi.x+bpi.w-IfTrans[bpi.beadR,w+2];
cnt5←cnt5+1;
range1←jx-w-deltaX;
range2←jx+bpj.w+deltaX;
FOR this←bpi.noodle,noodleChain[this]
UNTIL this=topNoodle DO BEGIN
nextX:INTEGER←thisX+noodleDX[this];
IF MAX[thisX,leftEdge]<range2 AND MIN[nextX,rightEdge]>range1
AND thisY<lowestY THEN lowestY←thisY;
thisX←nextX;
thisY←thisY+noodleDY[this];
END; ENDLOOP;
IF MAX[thisX,leftEdge]<range2 AND rightEdge>range1
AND thisY<lowestY THEN lowestY←thisY;
IF lowestY<maxY THEN UpdateY[lowestY];
END;

Try4:PROCEDURE =BEGIN
--both i and j are wires
bw:BentWireData;
leftExt,rightExt:INTEGER;
wireWidthi:INTEGER←bpi.h;
del:INTEGER←MAX[0,deltaX];
cnt6←cnt6+1;
leftExt←del-IfTrans[bi,wireWidthi+2];
rightExt←del+wireWidthi;
IF bpi.w<0 OR bpj.w<0 THEN Error;
IF bpi.beadR=bpj.beadL OR bpi.beadL=bpj.beadR THEN Error;
StartBentWire[bi,@bw];
UNTIL bw.this=topNoodle DO
DoSegment[bw.thisX-leftExt,bw.nextX+rightExt,bw.thisY-deltaY,bj];
leftExt←del;
AdvanceBentWire[@bw];
ENDLOOP;
rightExt←rightExt-IfTrans[bi,wireWidthi];
DoSegment[bw.thisX-leftExt,bw.lastX+rightExt,bw.thisY-deltaY,bj];
CleanNoodle[bj];
END;

UpdateY:PROCEDURE[nextY:INTEGER] =BEGIN
newY:INTEGER←wpj.newY;
nextY←nextY+iy-jh;
IF nextY NOT IN [0..maxY] OR bj>topBead THEN
BEGIN IF ~seen2 THEN Error; seen2←TRUE; nextY←jy; END;
IF nextY+2<jy THEN
BEGIN IF ~seen THEN Error; seen←TRUE; nextY←jy; END;
IF bpj.wire AND bpj.beadR=noBead THEN RETURN;
IF nextY>=newY THEN BEGIN --ShowFalse[bj,nextY];-- RETURN; END;
wpj.newY←nextY;
IF ~wpj.stiff THEN BEGIN
n:CARDINAL←bpj.noodle;
t:CARDINAL←GetFreeNoodle[];
ChangeNoodle[t,n,0,newY-nextY];
bpj.noodle←t;
DoSegment[0,bpj.x+IfTrans[bpj.beadL,jh+2],nextY+jh,bj];
CleanNoodle[bj];
END;
--ShowSpit[bj,nextY];
Push[bj];
END;

seen,seen1,seen2:BOOLEAN←FALSE;

DoSegment:PROCEDURE[left,right,height:INTEGER,j:CARDINAL] =BEGIN
bw:BentWireData;
bpj:BeadPtr←Get[j];
IF left>=right THEN Error;
IF bpj.x+bpj.w+bpj.h<=left OR right<left THEN RETURN;
BEGIN OPEN bw;
Append:PROCEDURE[x,y:INTEGER] =BEGIN
IF x<0 THEN Error;
IF x=0 THEN IncrementNoodle[this,0,y]
ELSE BEGIN
new:CARDINAL←GetFreeNoodle[];
ChangeNoodle[new,noodleChain[this],x,y];
ChangeNoodleChain[this,new];
old←this;
this←new;
END;
END;

SegSeg:PROCEDURE=BEGIN
leftX:INTEGER←MAX[left,thisX];
IF thisY<=height THEN RETURN;
IF left>=nextX OR right<=thisX OR left=nextX AND left#(lastX+bpj.h)
THEN RETURN;
IF this=topNoodle THEN BEGIN
this←GetFreeNoodle[];
ChangeNoodleChain[this,topNoodle];
IF old=topNoodle THEN bpj.noodle←this
ELSE ChangeNoodleChain[old,this];
END;
ChangeNoodle[this,noodleChain[this],leftX-thisX,height-thisY];
IF right<nextX THEN BEGIN
Append[right-leftX,thisY-height];
Append[nextX-right,nextY-thisY];
END
ELSE Append[nextX-leftX,nextY-height];
IF MIN[right,nextX]-thisX>0 THEN Push[j];--rightis > thisX
END;

wire:INTEGER←bpj.h;
IF left<bpj.x THEN left←bpj.x;
left←left-wire;
height←height-wire;
StartBentWire[j,@bw];
UNTIL this=topNoodle DO SegSeg[]; AdvanceBentWire[@bw]; ENDLOOP;
bw.nextX←lastX;
bw.nextY←thisY;
SegSeg[];
END; END;

--CleanNoodle[j, a wire]:
-- If a wire segment has dx=0 or dy=0, then it should be removed for
-- efficiency. dx=0 is meaningful on the first segment
--If a wire bends within delta of a transistor, on either end, then the
-- wire must be straightened. either by dropping the transistor or a
-- segment of wire. Watch out - the bend might be within delta of both ends!
--If a wire bends up and then down again, without room inside the bend for
-- any bead to stick up, then the up/down must be dropped to the height
-- of the higher side. This is complicated when the bend up terminates on an
-- end bead on one side or another. This is not an efficiency matter! -
-- The little stub left sticking up might well be less than a wire wide, and
-- must be eliminated.
--One need not worry about a bend down and then up, since there is nothing
-- which can cause that to happen.

CleanNoodle:PROCEDURE[j:CARDINAL]=BEGIN
Swivel:PROCEDURE[x,y:INTEGER]=BEGIN
IncrementNoodle[bw.this,x,y];
IncrementNoodle[bw.next,-x,-y];
release←FALSE;
END;
release,startOver:BOOLEAN;
done:BOOLEAN←FALSE;
bpj:BeadPtr←Get[j];
wpj:WorkPtr←GetW[j];
bw:BentWireData;
wire:INTEGER←bpj.h;
left:CARDINAL←bpj.beadL;
right:CARDINAL←bpj.beadR;
bpr:BeadPtr←Get[right];
wpr:WorkPtr←GetW[right];
leftDelta:INTEGER←IfTrans[left,wire+2];
rightDelta:INTEGER←IfTrans[right,wire+2];
leftPivot:INTEGER←bpj.x-wire+leftDelta;
rightPivot:INTEGER←bpr.x-rightDelta;
rightY1:INTEGER←wpr.newY;
rightY2:INTEGER←rightY1+MAX[bpr.h,wire]-wire;
CheckWire[j];
StartBentWire[j,@bw];
UNTIL bw.this=topNoodle DO BEGIN OPEN bw;
IF dx=0 AND old#topNoodle THEN MergeLeft[j,old];
AdvanceBentWire[@bw];
END; ENDLOOP;
--pass 2
UNTIL done DO
StartBentWire[j,@bw];
UNTIL done←bw.this=topNoodle DO BEGIN OPEN bw;
release←startOver←TRUE;
SELECT TRUE FROM
dx=0 AND old#topNoodle=>IncrementNoodle[old,dx,dy];
dy=0=>IncrementNoodle[next,dx,dy];
nextX>rightPivot=>BEGIN
Push[j];
IF dy<0 THEN Swivel[rightPivot-nextX,0]
ELSE IncrementNoodle[next,dx,dy];
END;
nextX<leftPivot=>BEGIN
Push[j];
IF dy<0
THEN BEGIN wpj.newY←nextY; IncrementNoodle[next,dx,0]; END
ELSE IF next=topNoodle OR nextX+nextdx>leftPivot
THEN Swivel[leftPivot-nextX,0]
ELSE IncrementNoodle[next,dx,dy];
END;
nextX>rightPivot-wire-8 AND thisY IN [rightY2..nextY)
=>IncrementNoodle[next,dx,dy];
nextX>rightPivot-wire-8 AND rightY1 IN [thisY..nextY)
=>Swivel[0,rightY1-nextY];
nextX<MAX[leftPivot+8,thisX+wire+12]
AND old#topNoodle AND olddy>0 AND dy<0=>
IF olddy>-dy THEN BEGIN
IncrementNoodle[old,0,dy];
IncrementNoodle[next,dx,0];
END
ELSE IncrementNoodle[old,dx,dy];
nextX=lastX AND rightDelta=0=>BEGIN
SELECT nextY FROM
>rightY2=>IncrementNoodle[this,0,rightY2-nextY];
<rightY1=>IncrementNoodle[this,0,rightY1-nextY];
ENDCASE;
startOver←release←FALSE;
END;
ENDCASE=>startOver←release←FALSE;
IF release THEN BEGIN
ReleaseNoodle[this];
IF old=topNoodle THEN bpj.noodle←next ELSE noodleChain[old]←next;
END;
IF startOver THEN EXIT;
AdvanceBentWire[@bw];
END; ENDLOOP;
ENDLOOP;
CheckWire[j];
END;

CheckWire:PROCEDURE[j:CARDINAL] =BEGIN
bpj:BeadPtr←Get[j];
thisY:INTEGER←GetW[j].newY;
this:CARDINAL;
IF thisY+6<bpj.y THEN Seen1[];
-- PrintWire[j];
FOR this←bpj.noodle,noodleChain[this] UNTIL this=topNoodle
DO IF noodleDX[this]<0 OR (thisY←thisY+noodleDY[this])+6<bpj.y
THEN Seen1[]; ENDLOOP;
END;

Seen1:PROCEDURE=BEGIN IF ~seen1 THEN BEGIN seen1←TRUE; Error; END; END;

--////// INITIALIZATION //////


InitPut:PROCEDURE=
BEGIN seen←seen1←seen2←FALSE; ClearCounts[]; InitNoodle[]; END;

ClearCounts:PROCEDURE= BEGIN cnt1←cnt2←cnt3←cnt4←cnt5←cnt6←cnt7←cnt8←0; END;

PrintCounts:PROCEDURE= BEGIN
IODefs.WriteChar[CR];
PrintLong[cnt1]; PrintLong[cnt2]; PrintLong[cnt3]; PrintLong[cnt4];
PrintLong[cnt5]; PrintLong[cnt6]; PrintLong[cnt7]; PrintLong[cnt8];
END;

Finish:PROCEDURE= BEGIN--for debugging
AdjustTheBottom[];
FixWires[];
[]←BeadsDefs.ManipulateDisplay[];
END;

InitNoodle:PROCEDURE= BEGIN i:CARDINAL;
FOR i IN [0..topNoodle) DO noodleChain[i]←i+1; ENDLOOP;
freeNoodleChain←0;
END;

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

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;


END..

PrintWire:PROCEDURE[j:CARDINAL] =BEGIN
thisY,thisX:INTEGER; this:CARDINAL;
IF j#trackBead OR j=noBead THEN RETURN;
IODefs.WriteChar[CR];
thisX←bead[j].x-bead[j].h; thisY←work[j].newY;
FOR this←bead[j].noodle,noodleChain[this] UNTIL this=topNoodle
DO
WriteCorner[thisX,thisY];
thisY←thisY+noodleDY[this];
thisX←thisX+noodleDX[this];
ENDLOOP;
WriteCorner[thisX,thisY];
WriteCorner[bead[j].x+bead[j].w,thisY];
END;

WriteCorner:PROCEDURE[a,b:CARDINAL] =BEGIN OPEN IODefs;
WriteChar[’(];
WriteNumber[a, [10,FALSE,TRUE,4]];
WriteChar[’,];
WriteNumber[b, [10,FALSE,TRUE,4]];
WriteChar[’)];
END;

PositionBeads and Push:
Position Beads implements the heart of the whole algorithm. All of the other modules can be considered as initialization, cleanup, efficiency hacks, or utility routines (Local Transformations excepted). Position is called with a loose diagram, and compresses it in the y dimension. To get compression in x, the whole diagram is rotated 90 degrees and Position is called again. Position accepts several minor parameters (like whether or not to bend wires).
The algorithm of position beads is to first place all the beads at the top of the figure, then to enumerate through all pairs of beads i and j and call Shoot to adjust down the position of j so that it is legal with respect to i. Whenever Shoot repositions a bead j , it calls Push[j] to tell Position that j has moved. Position continues to run until every pair has been processed with the i of the pair in its final position.
Position owns three data structures: a boolean per bead called "processed", a backpointer per bead to hold the inverse of the (constant) sort table, and the global "pushingY" which says how far through the processing we are. Position itself, as opposed to its friend Shoot, knows almost nothing about the details of beads, although it does know enough not to bother processing vertical wires.
For efficiency, position processes the higher beads first, based on the last iteration through the processing, hoping to not have to reprocess many beads - actually it should never reprocess beads except when they are connected as neighbors (rather than interacting by closeness). Also, Position does not try all of the possible j, but only those recommended by TryAllBelow, which is cleverly constructed to be able to find the few beads which might possibly interact with i without looking at those which cannot interact. The result of these two efficiencies is to change a potential n cubed algorithm to an n log n algorithm (TryAllBelow returns log n candidates for j - actually it returns something like 6 plus 1/8 log n, which means that one doesn’t see the log n until n = 2 to the 50 -but these numbers are shakey).

Shoot[i,j]: The function of Shoot is to make j legal with respect to i by moving j down, if necessary. Shoot uses Deltas to find the minumum x and y separation for interaction between i and j - all the design rule information is imbedded in Deltas (almost). Actually, Shoot is nothing but a big dispatch routine, determining which of several cases apply and then calling the appropiate routine labeled "try" to actually do the work. The cases recognized by Shoot are:
j is above i - assumed not to occur
i is vertical wire - assumed not to occur
j is vertical wire - do nothing (should not occur?)
i and j are tied - call tryT
i and j are different levels - do nothing (should not occur?)
i and j are across a TT - do nothing (should go in Deltas?)
i and j are neighbors - call tryR or tryL
i or j has negative length - do nothing
i and j are stiff - call try1
i is stiff - call try2
j is stiff - call try3
no stiff - call try4
A bead is stiff if it cannot bend. Only long wires can bend, ans those only when bending is asked for.