-- beadsMerge.mesa

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

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

ScourBeads:PUBLIC PROCEDURE=BEGIN
EnumerateBeads[RemoveStraightThroughs];
EnumerateBeads[OverlappedJunctionAndContact1];
EnumerateBeads[OverlappedJunctionAndContact2];
EnumerateBeads[OverlappedContacts];
FixWires[];
END;

RemoveStraightThroughs:PROCEDURE[i:Desc]=BEGIN
IF Junction[i] THEN SELECT TRUE FROM
NoBeadL[i] AND NoBeadR[i]=>RemoveUpAndI[i];
NoBeadU[i] AND NoBeadD[i]=>RemoveRtAndI[i];
ENDCASE;
END;

OverlappedJunctionAndContact1:PROCEDURE[i:Desc]=BEGIN
IF Junction[i] AND ~NoBeadD[i] THEN BEGIN
d:Desc←DescD[i];
dd:Desc←DescD[d];
IF Contact[dd] AND Top[i]<=Top[dd]
AND (NoBeadL[i] OR NoBeadL[dd]) AND (NoBeadR[i] OR NoBeadR[dd])
THEN {FixLR[i,dd]; RemoveUpAndI[d];};
END; END;

OverlappedJunctionAndContact2:PROCEDURE[i:Desc]=BEGIN
IF ~Junction[i] OR NoBeadU[i] THEN RETURN;
BEGIN
u:Desc←DescU[i];
uu:Desc←DescU[u];
IF Contact[uu] AND Bot[uu]<=Bot[i]
AND (NoBeadL[i] OR NoBeadL[uu]) AND (NoBeadR[i] OR NoBeadR[uu])
THEN{ FixLR[i,uu]; RemoveUpAndI[u];};
END; END;

OverlappedContacts:PROCEDURE[i:Desc]=BEGIN
IF ~Contact[i] OR NoBeadU[i] THEN RETURN;
BEGIN
u:Desc←DescU[i];
uu:Desc←DescU[u];
IF Contact[uu]
AND (NoBeadL[i] OR NoBeadL[uu]) AND (NoBeadR[i] OR NoBeadR[uu])
AND Lfm[uu]=Lfm[i] AND Bot[uu]=Bot[i]
AND Height[uu]=Height[i] AND Width[uu]=Width[i]
THEN BEGIN
s:Desc←DescT[uu];
t:Desc←DescT[i];
hooked:BOOLEAN←DescD[s]=DescU[t] AND ~NoBeadD[s];
IF DescT[s]=uu AND DescT[t]=i
AND (NoBeadL[s] OR NoBeadL[t])
AND (NoBeadR[s] OR NoBeadR[t])
AND (hooked OR (NoBeadU[s] OR NoBeadU[t])
AND (NoBeadD[s] OR NoBeadD[t]))
AND (NoBeadD[s] OR NoBeadU[t] OR hooked)
THEN BEGIN
FixLR[i,uu];
RemoveDownAndI[u];
FixLR[t,s];
IF hooked THEN HookUD[DescD[t],s] ELSE FixUD[t,s];
IF hooked THEN ReleaseBead[DescU[t]];
ReleaseBead[t];
END; END; END; END;

FixLR:PROCEDURE[a,b:Desc]=BEGIN
IF ~NoBeadL[a] THEN HookLR[DescL[a],b];
IF ~NoBeadR[a] THEN HookLR[b,DescR[a]];
END;

FixUD:PROCEDURE[a,b:Desc]=BEGIN
IF ~NoBeadD[a] THEN HookUD[DescD[a],b];
IF ~NoBeadU[a] THEN HookUD[b,DescU[a]];
END;

RemoveUpAndI:PROCEDURE[i:Desc]=BEGIN
u:Desc←DescU[i];
uu:Desc←DescU[u];
d:Desc←DescD[i];
IF NoBead[u] OR NoBead[d] THEN Error;
IF Width[u]#Width[d] OR Lfm[u]#Lfm[d] THEN RETURN;
HookUD[d,uu];
ReleaseBead[u];
ReleaseBead[i];
FixWire[uu];
END;

RemoveDownAndI:PROCEDURE[i:Desc]=BEGIN
u:Desc←DescU[i];
d:Desc←DescD[i];
dd:Desc←DescD[d];
IF NoBead[u] OR NoBead[d] THEN Error;
IF Width[u]#Width[d] OR Lfm[u]#Lfm[d] THEN RETURN;
HookUD[dd,u];
ReleaseBead[d];
ReleaseBead[i];
FixWire[dd];
END;

RemoveRtAndI:PROCEDURE[i:Desc]=BEGIN
r:Desc←DescR[i];
l:Desc←DescL[i];
rr:Desc←DescR[r];
IF NoBead[r] OR NoBead[l] THEN Error;
IF Height[r]#Height[l] OR Bot[r]#Bot[l] THEN RETURN;
HookLR[l,rr];
ReleaseBead[r];
ReleaseBead[i];
FixWire[rr];
END;

