--beadsmove2.mesa August 27, 1979 11:22 AM
--
move beads
-- use deltas to find deltaX and deltaY
DIRECTORY IODefs:FROM"IODefs",
InlineDefs:FROM"InlineDefs",
BeadsDefs:FROM"BeadsDefs";
BeadsMove:PROGRAM IMPORTS InlineDefs,IODefs,BeadsDefs EXPORTS BeadsDefs =
BEGIN OPEN BeadsDefs;

Error:SIGNAL=CODE;
oldtopBead:CARDINAL;

maxCache:INTEGER=100;
index:CARDINAL← 0;
cache:ARRAY [0..maxCache] OF Bead;
--
saves state until after transformation
address:ARRAY [0..maxCache] OF CARDINAL;
abort:ARRAY [0..maxCache] OF BOOLEAN; --
this bead is abortable
shift:ARRAY [0..maxCache] OF BOOLEAN; --
this bead is shiftable

noMoves:INTEGER←0;
maxMoves:INTEGER=20;
ShiftLeft,ShiftRight,ShiftUp,ShiftDown:BOOLEAN;
shortLegalOK:BOOLEAN←FALSE;

maxPathLength:INTEGER= 20;
step:INTEGER[0..maxPathLength];
path:ARRAY [0..maxPathLength] OF Step; --
contains the current path
Step:TYPE= RECORD[bead:CARDINAL,v:Variant];

deleteindex:CARDINAL[0..20]← 0;
delete:ARRAY [0..20] OF CARDINAL; --
cache of beads to be deleted

--************************************************************************
Process:PUBLIC PROCEDURE= BEGIN
i:CARDINAL;
FOR i IN [0..index) DO IF shift[i] AND ~RoomFor[address[i]] THEN BEGIN
Abort[];
IODefs.WriteString["no room,"];
EXIT; END;
ENDLOOP;
FOR i IN [0..index) DO IF shift[i] AND ~Move[bead,address[i],0,0]
THEN BEGIN Restore[]; RETURN; END;
ENDLOOP;
Commit[];
END;

--************************************************************************
--path detection and removal
Find:PUBLIC PROCEDURE[b:BeadType,i:CARDINAL] RETURNS[CARDINAL]=BEGIN
bpi:BeadPtr←Get[i]; tie:CARDINAL←bpi.beadT; bpt:BeadPtr←Get[tie];
RETURN[IF bpt.t=b THEN tie ELSE bpt.beadT];
END;

FindPath:PUBLIC PROCEDURE[i,j:CARDINAL,v:Variant] RETURNS[BOOLEAN]= BEGIN
bpi:BeadPtr←Get[i];
step← 0;
IF v#left AND RecursiveFindPath[i,bpi.beadR,j,right] THEN RETURN[TRUE];
IF v#right AND RecursiveFindPath[i,bpi.beadL,j,left ] THEN RETURN[TRUE];
IF v#up AND RecursiveFindPath[i,bpi.beadD,j,down ] THEN RETURN[TRUE];
IF v#down AND RecursiveFindPath[i,bpi.beadU,j,up ] THEN RETURN[TRUE];
IF v#tied AND RecursiveFindPath[i,bpi.beadT,j,tied ] THEN RETURN[TRUE];
RETURN[FALSE];
END;

RemovePaths:PUBLIC PROCEDURE[i,j:CARDINAL,v:Variant]=BEGIN
k:INTEGER;
IF i=noBead OR j=noBead THEN RETURN;
WHILE FindPath[i,j,v] DO
Remove[path[0].bead]; k←1;
WHILE NumRelatives[path[k].bead]< 2 AND k< step
DO Remove[path[k].bead]; k← k+ 1; ENDLOOP;
ENDLOOP;
END;

