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

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
i,j:CARDINAL←0;
EnumerateBeads[InitBeadWork];
Initialize[];
-- EnumerateBeads[PartWiggle];
EnumerateBeads[Transformation1];
EnumerateBeads[Transformation2];
EnumerateBeads[Transformation3];
EnumerateBeads[Transformation4];
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[i:CARDINAL,bpi:BeadPtr]=BEGIN
j:CARDINAL;
FOR j IN [0..topBead] DO IF Get[j].t#none THEN Wiggle[i,j]; ENDLOOP;
END;

Wiggle:PROCEDURE[i,j:CARDINAL]= BEGIN-- j is below i
bi:Bead←Get[i]↑;
bj:Bead←Get[j]↑;
minX,minY:INTEGER;
[minX,minY]←Deltas[i,j];
IF bi.wire OR bj.wire THEN RETURN;-- why?
IF bj.y> bi.y THEN
BEGIN t:CARDINAL←i; i←j; j←t; bi← bj; bj←Get[j]↑; END;
IF minY#bi.y-bj.y- bj.h
OR bj.x>= bi.x+ bi.w+ minX
OR bj.x+ bj.w<= bi.x- minX
OR Related[i,j]
OR Tied[i,j]
OR Get[bj.beadU].beadU= i THEN RETURN;
IF Move[bead,j,bi.x+ bi.w+ minX- bj.x,2]
THEN BEGIN Commit[]; RETURN; END ELSE Abort[];
IF Move[bead,j,bi.x- (bj.x+ bj.w+ minX),2]
THEN BEGIN Commit[]; RETURN; END ELSE Abort[];
Restore[];
END;


Transformation1:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
k,m,n:CARDINAL;
IF bpi.t= ttV AND
bpi.beadR= noBead AND
Get[m← Get[k← bpi.beadL].beadL].t= rb AND
Get[n← Get[m].beadT].t= bf --AND
--Get[n].beadR#noBead-- THEN
BEGIN
OPEN IODefs;
WriteString["flip transistor#1- "];
Attach[k,right,i];
Attach[k,left,m];
IF ~Move[bead,m,2- Get[k].w,0] THEN BEGIN WriteLine["couldn’t move"]; Restore[]; END
ELSE BEGIN WriteLine["flipped"];
Commit[]; END;
END;
END;

Transformation2:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN--rotate a contact
j,k:CARDINAL; bpj,bpk:BeadPtr;
IF bpi.t# bf THEN RETURN;
k←bpi.beadT; bpk←Get[k]; j←bpk.beadT; bpj←Get[j];
IF bpk.t =bg AND bpj.t= rb AND bpi.h>bpi.w AND bpj.y< bpk.y THEN BEGIN
RotateRight:BOOLEAN;
IF bpi.h< bpi.w THEN RETURN;
IF bpj.x> bpk.x THEN RETURN;
SELECT TRUE FROM
bpj.beadL#noBead AND bpj.beadR#noBead => RETURN;
bpk.beadL#noBead AND bpk.beadR#noBead => RETURN;
bpj.beadR#noBead AND bpk.beadR#noBead => RETURN;
bpj.beadL#noBead AND bpk.beadL#noBead => RETURN;
bpj.beadL#noBead AND bpk.beadU#noBead => RotateRight← TRUE;
bpj.beadD#noBead AND bpk.beadL#noBead => RotateRight← FALSE;
bpj.beadR#noBead AND bpk.beadU#noBead => RotateRight← FALSE;
bpj.beadD#noBead AND bpk.beadR#noBead => RotateRight← TRUE;
bpj.beadL#noBead AND bpk.beadR#noBead => RotateRight← TRUE;
bpj.beadR#noBead AND bpk.beadL#noBead => RotateRight← FALSE;
bpj.beadU#noBead AND bpk.beadD#noBead =>
IF Get[bpj.beadD].y< Get[bpk.beadU].y THEN RotateRight← TRUE
ELSE RotateRight← FALSE;
ENDCASE => RETURN;
IODefs.WriteString["rotate contact- "];
ClearShift[]; Put[i,-2,2,8,12];
IF RotateRight THEN BEGIN Put[j,-2,2,8,6]; Put[k, 4,-4,8,6]; END
ELSE BEGIN Put[j, 4,2,8,6]; Put[k,-2,-4,8,6]; END;
Process[];
END;
END;

