-- beadsPut.mesa

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

Error:SIGNAL=CODE;

StartIncrementalDisplay:PROCEDURE=BEGIN END;
IncrementalDisplay:PROCEDURE=BEGIN END;
EndIncrementalDisplay:PROCEDURE=BEGIN END;

howMuch:PUBLIC [0..256);
cnt1,cnt2,cnt3,cnt4,cnt5,cnt6,cnt7,cnt8:LONG CARDINAL;
pushingY:[0..1024);
--i is the bead being processed (pushing j)
bi,bj:Desc;
delta:Coord;
wpi,wpj:WorkPtr;
iy,ih,jy,jh:INTEGER;
gain:INTEGER;



PositionBeads:PUBLIC PROCEDURE= BEGIN
seen←seen1←seen2←FALSE; ClearCounts[]; InitNoodle[];
EnumerateBeads[InitBackSortAndProcessed];
StartIncrementalDisplay[];
FOR pushingY←0,pushingY+1 UNTIL pushingY>topBead
DO PlaceABead[GetDesc[GetW[pushingY].sort]]; ENDLOOP;
EndIncrementalDisplay[];
gain←maxY;
EnumerateBeads[FindGain];
EnumerateBeads[MoveDown];
PrintCounts[];
END;

PlaceABead:PROCEDURE[i:Desc]= BEGIN
bi←i; wpi←Getw[i]; iy←wpi.newY; ih←Height[i];
IF ~wpi.processed AND Type[i]#none THEN
BEGIN cnt1←cnt1+1; []←TryAllBelow[i.z,Shoot]; END;
wpi.processed←TRUE;
IncrementalDisplay[];
END;

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

InitBackSortAndProcessed:PROCEDURE[i:Desc]=BEGIN
wpi←Getw[i];
GetW[wpi.sort].backSort←i.z;
wpi.processed←VerticalWire[i];
END;

Shoot:PROCEDURE[i,j:CARDINAL] RETURNS[ok:BOOLEAN] =BEGIN
ok←TRUE;
bj←GetDesc[j]; wpj←Getw[bj]; jy←Bot[bj]; jh←Height[bj];
delta←Delta[bi,bj];
delta.x←MAX[0,delta.x];
cnt2←cnt2+1;
SELECT TRUE FROM
Type[bi]=none OR Type[bj]=none=>Error;
VerticalWire[bj]=>RETURN;
TiedBeads[bi,bj]=>TryT[];
Unrelated[bi,bj]=>RETURN;
LeftOf[bj,bi]=>TryR[];--probably backward!
LeftOf[bi,bj]=>TryL[];--probably backward!
NoWidths[bi,bj]=>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 ShowTracked[i,j];
END;

TryT:PROCEDURE =BEGIN UpdateY[jy-Bot[bi]+jh]; END;

TryL:PROCEDURE =BEGIN IF wpj.stiff THEN UpdateY[MAX[ih,jh]]
ELSE DoSegment[IF Tran[bi] THEN Lfm[bi]-2 ELSE Lfm[bi]+jh,maxX+1,iy+ih]; END;
--zero is probably good enough for jh

TryR:PROCEDURE =BEGIN UpdateY[LowestPoint[bi].y+MAX[ih,jh]]; END;

Try1:PROCEDURE =BEGIN f:INTEGER; t:CARDINAL;
--neither i nor j is a wire
IF ~Interact[bi,bj] THEN RETURN;
t←32+delta.y-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[Bot[bi]-jy-jh,delta.y]];
UpdateY[-f];
END;

--j is a wire, i is not
Try2:PROCEDURE =BEGIN
DoSegment[Lfm[bi]-delta.x,Rtm[bi]+delta.x,iy-delta.y];
END;