RecursiveFindPath:PROCEDURE[s,i,j:CARDINAL,v:Variant] RETURNS[BOOLEAN]=BEGIN
bpi:BeadPtr←Get[i];
IF i=noBead THEN RETURN[FALSE];
IF i=j THEN RETURN[TRUE];
IF s=i THEN RETURN[FALSE];
IF bpi.t=dd OR bpi.t=ddV THEN RETURN[FALSE];
IF bpi.t=tt OR bpi.t=ttV THEN RETURN[FALSE];
IF step> maxPathLength THEN RETURN[FALSE];
path[step].bead← i;
path[step].v← v;
step← step+ 1;
IF v#left AND RecursiveFindPath[s,bpi.beadR,j,right] THEN RETURN[TRUE];
IF v#right AND RecursiveFindPath[s,bpi.beadL,j,left ] THEN RETURN[TRUE];
IF v#up AND RecursiveFindPath[s,bpi.beadD,j,down ] THEN RETURN[TRUE];
IF v#down AND RecursiveFindPath[s,bpi.beadU,j,up ] THEN RETURN[TRUE];
IF v#tied AND RecursiveFindPath[s,bpi.beadT,j,tied ] THEN RETURN[TRUE];
step← step- 1;
RETURN[FALSE];
END;

--************************************************************************
--queries about the beads
NumRelatives:PUBLIC PROCEDURE[i:CARDINAL] RETURNS[num:CARDINAL]= BEGIN
bpi:BeadPtr←Get[i];
num←(IF bpi.beadR=noBead THEN 0 ELSE 1)
+(IF bpi.beadL=noBead THEN 0 ELSE 1)
+(IF bpi.beadU=noBead THEN 0 ELSE 1)
+(IF bpi.beadD=noBead THEN 0 ELSE 1)
+(IF bpi.beadT=noBead THEN 0 ELSE 1);
END;

AndOfRelatives:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]= BEGIN
bpi:BeadPtr←Get[i];
bpj:BeadPtr←Get[j];
RETURN[bpi.beadL#noBead AND bpj.beadL#noBead
OR bpi.beadR#noBead AND bpj.beadR#noBead
OR bpi.beadU#noBead AND bpj.beadU#noBead
OR bpi.beadD#noBead AND bpj.beadD#noBead];
END;


Tied:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]= BEGIN
bpi:BeadPtr←Get[i];
bpj:BeadPtr←Get[j];
ti:BeadType← bpi.t; --
the 3way contacts are treated special
tj:BeadType← bpj.t;
IF ti=wireR AND tj=bg THEN RETURN[Related[i,bpj.beadT]];
IF ti=wireG AND tj=rb THEN RETURN[Related[i,Get[bpj.beadT].beadT]];
IF tj=wireR AND ti=bg THEN RETURN[Related[j,bpi.beadT]];
IF tj=wireG AND ti=rb THEN RETURN[Related[j,Get[bpi.beadT].beadT]];
RETURN[FALSE];
END;

Related:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]= BEGIN
bpi:BeadPtr←Get[i]; --
is i a relative of j?
RETURN[SELECT j FROM
i,bpi.beadT,bpi.beadU,bpi.beadD,bpi.beadL,bpi.beadR,Get[bpi.beadT].beadT
=>TRUE,
ENDCASE =>FALSE];
END;

Overlap:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]= BEGIN
bpi:BeadPtr←Get[i]; bpj:BeadPtr←Get[j];
RETURN[(bpi.x IN [bpj.x..bpj.x+bpj.w) OR bpj.x IN [bpi.x..bpi.x+bpi.w))
AND (bpi.y IN [bpj.y..bpj.y+bpj.h) OR bpj.y IN [bpi.y..bpi.y+bpi.h))]
END;

Slack:PROCEDURE[i:CARDINAL,variant:Variant] RETURNS[INTEGER]=
BEGIN
bpi:BeadPtr←Get[i];
bpv:BeadPtr;
t1,t2:INTEGER;
SELECT variant FROM
left => BEGIN
bpv←Get[bpi.beadL];
t1← bpv.y- bpi.y;
t2← bpv.h+ t1- bpi.h;
END;
right => BEGIN
bpv←Get[bpi.beadR];
t1← bpv.y- bpi.y;
t2← bpv.h+ t1- bpi.h;
END;
up => BEGIN
bpv←Get[bpi.beadU];
t1← bpv.x- bpi.x;
t2← bpv.w+ t1- bpi.w;
END;
down => BEGIN
bpv←Get[bpi.beadD];
t1← bpv.x- bpi.x;
t2← bpv.w+ t1- bpi.w;
END;
ENDCASE => NULL;
IF t1>0 AND t2>0 THEN RETURN[MIN[t1,t2]];
IF t1<0 AND t2<0 THEN RETURN[MAX[t1,t2]];
RETURN[0];
END;