Transformation3:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
bi:Bead← bpi↑; bpj:BeadPtr;
j,k:CARDINAL← noBead;
IF bi.t=rb THEN FOR j IN (i..topBead] DO
bpj←Get[j];
IF bpj.t=rb AND bi.circuit=bpj.circuit
AND Overlap[i,j] THEN k←j; ENDLOOP;
IF bi.t=bg THEN FOR j IN (i..topBead] DO
bpj←Get[j];
IF bpj.t=bg AND bi.circuit=bpj.circuit
AND Overlap[i,j] THEN k←j; ENDLOOP;
IF k=noBead THEN RETURN ELSE BEGIN
bt,bk:Bead← Get[k]↑;
t:CARDINAL;
l:CARDINAL←Find[bf,i]; loopL:BOOLEAN←Get[l].beadT#i;
m:CARDINAL←Find[bf,k]; loopM:BOOLEAN←Get[m].beadT#k;
horizontal,vertical:Variant;
IF loopM AND loopL THEN RETURN; --budding contacts
IODefs.WriteString["double contact- "];
IF loopM THEN BEGIN --a budding contact
t←i; i←k; k←t; --we don’t want k to be a 3-way contact
t←m; m←l; l←t;
bk←bi; bi←bt; END;
t← IF bi.t= bg THEN Find[rb,i] ELSE Find[bg,i];
RemovePaths[m,l,tied]; RemovePaths[k,i,tied];
Attach[noBead,tied,k];
horizontal← IF bk.x< bi.x THEN down ELSE up;
vertical← IF bk.y< bi.y THEN left ELSE right;
IF (NumRelatives[k]+ NumRelatives[m])*4>= noBead- topBead
THEN BEGIN Restore[]; IODefs.WriteLine[">noBead"]; RETURN; END;
InsertJogs[k,horizontal,vertical];
InsertJogs[m,horizontal,vertical];
AttachAll[k,i]; AttachAll[m,l];
Remove[k]; Remove[m];
IF Move[bead,i,0,0] THEN Commit[] ELSE Restore[];
j←j; --a hack to get around a bug in the debugger;
END;
END;

Transformation4:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
bi:Bead← bpi↑;
j,k,l,m,n,rb,bg,bf:CARDINAL;
IF (bi.t=dd OR bi.t=tt) AND
NumRelatives[i]=3 AND
NumRelatives[k←Get[j←bi.beadU].beadU]=2 AND
NumRelatives[m←Get[l←Get[k].beadL].beadL]=2 AND
NumRelatives[rb←Get[n←Get[m].beadD].beadD]=2 AND
NumRelatives[bg←Get[bf←Get[rb].beadT].beadT]=3 AND
Get[Get[bg].beadR].beadR=i THEN BEGIN
IODefs.WriteString["flip transistor#2- "];
Put[rb,0,-12,0,0]; Put[bf,0,-6,0,0];
Attach[n,down,rb]; Attach[n,up,m];
Attach[j,down,i]; Attach[j,up,k];
IF ~Move[bead,rb,0,0] THEN GOTO Abort;
IF ~Move[bead,bf,0,0] THEN GOTO Abort;
Commit[];
END;
EXITS
Abort => Restore[];
END;


Local1:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
k:CARDINAL←bpi.beadD;
bpk:BeadPtr←Get[k];
j:CARDINAL←bpk.beadD;
bpj:BeadPtr←Get[j];
delta:INTEGER←bpj.y-bpi.y;
IF k#noBead AND bpk.wire AND j#noBead
AND delta IN [0..bpi.h-bpj.h)
AND (SELECT bpj.t FROM jctnG,jctnR,jctnB=>TRUE, ENDCASE=>FALSE)
THEN BEGIN
bj:Bead←bpj↑;
IF bj.beadT#noBead THEN Error;
IF bj.beadR#noBead THEN BEGIN
IF bpi.beadR#noBead THEN RETURN;
bpi.beadD←noBead;
Attach[bj.beadR,right,i];
END;
IF bj.beadL#noBead THEN BEGIN
IF bpi.beadL#noBead THEN RETURN;
bpi.beadD←noBead;
Attach[bj.beadL,left,i];
END;
IF bj.beadD#noBead THEN BEGIN
Attach[bj.beadD,down,i];
END;
IODefs.WriteLine["deleted junction"];
DeleteBead[j];
DeleteBead[k];
END;
END;

