--beadsLocal.mesa August 21, 1979 11:30 AM
-- move beads
DIRECTORY IODefs:FROM"IODefs",
BeadsInlines:FROM"BeadsInlines",
InlineDefs:FROM"InlineDefs",
BeadsDefs:FROM"BeadsDefs";
BeadsLocal:PROGRAM IMPORTS BeadsInlines, InlineDefs, IODefs,BeadsDefs EXPORTS BeadsDefs=
BEGIN OPEN BeadsDefs, BeadsInlines;

KeepMesaHappy:PROCEDURE =BEGIN IODefs.WriteChar[’*]; END;
Error:SIGNAL=CODE;
--************************************************************************
--control procedures
CleanUp:PUBLIC PROCEDURE= BEGIN
Initialize[];
ResetBelow[];
EnumerateBeads[Local2];
-- EnumerateBeads[Local3];
-- EnumerateBeads[Local3a];
END;

Local:PUBLIC PROCEDURE=BEGIN
LocalStuff; -- Reflect[];
--LocalStuff; Reflect[];
--LocalStuff; Rotate[];
--LocalStuff; Rotate[];
END;

LocalStuff:PROCEDURE= BEGIN
EnumerateBeads[InitBeadWork];
Initialize[];
-- EnumerateBeads[PartWiggle];
EnumerateBeads[Transformation1];
EnumerateBeads[Transformation2];
EnumerateBeads[Transformation3];
EnumerateBeads[Transformation4];
EnumerateBeads[Transformation5];
EnumerateBeads[Local1];
END;


--************************************************************************
--transformations and local optimizations
--Local#1 deletes unneeded junctions
--Local#2 pulls horseshoes down tight
--Local#3 pulls in hooks
--Transformation#1 flips transistors
--Transformation#2 rotates contacts
--Transformation#3 merges contacts
--Transformation#4 also flips transistors
--Wiggle moves beads back and forth to see if the beads can be moved up

PartWiggle:PROCEDURE[k:Desc]=BEGIN
Wiggle:PROCEDURE[j:Desc]= BEGIN
i:Desc;
min:Coord←Delta[k,j];
IF k.p.wire OR j.p.wire THEN RETURN;-- why?
IF Bot[j]> Bot[k] THEN {i←j; j←k} ELSE i←k;-- j is now below i
IF min.y#Bot[i]-Top[j]
OR Lfm[j]>= Rtm[i]+ min.x
OR Rtm[j]<= Lfm[i]- min.x
OR TouchingBeads[i,j]
OR TiedBeads[i,j]
OR DescU[DescU[j]]=i THEN RETURN;
IF ~GoodMove[j.z,Rtm[i]+min.x-Lfm[j]]
AND ~GoodMove[j.z,Lfm[i]-(Rtm[j]+ min.x)] THEN Restore[];
END;
EnumerateBeads[Wiggle];
END;

GoodMove:PROCEDURE[jj,x:INTEGER] RETURNS[b:BOOLEAN]=BEGIN
b←Move[bead,jj,x,2]; IF b THEN Commit[] ELSE Abort[]; END;

Transformation1:PROCEDURE[i:Desc]= BEGIN
k,m,n:Desc;
IF i.p.t= ttV AND NoBeadR[i] AND
(m←DescL[k←DescL[i]]).p.t= rb AND
(n←DescT[m]).p.t= bf --AND
--Get[n].beadR#noBead-- THEN BEGIN
Attach[k.z,right,i.z];
Attach[k.z,left,m.z];
TryTo[Move[bead,m.z,2+Rtm[i]-Rtm[m],0]];
END;
END;

Transformation2:PROCEDURE[i:Desc]= BEGIN--rotate a contact
IF i.p.t# bf THEN RETURN ELSE BEGIN
k:Desc←DescT[i];
j:Desc←DescT[k];
IF k.p.t =bg AND j.p.t= rb AND Height[i]>Width[i] AND Bot[j]< Bot[k]
THEN BEGIN
rotateRight:BOOLEAN;
SELECT TRUE FROM
i.p.h< i.p.w => RETURN;
Lfm[j]>Lfm[k] => RETURN;
~NoBeadL[j] AND ~NoBeadR[j] => RETURN;
~NoBeadL[k] AND ~NoBeadR[k] => RETURN;
~NoBeadR[j] AND ~NoBeadR[k] => RETURN;
~NoBeadL[j] AND ~NoBeadL[k] => RETURN;
~NoBeadL[j] AND ~NoBeadU[k] => rotateRight← TRUE;
~NoBeadD[j] AND ~NoBeadL[k] => rotateRight← TRUE;
~NoBeadR[j] AND ~NoBeadU[k] => rotateRight← FALSE;
~NoBeadD[j] AND ~NoBeadR[k] => rotateRight← TRUE;
~NoBeadL[j] AND ~NoBeadR[k] => rotateRight← TRUE;
~NoBeadR[j] AND ~NoBeadL[k] => rotateRight← FALSE;
~NoBeadU[j] AND ~NoBeadD[k] => rotateRight←
Bot[DescD[j]]<Bot[DescU[k]];
ENDCASE => RETURN;
ClearShift[]; Put[i.z,-2,2,8,12];
IF rotateRight THEN BEGIN Put[j.z,-2,2,8,6]; Put[k.z, 4,-4,8,6]; END
ELSE BEGIN Put[j.z, 4,2,8,6]; Put[k.z,-2,-4,8,6]; END;
Process[];
END;
END; END;