Push:PROCEDURE[i,j:CARDINAL] RETURNS[dx,dy:INTEGER]= BEGIN
--
i pushes on j. How far must j move?
bpi:BeadPtr←Get[i];
bpj:BeadPtr←Get[j];
w,h,x,y:INTEGER;
w← IF bpi.x< bpj.x THEN bpj.x- (bpi.x+ bpi.w) ELSE bpi.x- (bpj.x+ bpj.w);
h← IF bpi.y< bpj.y THEN bpj.y- (bpi.y+ bpi.h) ELSE bpi.y- (bpj.y+ bpj.h);
IF (x← w- MinSepInX[i,j])< 0 AND (y← h- MinSepInY[i,j])< 0
THEN BEGIN
dx← IF bpi.x< bpj.x THEN -x ELSE x;
dy← IF bpi.y< bpj.y THEN -y ELSE y;
SELECT TRUE FROM
~bpj.wire => IF x> y THEN dy← 0 ELSE dx← 0;
bpj.beadL#noBead => dx←0;
bpj.beadU#noBead => dy←0;
ENDCASE;
RETURN[dx,dy];
END;
RETURN[0,0];
END;

MinSepInY:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[deltaY:INTEGER]=
BEGIN [,deltaY]←Deltas[i,j]; END;

MinSepInX:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[deltaX:INTEGER]=
BEGIN [deltaX,]←Deltas[i,j]; END;

HorizontalWire:PROCEDURE[bpi:BeadPtr] RETURNS[BOOLEAN]=INLINE BEGIN
RETURN[bpi.wire AND bpi.beadU= noBead];
END;

VerticalWire:PROCEDURE[bpi:BeadPtr] RETURNS[BOOLEAN]=INLINE BEGIN
RETURN[bpi.wire AND bpi.beadR= noBead];
END;

--************************************************************************
--
procedures that modify the beads structure
Initialize:PUBLIC PROCEDURE= BEGIN
-- cache← LOOPHOLE[work];
--address← LOOPHOLE[work+ 16*maxCache];
-- abort← LOOPHOLE[work+ 17*maxCache];
-- shift← LOOPHOLE[work+ 18*maxCache];
oldtopBead← topBead;
Clear[Get[noBead]];
END;

Clear:PROCEDURE[bpi:BeadPtr]= BEGIN
bpi.beadL←bpi.beadR←bpi.beadU←bpi.beadD←bpi.beadT← noBead;
END;

Attach:PUBLIC PROCEDURE[i:CARDINAL,variant:Variant,j:CARDINAL]=
BEGIN --
Attach i to the variant of j
bpi:BeadPtr←Get[i];

bpj:BeadPtr←Get[j];
m,n:CARDINAL;
Save[i,FALSE,FALSE]; Save[j,FALSE,FALSE];
SELECT variant FROM
left => BEGIN
Save[m←bpi.beadR,FALSE,FALSE];
Save[n←bpj.beadL,FALSE,FALSE];
Get[m].beadL← noBead; Get[n].beadR← noBead;
IF i#noBead THEN bpi.beadR← j; bpj.beadL← i;
END;
right => BEGIN
Save[m←bpj.beadR,FALSE,FALSE];
Save[n←bpi.beadL,FALSE,FALSE];
Get[m].beadL← noBead; Get[n].beadR← noBead;
bpj.beadR← i; IF i#noBead THEN bpi.beadL← j;
END;
up => BEGIN
Save[m←bpj.beadU,FALSE,FALSE];
Save[n←bpi.beadD,FALSE,FALSE];
Get[m].beadD← noBead; Get[n].beadU← noBead;
bpj.beadU← i; IF i#noBead THEN bpi.beadD← j;
END;
down => BEGIN
Save[m←bpi.beadU,FALSE,FALSE];
Save[n←bpj.beadD,FALSE,FALSE];
Get[m].beadD← noBead; Get[n].beadU← noBead;
IF i#noBead THEN bpi.beadU← j; bpj.beadD← i;
END;
tied => BEGIN
bpi.x← bpj.x+ (bpj.w- bpi.w)/2;
bpi.y← bpj.y+ (bpj.h- bpi.h)/2;
Save[m←bpi.beadT,FALSE,FALSE];
Save[n←bpj.beadT,FALSE,FALSE];
Get[m].beadT← noBead; Get[n].beadT← noBead;
IF i#noBead THEN bpi.beadT← j; bpj.beadT← i;
END;
ENDCASE;
END;