--i is a wire, j is not
Try3:PROCEDURE =BEGIN
w:INTEGER←Height[bi];
thisX:INTEGER←Lfm[bi]-w;
thisY:INTEGER←0;
lowestY:INTEGER←maxY;
leftEdge:INTEGER←LeftEdge[bi];
rightEdge:INTEGER←RightEdge[bi];
range1:INTEGER←Lfm[bj]-w-delta.x;
range2:INTEGER←Rtm[bj]+delta.x;
Lowest:PROCEDURE[d:Coord]=BEGIN
IF MAX[thisX,leftEdge]<range2 AND MIN[thisX+d.x,rightEdge]>range1
THEN lowestY←MIN[lowestY,thisY];
thisX←thisX+d.x;
thisY←thisY+d.y;
END;
FollowShortNoodle[bi,Lowest];
Lowest[[rightEdge-thisX,0]];
IF lowestY<maxY THEN UpdateY[lowestY-delta.y];
END;

--both i and j are wires
Try4:PROCEDURE =BEGIN
bw:BentWireData;
wireWidthi:INTEGER=Height[bi];
leftExt:INTEGER←delta.x-IfTran[bi,wireWidthi+2];
rightExt:INTEGER←delta.x+wireWidthi;
NoName:PROCEDURE=BEGIN
DoSegment[bw.thisX-leftExt,bw.nextX+rightExt,bw.thisY-delta.y,FALSE];
leftExt←delta.x;
END;
IF NoWidths[bi,bj] THEN Error;
IF bi.p.beadR=bj.p.beadL OR bi.p.beadL=bj.p.beadR THEN Error;
FollowNoodle[bi,@bw,NoName];
rightExt←rightExt-IfTran[bi,wireWidthi];
DoSegment[bw.thisX-leftExt,bw.lastX+rightExt,bw.thisY-delta.y];
END;

UpdateY:PROCEDURE[del:INTEGER] =BEGIN
newY:INTEGER←wpj.newY;
BetterY:INTEGER←del+iy-jh;
IF BetterY NOT IN [0..maxY] OR bj.z>topBead THEN
BEGIN IF ~seen2 THEN Error; seen2←TRUE; BetterY←jy; END;
IF BetterY+2<jy THEN {IF ~seen THEN Error; seen←TRUE; BetterY←jy};
IF VerticalWire[bj] THEN Error;
IF BetterY>=newY THEN RETURN;
wpj.newY←BetterY;
IF ~wpj.stiff THEN BEGIN
[]←MakeNewNoodle[topNoodle,bj.p,0,newY-BetterY];
DoSegment[0,LeftEdge[bj]+jh,BetterY+jh];
END;
--ShowSpit[bj,BetterY];
Push[bj];
END;

seen,seen1,seen2:BOOLEAN←FALSE;