Transformation3:PROCEDURE[i:Desc]= BEGIN
bi:Bead← i.p↑;
j,k:Desc←GetDesc[noBead];
SELECT i.p.t FROM rb,bg=>NULL; ENDCASE=>RETURN;
FOR jj:CARDINAL IN (i.z..topBead] DO
j←GetDesc[jj];
IF j.p.t=i.p.t AND i.p.circuit=j.p.circuit AND Overlap[i.z,j.z]
THEN {k←j; EXIT};
ENDLOOP;
IF NoBead[k] THEN RETURN ELSE BEGIN
bt,bk:Bead← k.p↑;
t:CARDINAL;
l:Desc←GetDesc[Find[bf,i.z]]; loopL:BOOLEAN←DescT[l]#i;
m:Desc←GetDesc[Find[bf,k.z]]; loopM:BOOLEAN←DescT[m]#k;
horizontal,vertical:Variant;
IF loopM AND loopL THEN RETURN; --budding contacts
IF loopM THEN BEGIN --a budding contact
tt:Desc←i; i←k; k←tt; --we don’t want k to be a 3-way contact
tt←m; m←l; l←tt;
bk←bi; bi←bt; END;
t← Find[IF i.p.t= bg THEN rb ELSE bg,i.z];
RemovePaths[m.z,l.z,tied]; RemovePaths[k.z,i.z,tied];
Attach[noBead,tied,k.z];
horizontal← IF bk.x< bi.x THEN down ELSE up;
vertical← IF bk.y< bi.y THEN left ELSE right;
IF (NumRelatives[k.z]+ NumRelatives[m.z])*4>= noBead- topBead
THEN BEGIN Restore[]; RETURN; END;
InsertJogs[k,horizontal,vertical];
InsertJogs[m,horizontal,vertical];
AttachAll[k.z,i.z]; AttachAll[m.z,l.z];
Remove[k.z]; Remove[m.z];
TryTo[Move[bead,i.z,0,0]];
END;
END;

TryTo:PROCEDURE[b:BOOLEAN]=INLINE {IF b THEN Commit[] ELSE Restore[] };

Transformation4:PROCEDURE[i:Desc]= BEGIN
j,k,l,m,n,rb,bg,bf:Desc;
IF (i.p.t=dd OR i.p.t=tt) AND
NumRelatives[i.z]=3 AND
NumRelatives[(k←DescU[j←DescU[i]]).z]=2 AND
NumRelatives[(m←DescL[l←DescL[k]]).z]=2 AND
NumRelatives[(rb←DescD[n←DescD[m]]).z]=2 AND
NumRelatives[(bg←DescT[bf←DescT[rb]]).z]=3 AND
DescR[DescR[bg]]=i THEN BEGIN
Put[rb.z,0,-12,0,0]; Put[bf.z,0,-6,0,0];
Attach[n.z,down,rb.z]; Attach[n.z,up,m.z];
Attach[j.z,down,i.z]; Attach[j.z,up,k.z];
TryTo[Move[bead,rb.z,0,0] AND Move[bead,bf.z,0,0]];
END;
END;