AttachAll:PUBLIC PROCEDURE[i,j:CARDINAL]= BEGIN
bi:BeadPtr←Get[i];
IF bi.beadL#noBead THEN Attach[bi.beadL,left ,j];
IF bi.beadR#noBead THEN Attach[bi.beadR,right,j];
IF bi.beadU#noBead THEN Attach[bi.beadU,up ,j];
IF bi.beadD#noBead THEN Attach[bi.beadD,down ,j];
IF bi.beadT#noBead THEN Attach[bi.beadT,tied ,j]; END;

Move:PUBLIC PROCEDURE[variant:Variant,i:CARDINAL,dx,dy:INTEGER] RETURNS[r:BOOLEAN] =
BEGIN
bpi:BeadPtr← Get[i];
x,y,w,h,u,d,r,l,needed,d5,d7:INTEGER← 0;
k:CARDINAL;
bpd:BeadPtr←Get[bpi.beadD];
bpu:BeadPtr←Get[bpi.beadU];
bpl:BeadPtr←Get[bpi.beadL];
bpr:BeadPtr←Get[bpi.beadR];
w← bpi.w; h← bpi.h;
IF i=noBead THEN RETURN[TRUE];
IF variant#tied AND variant#bead THEN BEGIN
needed← Slack[i, variant];
d5←Des5[desP[bpu.t].short][desP[bpd.t].short];
d7←Des7[desP[bpl.t].short][desP[bpr.t].short];
u← bpu.y;
d← bpd.y+ bpd.h;
r← bpr.x;
l← bpl.x+ bpl.w;
END;
SELECT variant FROM
left => BEGIN
IF bpi.wire THEN w← MAX[d7,r-l];
dx← l- bpi.x; dy← needed;
END;
down => BEGIN
IF bpi.wire THEN h← MAX[d5,u-d];
dy← d- bpi.y; dx← needed;
END;
right => BEGIN
IF bpi.wire THEN w← MAX[d7,r-l];
dy← needed; dx← r- (bpi.x+ w);
END;
up => BEGIN
IF bpi.wire THEN h← MAX[d5,u-d];
dx← needed; dy← u- (bpi.y+ h);
END;
ENDCASE;
IF dx=0 AND dy=0 AND bpi.w=w AND bpi.h=h AND variant#bead THEN RETURN[TRUE];
x←bpi.x+ dx; y←bpi.y+ dy;
IF x<0 OR y<0 OR x+w>maxX OR y+h>maxY THEN BEGIN
-- IODefs.WriteString["out of bounds,"];-- GOTO False; END;--bounds
noMoves← noMoves+ 1;
IF noMoves> maxMoves THEN BEGIN --IODefs.WriteString[">maxMoves,"];--
GOTO False; END; --limit
Save[i,TRUE,FALSE];
bpi.x← x; bpi.y← y; bpi.w← w; bpi.h← h;
IF variant#up AND ~Move[down ,bpi.beadU, 0, 0] THEN GOTO
False;
IF variant#right AND ~Move[left ,bpi.beadR, 0, 0] THEN GOTO
False;
IF variant#down AND ~Move[up ,bpi.beadD, 0, 0] THEN GOTO
False;
IF variant#left AND ~Move[right,bpi.beadL, 0, 0] THEN GOTO
False;
IF variant#tied AND ~Move[tied ,bpi.beadT,dx,dy] THEN GOTO
False;
IF variant#tied AND (k←Get[bpi.beadT].beadT)# i
AND ~Move[tied ,k ,dx,dy] THEN GOTO False;
IF ~Legal[i] THEN GOTO
False;
RETURN[TRUE];
EXITS
False => RETURN[FALSE];
END;

Legal:PROCEDURE[i:CARDINAL] RETURNS[r:BOOLEAN]=
BEGIN RETURN[IF shortLegalOK THEN LegalShort[i] ELSE LegalLong[i]]; END;