UnnecessaryJunction:PROCEDURE[i:Desc]=BEGIN
IF Junction[i] AND ~NoBeadU[i] THEN BEGIN
w:Desc←DescU[i];
IF Height[w]<12 THEN BEGIN
u:Desc←DescU[w];
IF Junction[u] THEN BEGIN
IF Bot[i]=Bot[u] THEN BEGIN
i.p.beadU←u.p.beadU;
SELECT TRUE FROM
NoBeadL[u]=>NULL;
NoBeadL[i]=>i.p.beadL←u.p.beadL;
ENDCASE=>NULL;--xxxL;
SELECT TRUE FROM
NoBeadR[u]=>NULL;
NoBeadR[i]=>i.p.beadR←u.p.beadR;
ENDCASE=>NULL;--xxxR;
ReleaseBead[w]; ReleaseBead[u];
END
ELSE BEGIN
IF ~NoBeadL[u] AND ~NoBeadL[i] THEN BEGIN
ul :Desc←DescL[ u];
il :Desc←DescL[ i];
ull:Desc←DescL[ul];
ill:Desc←DescL[il];
gainU:INTEGER←Width[ul]-IfTran[ull,6];
gainI:INTEGER←Width[il]-IfTran[ill,6];
IF MIN[gainU,gainI]>Width[u] THEN BEGIN
IF gainU>gainI THEN BEGIN
--IF tt or end insert a Jcn/wire
--If no hook down, insert a Jcn/wire
--Insert second jcn,wire
END;
END;
END
ELSE BEGIN
--more here
END;
IF ~NoBeadR[u] AND ~NoBeadR[i] THEN BEGIN
ul :Desc←DescR[u];
il :Desc←DescR[i];
ull:Desc←DescR[ul];
ill:Desc←DescR[il];
gainU:INTEGER←Width[ul]-IfTran[ull,6];
gainI:INTEGER←Width[il]-IfTran[ill,6];
IF MIN[gainU,gainI]>Width[u] THEN BEGIN
IF gainU>gainI THEN BEGIN
--IF tt or end insert a Jcn/wire
--If no hook down, insert a Jcn/wire
--Insert second jcn,wire
END;
END;
END
ELSE BEGIN
--more here
END;
END;
END; 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

ReleaseBead:PUBLIC PROCEDURE[i:Desc]=BEGIN
i.p.t←none;
i.p.beadT←freeBeadList;
i.p.wire←FALSE;
freeBeadList←i.z;
DO IF Get[topBead].t=none THEN topBead←topBead-1 ELSE EXIT; ENDLOOP;
END;

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

TrueReleaseBead:PROCEDURE[i:CARDINAL]=BEGIN
j:Desc←GetDesc[i];
IF j.z>topBead THEN Error;
IF j.z#topBead THEN BEGIN
t:Desc←GetDesc[topBead];
bpi:BeadPtr←Get[i];
j.p↑←t.p↑;
DescR[j].p.beadL←i;
DescL[j].p.beadR←i;
DescU[j].p.beadD←i;
DescD[j].p.beadU←i;
IF ~NoBeadT[j] THEN FOR s:Desc←j,DescT[s] DO
IF s.p.beadT=t.z THEN {s.p.beadT←i; EXIT}; ENDLOOP;
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..

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.


ScourBead:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
conu,cond:BOOLEAN;
up:CARDINAL←bpi.beadU;
down:CARDINAL←bpi.beadD;
bpu:BeadPtr←Get[up];
bpd:BeadPtr←Get[down];
room:BOOLEAN←(NoBeadL[bpu] OR NoBeadL[bpd])
AND (NoBeadR[bpu] OR NoBeadR[bpd]);
IF ~VerticalWire[bpi] OR bpu.y>=Top[bpd]+8 OR ~room THEN RETURN;
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;
SELECT TRUE FROM
Top[bpu]<=Top[bpd] AND ~conu=>
{FixLR[up,down]; RemoveUpAndI[i,bpi];};
bpu.y<=bpd.y AND ~cond =>{ FixLR[down,up]; RemoveRtAndI[i,bpi];};
conu AND cond AND bpu.x=bpd.x AND bpu.y=bpd.y
AND bpu.h=bpd.h AND bpu.w=bpd.w => BEGIN
s:CARDINAL←bpu.beadT; bps:BeadPtr←Get[s];
t:CARDINAL←bpd.beadT; bpt:BeadPtr←Get[t];
hooked:BOOLEAN←bps.beadD=bpt.beadU AND ~NoBeadD[bps];
IF bps.beadT=up AND bpt.beadT=down
AND (NoBeadL[bps] OR NoBeadL[bpt])
AND (NoBeadR[bps] OR NoBeadR[bpt])
AND (hooked OR (NoBeadU[bps] OR NoBeadU[bpt])
AND (NoBeadD[bps] OR NoBeadD[bpt]))
AND (NoBeadD[bps] OR NoBeadU[bpt] OR bps.beadD=bpt.beadU)
THEN BEGIN
FixLR[down,up];
RemoveDownAndI[i,bpi];
FixLR[t,s];
IF hooked THEN Get[bps.beadD←bpt.beadD].beadU←s ELSE FixUD[t,s];
IF hooked THEN ReleaseBead[bpt.beadU];
ReleaseBead[t];
END;
END;
ENDCASE;
END;