Transformation5:PROCEDURE[i:Desc]=BEGIN
IF i.p.t#ddV OR ~NoBeadR[i] THEN RETURN ELSE BEGIN
dw:Desc←DescD[i];
j:Desc←DescD[dw];
IF NoBead[dw] OR ~dw.p.wire OR NoBead[j] THEN Error;
IF ~Junction[j] OR ~NoBeadR[j] OR ~NoBeadD[j] THEN RETURN ELSE BEGIN
iw:Desc←DescL[i];
uw:Desc←DescU[i];
lw:Desc←DescL[j];
Save[i.z]; Save[j.z]; Save[dw.z]; Save[uw.z]; Save[lw.z];
HookLR[lw,i]; HookUD[j,uw]; HookLR[i,dw]; HookLR[dw,j];
i.p.t←dd; {t:INTEGER←i.p.w; i.p.w←i.p.h; i.p.h←t};
IF ~NoBead[iw] THEN BEGIN
m:Desc←i;--MakeBead[iw];
n:Desc←i;--MakeBead[iw];
IF TRUE THEN {Restore[]; RETURN};
Save[iw.z]; HookLR[iw,m]; HookUD[i,m];
m.p.t←jctnR; m.p.h←m.p.w←4;
n.p.t←wireR; n.p.w←4;
END;
TryTo[Move[bead,i.z,-12,-2]];
END; END; END;

Save:PROCEDURE[i:CARDINAL]=BEGIN Error; END;

Local1:PROCEDURE[i:Desc]=BEGIN
IF i.p.wire OR NoBeadD[i] THEN RETURN ELSE BEGIN
k:Desc←DescD[i];
j:Desc←DescD[k];
IF NoBead[k] OR ~k.p.wire OR NoBead[j] THEN Error;
IF Bot[j]-Bot[i] IN [0..i.p.h-j.p.h) AND Junction[j] THEN RETURN ELSE BEGIN
IF ~NoBeadT[j] THEN Error;
IF ~NoBeadR[j] THEN
IF ~NoBeadR[i] THEN RETURN ELSE Attach[j.p.beadR,right,i.z];
IF ~NoBeadL[j] THEN
IF ~NoBeadL[i] THEN RETURN ELSE Attach[j.p.beadL,left,i.z];
i.p.beadD←noBead;
IF ~NoBeadD[i] THEN Attach[j.p.beadD,down,i.z];
ReleaseBead[j];
ReleaseBead[k];
END; END; END;

Local2:PROCEDURE[i:Desc]= BEGIN
--
--none j(jctn) - k(wire) - i(jctn) none
-- l m
-- n p
NoName:PROCEDURE[s,t:Desc]RETURNS[a:INTEGER]=INLINE BEGIN
a←Delta[s,t].y; IF a<0 AND ~NoBeadT[t] THEN a←a+2; END;
IF Junction[i] AND NoBeadR[i] THEN BEGIN
k:Desc←DescL[i];
j:Desc←DescL[k];
IF k.z#noBead AND NoBeadL[j] AND Junction[j] THEN BEGIN
m:Desc←DescD[i];
l:Desc←DescD[j];
IF m.z#noBead AND l.z#noBead THEN BEGIN
n:Desc←DescD[l];
p:Desc←DescD[m];
hm:INTEGER←MIN[Bot[j]-(Top[n]+NoName[j,n]),
Bot[i]-(Top[p]+NoName[i,p])];
IF hm<=0 THEN RETURN;
FallTwo[j,hm];
IF ~NoBeadU[i] THEN FixWire[DescU[i]];
FixWire[m];
FixWire[l];
END; END; END; END;

Local3:PROCEDURE[i:Desc]= BEGIN
-- none
--none j - k(wire) - i
-- l
-- m
IF ~NoBeadL[i] THEN BEGIN
k:Desc←DescL[i];
IF k.p.wire AND Bot[k]>Bot[i] THEN BEGIN
j:Desc←DescL[k];
IF NoBeadU[j] AND NoBeadL[j] AND ~NoBeadD[j] THEN BEGIN
l:Desc←DescD[k];
m:Desc←DescD[l];
hm:INTEGER← MIN[Bot[k]-Bot[i],Bot[j]- (Top[m]+ Delta[j,m].y)];
IF hm<=0 THEN RETURN;
FallTwo[j,hm];
FixWire[k];
FixWire[l];
END; END; END; END;

Local3a:PROCEDURE[i:Desc]= BEGIN
IF ~NoBeadR[i] THEN BEGIN
k:Desc←DescR[i];
IF k.p.wire AND Bot[k]>Bot[i] THEN BEGIN
j:Desc←DescR[k];
IF NoBeadU[j] AND NoBeadR[j] AND ~NoBeadD[j] THEN BEGIN
l:Desc←DescD[k];
m:Desc←DescD[l];
hm:INTEGER← MIN[Bot[k]-Bot[i],Bot[j]- (Top[m]+ Delta[j,m].y)];
IF hm<=0 THEN RETURN;
FallTwo[j,hm];
FixWire[k];
FixWire[l];
END; END; END; END;

--************************************************************************
END..