LegalLong
:PROCEDURE[i:CARDINAL] RETURNS[BOOLEAN]= BEGIN
--
make the rest of the world legal with respect to i
j:CARDINAL;
dx,dy:INTEGER;
FOR j IN [0..topBead] DO BEGIN
IF Get[j].t=none THEN LOOP;
[dx,dy]← Push[i,j];
SELECT TRUE FROM
dx=0 AND dy=0 OR Related[i,j] OR Tied[i,j] =>NULL;
~Move[bead,j,dx,dy] =>RETURN[FALSE];
ENDCASE;
END;
ENDLOOP;
RETURN[TRUE];
END;


LegalShort
:PROCEDURE[i:CARDINAL] RETURNS[r:BOOLEAN]= BEGIN
Error; RETURN[TRUE]; END;


Put
:PUBLIC PROCEDURE[i:CARDINAL,dx,dy,h,w:INTEGER]= BEGIN
bpi:BeadPtr←Get[i];
Save[i,FALSE,TRUE];
bpi.x← bpi.x+ dx;
bpi.y← bpi.y+ dy;
IF h#0 THEN bpi.h← h;
IF w#0 THEN bpi.w← w;
END;

Create:PROCEDURE[t:BeadType,x,y,h,w,circuit:INTEGER] RETURNS[CARDINAL]= BEGIN
bpt:BeadPtr← Get[topBead+1];
IF (topBead← topBead+ 1)>= noBead THEN Error;
Clear[bpt];
bpt.x← x; bpt.y← y; bpt.circuit← circuit;
bpt.w← IF w=0 THEN desP[t].w ELSE w;
bpt.h← IF h=0 THEN desP[t].h ELSE h;
bpt.t← t; bpt.external← 0; --
is this correct?
bpt.wire← t=wireG OR t=wireB OR t=wireR;
bpt.noodle← topNoodle;
bpt.nextBelow← noBelow;
InitBeadWork[topBead,bpt];
RETURN[topBead];
END;

InsertJogs:PUBLIC PROCEDURE[i:CARDINAL,horizontal,vertical:Variant]= BEGIN
bpi:BeadPtr← Get[i];
IF bpi.beadR#noBead THEN InsertJog[i,bpi.beadR,left,horizontal];
IF bpi.beadL#noBead THEN InsertJog[i,bpi.beadL,right,horizontal];
IF bpi.beadU#noBead THEN InsertJog[i,bpi.beadU,down,vertical];
IF bpi.beadD#noBead THEN InsertJog[i,bpi.beadD,up,vertical];
END;


InsertJog:PROCEDURE[contact,wire:CARDINAL,whichEnd,bend:Variant]= BEGIN
wt:BeadType← Get[wire].t;
bpc:BeadPtr← Get[contact];
vert:BOOLEAN← whichEnd=up OR whichEnd=down;
s:INTEGER← IF wt= wireB THEN 6 ELSE 4;
jt:BeadType← SELECT wt FROM wireR => jctnR,wireB => jctnB, ENDCASE => jctnG;
j1:CARDINAL← Create[jt,bpc.x,bpc.y,s,s,bpc.circuit];
j2:CARDINAL← Create[jt,bpc.x,bpc.y,s,s,bpc.circuit];
w1:CARDINAL← IF vert THEN Create[wt,bpc.x,bpc.y+s,-s,s,bpc.circuit]
ELSE Create[wt,bpc.x+s,bpc.y,s,-s,bpc.circuit];
w2:CARDINAL← IF vert THEN Create[wt,bpc.x+s,bpc.y,s,-s,bpc.circuit]
ELSE Create[wt,bpc.x,bpc.y+s,-s,s,bpc.circuit];
Attach[contact,whichEnd,w1]; Attach[j2,whichEnd,wire];
Attach[w1,whichEnd,j1]; Attach[j2,bend,w2]; Attach[w2,bend,j1];
END;




--************************************************************************
--
find room for a group of beads
RoomFor:PUBLIC PROCEDURE[i:CARDINAL] RETURNS[r:BOOLEAN]= BEGIN
--
make i legal with respect to the rest of the world
j:CARDINAL;
dx,dy:INTEGER;
FOR j IN [0..topBead] DO BEGIN
IF Get[j].t=none THEN LOOP;
[dx,dy]← Push[i,j];
SELECT TRUE FROM
dx=0 AND dy=0 =>NULL;
Related[i,j] =>NULL;
Tied[i,j] =>NULL;
~Shift[-dx,-dy] =>RETURN[FALSE];
ENDCASE;
END;
ENDLOOP;
RETURN[TRUE];
END;