DoSegment:PROCEDURE[left,right,height:INTEGER,clean:BOOLEAN←TRUE] =BEGIN
bw:BentWireData;
IF left>=right OR ~Wir[bj] THEN Error;
IF Rtm[bj]+Height[bj]<=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 {old←this; this←MakeNewNoodle[old,bj.p,x,y];};
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+Height[bj])
THEN RETURN;
IF this=topNoodle THEN this←InsertNewNoodle[old,bj.p];
SetNoodle[this,leftX-thisX,height-thisY];
IF right<nextX
THEN {Append[right-leftX,thisY-height]; Append[nextX-right,nextY-thisY]}
ELSE Append[nextX-leftX,nextY-height];
IF MIN[right,nextX]-thisX>0 THEN Push[bj];--rightis > thisX
--this is not always necessary, should experiment!
END;
wire:INTEGER←Height[bj];
left←MAX[left,Lfm[bj]]-wire;
height←height-wire;
FollowNoodle[bj,SegSeg];
SegSeg[];
IF clean THEN CleanNoodle[bj];
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:Desc]=BEGIN
bw:BentWireData;
BEGIN OPEN bw;
l:Desc←DescL[j];
r:Desc←DescR[j];
wpj:WorkPtr←Getw[j];
wpr:WorkPtr←Getw[r];
wire:INTEGER←Height[j];
leftPivot:INTEGER←LeftEdge[j];
rightPivot:INTEGER←RightEdge[j];
rightY1:INTEGER←wpr.newY;
rightY2:INTEGER←rightY1+MAX[Height[r]-wire,0];
NoName:PROCEDURE={IF dx=0 AND old#topNoodle THEN MergeL[@bw]};
StillNoName:PROCEDURE=BEGIN
done←TRUE;
SELECT TRUE FROM
dx=0 AND old#topNoodle=>MergeR[@bw];
dy=0=>MergeLPlus[@bw];
nextX>rightPivot=>BEGIN
Push[j];
IF dy<0 THEN MoveJog[this,rightPivot-nextX,0] ELSE MergeLPlus[@bw];
END;
nextX<leftPivot AND dy<0=>BEGIN
Push[j];
wpj.newY←nextY;
IF old#topNoodle THEN Error;
IncrementNoodle[next,dx,0]; ReleaseNoodle[this,old,j];
END;
nextX<leftPivot=>BEGIN
Push[j];
IF next=topNoodle OR nextX+nextdx>leftPivot
THEN MoveJog[this,leftPivot-nextX,0] ELSE MergeLPlus[@bw];
END;
NearRight[] AND thisY IN [rightY2..nextY)=>MergeLPlus[@bw];
NearRight[] AND rightY1 IN [thisY..nextY)=>MoveJog[this,0,rightY1-nextY];
Wicket[]=>IF olddy>-dy THEN MergeR[@bw] ELSE MergeL[@bw];
nextX=lastX AND ~Trans[r]=>BEGIN
SELECT nextY FROM
>rightY2=>IncrementNoodle[this,0,rightY2-nextY];
<rightY1=>IncrementNoodle[this,0,rightY1-nextY];
ENDCASE;
done←FALSE;
END;
ENDCASE=>done←FALSE;
END;
NearRight:PROCEDURE RETURNS[b:BOOLEAN]=INLINE {b←nextX>rightPivot-wire-8};
Wicket:PROCEDURE RETURNS[b:BOOLEAN]=INLINE BEGIN
b←nextX<MAX[leftPivot+8,thisX+wire+12]
AND old#topNoodle AND olddy>0 AND dy<0; END;
CheckWire[j];
FollowNoodle[j,@bw,NoName];
DO
FollowNoodle[j,@bw,StillNoName];
IF done THEN EXIT;
ENDLOOP;
CheckWire[j];
END; END;

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

CheckWire:PROCEDURE[j:Desc] =BEGIN
NoName:PROCEDURE[d:Coord]=BEGIN IF d.x<0 OR (thisY←thisY+d.y)+6<Bot[j]
THEN Seen1[]; END;
thisY:INTEGER←Getw[j].newY;
NoName[Zero];
FollowShortNoodle[j,NoName];
END;

Push:PROCEDURE[i:Desc]=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;

FindGain:PROCEDURE[i:Desc]=
{IF ~VerticalWire[i] THEN gain←MIN[gain,Getw[i].newY+LowestPoint[i].x]};

MoveDown:PROCEDURE[i:Desc]=
{i.p.y←IF Bot[i]#0 OR ~End[i] OR NoBeadU[i] THEN Getw[i].newY-gain ELSE 0};

LowestPoint:PROCEDURE[i:Desc] RETURNS[f:Coord]= BEGIN
NoName:PROCEDURE[d:Coord]={f.x←MIN[f.x,f.y←f.y+d.y]};
f←Zero;
IF ~Getw[i].stiff THEN FollowShortNoodle[i,NoName];
END;


PrintCounts:PUBLIC PROCEDURE= BEGIN
IODefs.WriteChar[CR];
PrintLong[cnt1]; PrintLong[cnt2]; PrintLong[cnt7]; PrintLong[cnt8];
END;

ShowTracked:PROCEDURE[i,j:CARDINAL]=BEGIN OPEN IODefs;
WriteChar[CR];
WriteNumber[i, [10,FALSE,TRUE,5]];
WriteString[" put "];
WriteNumber[j, [10,FALSE,TRUE,5]];
WriteString[" at "];
WriteNumber[GetW[j].newY, [10,FALSE,TRUE,5]];
END;

END..