Local2:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
--
--none j(jctn) - k(wire) - i(jctn) none
-- l m
-- n p
hm,delta1,delta2:INTEGER;
k:CARDINAL←bpi.beadL;
bpk:BeadPtr←Get[k];
j:CARDINAL←bpk.beadL;
bpj:BeadPtr←Get[j];
l,m,n,p:CARDINAL;
bpn,bpp:BeadPtr;
IF k=noBead
OR ~bpk.wire
OR (m←bpi.beadD)=noBead
OR j=noBead
OR bpi.beadR#noBead
OR (SELECT bpi.t FROM jctnG,jctnR,jctnB=>FALSE, ENDCASE=>TRUE)
OR (l←bpj.beadD)=noBead
OR bpj.beadL#noBead
OR (SELECT bpj.t FROM jctnG,jctnR,jctnB=>FALSE, ENDCASE=>TRUE)
THEN RETURN;
n← Get[l].beadD; bpn←Get[n]; p← Get[m].beadD; bpp←Get[p];
delta1←MinSepInY[j,n];
delta2←MinSepInY[i,p];
IF delta1<0 AND bpn.beadT#noBead THEN delta1←delta1+2;
IF delta2<0 AND bpp.beadT#noBead THEN delta2←delta2+2;
hm← MIN[bpj.y- (bpn.y+ bpn.h+ delta1),
bpi.y- (bpp.y+ bpp.h+ delta2)];
IF hm<=0 THEN RETURN;
IF BeadFall[j,hm] THEN UNTIL ~WireFall[k] DO ENDLOOP;
IF bpi.beadU#noBead THEN FixWire[bpi.beadU,Get[bpi.beadU]];
FixWire[m,Get[m]];
FixWire[l,Get[l]];
END;

Local3:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
-- none
--none j - k(wire) - i
-- l
-- m
hm:INTEGER;
k,j,l,m:CARDINAL;
bpk,bpj,bpm:BeadPtr;
k←bpi.beadL; IF k=noBead THEN RETURN; bpk←Get[k];
IF ~bpk.wire OR bpk.y<= bpi.y THEN RETURN;
j←bpk.beadL; bpj←Get[j];
IF bpj.beadU#noBead OR bpj.beadL#noBead THEN RETURN;
l←bpj.beadD; IF l=noBead THEN RETURN;
m← Get[l].beadD; bpm←Get[m];
hm← MIN[bpk.y- bpi.y, bpj.y- (bpm.y+ bpm.h+ MinSepInY[j,m])];
IF hm<=0 THEN RETURN;
IF BeadFall[j,hm] THEN UNTIL ~WireFall[k] DO ENDLOOP;
FixWire[k,bpk];
FixWire[l,Get[l]];
END;

Local3a:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
hm:INTEGER;
k,j,l,m:CARDINAL;
bpk,bpj,bpm:BeadPtr;
k←bpi.beadR; IF k=noBead THEN RETURN; bpk←Get[k];
IF ~bpk.wire OR bpk.y<= bpi.y THEN RETURN;
j←bpk.beadR; bpj←Get[j];
IF bpj.beadU#noBead OR bpj.beadR#noBead THEN RETURN;
l←bpj.beadD; IF l=noBead THEN RETURN;
m← Get[l].beadD; bpm←Get[m];
hm← MIN[bpk.y-bpi.y, bpj.y- (bpm.y+ bpm.h+ MinSepInY[j,m])];
IF hm<=0 THEN RETURN;
UNTIL ~WireFall[k] DO ENDLOOP;--but this is silly.
END;

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