ClearShift:PUBLIC PROCEDURE= BEGIN
ShiftLeft← ShiftRight← ShiftUp← ShiftDown← FALSE;
END;

Shift:PUBLIC PROCEDURE[dx,dy:INTEGER] RETURNS[BOOLEAN]= BEGIN
i:CARDINAL;
IF dx<0 AND ShiftLeft THEN RETURN[FALSE] ELSE ShiftLeft← TRUE;
IF dx>0 AND ShiftRight THEN RETURN[FALSE] ELSE ShiftRight← TRUE;
IF dy<0 AND ShiftDown THEN RETURN[FALSE] ELSE ShiftDown← TRUE;
IF dy>0 AND ShiftUp THEN RETURN[FALSE] ELSE ShiftUp← TRUE;
FOR i IN [0..index) DO
IF shift[i] THEN BEGIN
bpa:BeadPtr←Get[address[i]];
bpa.x← bpa.x+ dx;
bpa.y← bpa.y+ dy;
END;
ENDLOOP;
RETURN[TRUE];
END;

--************************************************************************
--
procedures that save state until a transformation is complete
Save:PROCEDURE[a:CARDINAL,abortable,shiftable:BOOLEAN]= BEGIN
IF a= noBead THEN RETURN;
IF a> oldtopBead THEN RETURN;
IF index> maxCache THEN Error; --
you should increase maxCache
cache[index]← Get[a]↑;
address[index]← a;
abort[index]← abortable;
shift[index]← shiftable;
index← index+ 1;
END;

Remove:PUBLIC PROCEDURE[i:CARDINAL]=BEGIN --get the bead out of the way
bpi:BeadPtr←Get[i];

t:CARDINAL← bpi.beadT;
bpt:BeadPtr←Get[t];
Save[i,FALSE,FALSE];
delete[deleteindex]← i;
deleteindex← deleteindex+ 1;
IF bpi.beadR#noBead THEN BEGIN Save[bpi.beadR,FALSE,FALSE];
Get[bpi.beadR].beadL← noBead; END;
IF bpi.beadL#noBead THEN BEGIN Save[bpi.beadL,FALSE,FALSE];
Get[bpi.beadL].beadR← noBead; END;
IF bpi.beadU#noBead THEN BEGIN Save[bpi.beadU,FALSE,FALSE];
Get[bpi.beadU].beadD← noBead; END;
IF bpi.beadD#noBead THEN BEGIN Save[bpi.beadD,FALSE,FALSE];
Get[bpi.beadD].beadU← noBead; END;
IF bpi.beadT#noBead THEN BEGIN IF Get[t].beadT#i THEN t← bpt.beadT;
Save[t,FALSE,FALSE];
bpt.beadT← noBead; END;
bpi.x← 2*maxX; bpi.y← 2*maxY;
Clear[bpi]; END;

Restore:PUBLIC PROCEDURE= BEGIN
a,i:CARDINAL;
--IODefs.WriteLine["failed"];
FOR i DECREASING IN [0..index) DO Get[a←address[i]]↑← cache[i]; ENDLOOP;
noMoves← deleteindex← index← 0;
topBead← oldtopBead;
END;


Abort:PUBLIC PROCEDURE=BEGIN
i:CARDINAL;
noMoves←0;
FOR i DECREASING IN [0..index) DO
IF abort[i]=TRUE THEN Get[address[i]]↑← cache[index← i];
ENDLOOP;
END;

Commit:PUBLIC PROCEDURE=BEGIN
i:INTEGER;
FOR i IN [0..deleteindex) DO
IF delete[i] IN [topBead-deleteindex..topBead] THEN
BEGIN DeleteBead[delete[i]];
delete[i]← noBead; END;
ENDLOOP;
FOR i IN [0..deleteindex) DO
IF delete[i]#noBead THEN DeleteBead[delete[i]]; ENDLOOP;
noMoves← index← deleteindex←0;
oldtopBead← topBead;
--IODefs.WriteLine["done"];
END;

DeleteBead:PUBLIC PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
bpi:BeadPtr←Get[i];

bpt:BeadPtr←Get[topBead];
--switch the bead with the topBead
IF i=topBead THEN BEGIN topBead←topBead-1; RETURN; END;
IF (j←bpt.beadU)#noBead THEN Get[j].beadD←i;
IF (j←bpt.beadD)#noBead THEN Get[j].beadU←i;
IF (j←bpt.beadR)#noBead THEN Get[j].beadL←i;
IF (j←bpt.beadL)#noBead THEN Get[j].beadR←i;
IF (j←bpt.beadT)#noBead THEN FOR j←topBead, Get[j].beadT DO
IF Get[j].beadT=topBead THEN BEGIN Get[j].beadT←i; EXIT; END;
ENDLOOP;
bpi↑←bpt↑;
topBead←topBead-1;
END;

--************************************************************************
Rotate:PUBLIC PROCEDURE=BEGIN i,s:CARDINAL; t:INTEGER;
FindBoundingBox[];
FOR i IN [0..topBead] DO BEGIN
bpi:BeadPtr←Get[i];
bi:Bead←bpi↑;
t←bi.y; bi.y←maxX-bi.x-bi.w; bi.x←t;
t←bi.w; bi.w←bi.h; bi.h←t;
s←bi.beadL; bi.beadL←bi.beadD; bi.beadD←bi.beadR;
bi.beadR←bi.beadU; bi.beadU←s;
bi.t←desP[bi.t].rotate;
bpi↑←bi;
END ENDLOOP;
END;

Reflect:PUBLIC PROCEDURE=BEGIN i,s:CARDINAL; t:INTEGER;
FindBoundingBox[];
FOR i IN [0..topBead] DO BEGIN
bpi:BeadPtr←Get[i];
bi:Bead←bpi↑;
t←bi.y; bi.y←bi.x; bi.x←t;
t←bi.w; bi.w←bi.h; bi.h←t;
s←bi.beadL; bi.beadL←bi.beadD; bi.beadD←s;
s←bi.beadR; bi.beadR←bi.beadU; bi.beadU←s;
bi.t←desP[bi.t].rotate;
bpi↑←bi;
END ENDLOOP;
END;

RotateBack:PUBLIC PROCEDURE=BEGIN i,s:CARDINAL; t:INTEGER;
FindBoundingBox[];
FOR i IN [0..topBead] DO BEGIN
bpi:BeadPtr←Get[i];
bi:Bead←bpi↑;
t←bi.x; bi.x←maxY-bi.y-bi.h; bi.y←t;
t←bi.w; bi.w←bi.h; bi.h←t;
s←bi.beadL; bi.beadL←bi.beadU; bi.beadU←bi.beadR;
bi.beadR←bi.beadD; bi.beadD←s;
bi.t←desP[bi.t].rotate;
bpi↑←bi;
END ENDLOOP;
END;

END..

MinSepInY:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[INTEGER]= BEGIN
bpi:BeadPtr←Get[i];
bpj:BeadPtr←Get[j];
si:CARDINAL=desP[bpi.t].short; sj:CARDINAL=desP[bpj.t].short;
SELECT TRUE FROM
desP[bpi.t].lessLevel#desP[bpj.t].lessLevel =>RETURN[-maxY];
bpi.wire AND bpj.wire => RETURN[IF Overlap[i,j] THEN maxY ELSE -maxY];
bpi.circuit#bpj.circuit => RETURN[Des4[sj][si]];
si=sj AND si IN [5..7] AND ~bpi.wire AND ~bpj.wire =>
RETURN[-MAX[bpi.h,bpj.h]];
ENDCASE=>RETURN[Des5[sj][si]];
END;

MinSepInX:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[INTEGER]= BEGIN
bpi:BeadPtr←Get[i];
bpj:BeadPtr←Get[j];
si:CARDINAL=desP[bpi.t].short; sj:CARDINAL=desP[bpj.t].short;
SELECT TRUE FROM
desP[bpi.t].lessLevel#desP[bpj.t].lessLevel =>RETURN[-maxX];
bpi.wire AND bpj.wire => RETURN[IF Overlap[i,j] THEN maxX ELSE -maxX];
bpi.circuit#bpj.circuit => RETURN[Des6[sj][si]];
si=sj AND si IN [5..7] AND ~bpi.wire AND ~bpj.wire =>
RETURN[-MAX[bpi.w,bpj.w]];
ENDCASE=>RETURN[Des7[sj][si]];
END;