--beadsmove.mesa

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

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

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

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

--************************************************************************
--path detection and removal
Find:PUBLIC PROCEDURE[b:BeadType,i:CARDINAL] RETURNS[CARDINAL]=BEGIN
t:Desc←DescT[GetDesc[i]]; RETURN[IF t.p.t=b THEN t.z ELSE t.p.beadT]; END;

FindPath:PUBLIC PROCEDURE[i,j:CARDINAL,v:Variant] RETURNS[BOOLEAN]= BEGIN
FindOut:PROCEDURE[v:Variant,bpi:BeadPtr] RETURNS[BOOLEAN]= BEGIN
RecursiveFindPath:PROCEDURE[mm:CARDINAL,v:Variant] RETURNS[BOOLEAN]=
BEGIN
IF mm=noBead THEN RETURN[FALSE];
IF mm=j THEN RETURN[TRUE];
IF i=mm OR step> maxPathLength THEN RETURN[FALSE];
BEGIN
m:Desc←GetDesc[mm];
IF Trans[m] THEN RETURN[FALSE];
path[step]←[m.z,v];
step←step+1;
RETURN[FindOut[v,m.p]];
END; END;
IF v#left AND RecursiveFindPath[bpi.beadR,right] THEN RETURN[TRUE];
IF v#right AND RecursiveFindPath[bpi.beadL,left ] THEN RETURN[TRUE];
IF v#up AND RecursiveFindPath[bpi.beadD,down ] THEN RETURN[TRUE];
IF v#down AND RecursiveFindPath[bpi.beadU,up ] THEN RETURN[TRUE];
IF v#tied AND RecursiveFindPath[bpi.beadT,tied ] THEN RETURN[TRUE];
step←step-1;
RETURN[FALSE];
END;
step← 0;
RETURN[FindOut[v,Get[i]]];
END;


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

--************************************************************************
--queries about the beads
NumRelatives:PUBLIC PROCEDURE[ii:CARDINAL] RETURNS[num:CARDINAL]= BEGIN
i:Desc←GetDesc[ii];
num←(IF NoBeadR[i] THEN 0 ELSE 1)
+(IF NoBeadL[i] THEN 0 ELSE 1)
+(IF NoBeadU[i] THEN 0 ELSE 1)
+(IF NoBeadD[i] THEN 0 ELSE 1)
+(IF NoBeadT[i] THEN 0 ELSE 1);
END;

Overlap:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]= BEGIN
s:Desc←GetDesc[i]; t:Desc←GetDesc[j];
RETURN[InteractH[s,t,0] AND InteractV[s,t,0]]
END;

SlackH:PROCEDURE[i,v:Desc] RETURNS[INTEGER]=BEGIN
t1:INTEGER←Bot[v]-Bot[i];
t2:INTEGER←Top[v]-Top[i];
RETURN[IF t1>0 THEN MAX[0,MIN[t1,t2]] ELSE MIN[0,MAX[t1,t2]]];
END;

SlackV:PROCEDURE[i,v:Desc] RETURNS[INTEGER]=BEGIN
t1:INTEGER←Lfm[v]-Lfm[i];
t2:INTEGER←Rtm[v]-Rtm[i];
RETURN[IF t1>0 THEN MAX[0,MIN[t1,t2]] ELSE MIN[0,MAX[t1,t2]]];
END;

Push:PROCEDURE[i,j:Desc] RETURNS[d:Coord]= BEGIN
--i pushes on j. How far must j move?
delta:Coord←Delta[i,j];
w:INTEGER← IF Lfm[i]<Lfm[j] THEN Lfm[j]- Rtm[i] ELSE Lfm[i]- Rtm[j];
h:INTEGER← IF Bot[i]<Bot[j] THEN Bot[j]- Top[i] ELSE Bot[i]- Top[j];
x:INTEGER← w-delta.x;
y:INTEGER← h-delta.y;
IF x< 0 AND y< 0
THEN BEGIN
d←[IF Lfm[i]<Lfm[j] THEN -x ELSE x,IF Bot[i]<Bot[j] THEN -y ELSE y];
SELECT TRUE FROM
~j.p.wire => IF x> y THEN d.y← 0 ELSE d.x← 0;
~NoBeadL[j] => d.x←0;
~NoBeadU[j] => d.y←0;
ENDCASE;
RETURN[d];
END;
RETURN[Zero];
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;

SaveBoth:PROCEDURE[i,j:Desc]={Save[i.z,FALSE,FALSE]; Save[j.z,FALSE,FALSE]};

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

Attach:PUBLIC PROCEDURE[i:Desc,variant:Variant,j:Desc]=
BEGIN --Attach i to the variant of j
m,n:Desc;
SaveBoth[i,j];
SELECT variant FROM
left => BEGIN
SaveBoth[m←DescR[i],n←DescL[j]];
m.p.beadL← noBead; n.p.beadR←noBead;
HookLR[i,j];
END;
right => BEGIN
SaveBoth[m←DescR[j],n←DescL[i]];
m.p.beadL←noBead; n.p.beadR←noBead;
HookLR[j,i];
END;
up => BEGIN
SaveBoth[m←DescU[j],n←DescD[i]];
m.p.beadD←noBead; n.p.beadU←noBead;
HookUD[j,i];
END;
down => BEGIN
SaveBoth[m←DescU[i],n←DescD[j]];
m.p.beadD←noBead; n.p.beadU←noBead;
HookUD[i,j];
END;
tied => BEGIN
IncrementX[i,Lfm[j]-Lfm[i]+(Width[j]- Width[i])/2];
IncrementY[i,Bot[j]-Bot[i]+(Height[j]- Height[i])/2];
SaveBoth[m←DescT[i],n←DescT[j]];
m.p.beadT←noBead; n.p.beadT←noBead;
IF ~NoBead[i] THEN i.p.beadT←j.z; j.p.beadT←i.z;
END;
ENDCASE;
END;

AttachAll:PUBLIC PROCEDURE[i,j:CARDINAL]= BEGIN
AttachOne:PROCEDURE[i:Desc,v:Variant]=
INLINE BEGIN IF ~NoBead[i] THEN Attach[i,v,GetDesc[j]]; END;
k:Desc←GetDesc[i];
AttachOne[DescL[k],left ];
AttachOne[DescR[k],right];
AttachOne[DescU[k],up ];
AttachOne[DescD[k],down ];
AttachOne[DescT[k],tied ];
END;

Move:PUBLIC PROCEDURE[i:Desc,a:Coord]] RETURNS[BOOLEAN] =
BEGIN
IF noBead[i] THEN RETURN[TRUE] ELSE BEGIN
d:Desc←DescD[i]; l:Desc←DescL[i]; u:Desc←DescU[i]; r:Desc←DescR[i];
t:Desc←DescT[i];
w:INTEGER← Width[i]; h:INTEGER← Height[i];
k:Desc←IF NoBead[t] THEN i ELSE DescT[t];
IF Lfm[i]+ a.x ~IN [0..maxX-w] OR Bot[i]+ a.y ~IN [0..maxY-h]
OR (noMoves← noMoves+1)>maxMoves THEN RETURN[FALSE];
noMoves← noMoves+1;
Save[i,TRUE,FALSE];
IncrementX[i,a.x]; IncrementY[i,a.y]; SetW[i,w]; SetH[i,h];
IF ~Movex[down ,u, Zero]
OR ~Movex[left ,r, Zero]
OR ~Movex[up ,d, Zero]
OR ~Movex[right,l, Zero]
OR ~Movex[tied ,t,a]
OR k#m AND ~Movex[tied ,k,a]
THEN RETURN[FALSE];
RETURN[Legal[i]];
END; END;

Movex:PUBLIC PROCEDURE[variant:Variant,i:Desc,a:Coord]] RETURNS[BOOLEAN] =
BEGIN
IF noBead[i] THEN RETURN[TRUE] ELSE BEGIN
d:Desc←DescD[i]; l:Desc←DescL[i]; u:Desc←DescU[i]; r:Desc←DescR[i];
t:Desc←DescT[i];
w:INTEGER← Width[i]; h:INTEGER← Height[i];
IF Wir[i] THEN BEGIN
d5:INTEGER←Des5[desP[Type[u]].short][desP[Type[d]].short];
d7:INTEGER←Des7[desP[Type[l]].short][desP[Type[r]].short];
SELECT variant FROM
left =>{w←MAX[d7,Lfm[r]-Rtm[l]]; a←[Rtm[l]-Lfm[i],SlackH[i,l]]};
down =>{h←MAX[d5,Bot[u]-Top[d]]; a←[SlackV[i,d],Top[d]-Bot[i]]};
right=>{w←MAX[d7,Lfm[r]-Rtm[l]]; a←[Lfm[r]-(Lfm[i]+w),SlackH[i,r]]};
up =>{h←MAX[d5,Bot[u]-Top[d]]; a←[SlackV[i,u],Bot[u]-(Bot[i]+h)]};
ENDCASE;
IF a=Zero AND Width[i]=w AND Height[i]=h THEN RETURN[TRUE];
END;
IF a=Zero THEN RETURN[TRUE];
BEGIN
k:Desc←IF NoBead[t] THEN i ELSE DescT[t];
IF Lfm[i]+ a.x ~IN [0..maxX-w] OR Bot[i]+ a.y ~IN [0..maxY-h]
OR (noMoves← noMoves+1)>maxMoves THEN RETURN[FALSE];
Save[i,TRUE,FALSE];
IncrementX[i,a.x]; IncrementY[i,a.y];
SetW[i,w]; SetH[i,h];
IF variant#up AND ~Movex[down ,u, Zero]
OR variant#right AND ~Movex[left ,r, Zero]
OR variant#down AND ~Movex[up ,d, Zero]
OR variant#left AND ~Movex[right,l, Zero]
OR variant#tied AND ~Movex[tied ,t,a]
OR variant#tied AND k#m AND ~Movex[tied ,k,a]
THEN RETURN[FALSE];
RETURN[Legal[i]];
END; END; END;

Zero:Coord=[0,0];

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

LegalLong:PROCEDURE[i:Desc] RETURNS[BOOLEAN]= BEGIN
--make the rest of the world legal with respect to i
NoName:PROCEDURE[j:Desc] RETURNS[abort:BOOLEAN]=BEGIN
d:Coord← Push[i,j];
SELECT TRUE FROM
d=Zero OR TouchingBeads[i,j] OR TiedBeads[i,j] =>NULL;
~Move[j,d] =>RETURN[TRUE];
ENDCASE;
RETURN[FALSE];
END;
RETURN[~EnumerateBeadsWithAbort[NoName]];
END;

Zero:Coord←[0,0];

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

Put:PUBLIC PROCEDURE[i:Desc,dx,dy,h,w:INTEGER]= BEGIN
Save[i,FALSE,TRUE];
IncrementX[i,dx];
IncrementY[i,dy];
IF h#0 THEN SetH[i,h];
IF w#0 THEN SetW[i,w];
END;

Create:PROCEDURE[ty:BeadType,x,y,h,w,circuit:INTEGER] RETURNS[Desc]= BEGIN
t:Desc←GetFreeBead[];
Save[t];
t.p.x← x; t.p.y← y; t.p.circuit← circuit;
t.p.w← IF w=0 THEN desP[ty].w ELSE w;
t.p.h← IF h=0 THEN desP[ty].h ELSE h;
t.p.t← ty;
t.p.wire← ty=wireG OR ty=wireB OR ty=wireR;
InitBeadWork[t];
RETURN[t];
END;

InsertJogs:PUBLIC PROCEDURE[i:Desc,horizontal,vertical:Variant]= BEGIN
InsertJog[i,left,horizontal];
InsertJog[i,right,horizontal];
InsertJog[i,down,vertical];
InsertJog[i,up,vertical];
END;


InsertJog:PROCEDURE[i:Desc,whichEnd,bend:Variant]= BEGIN
wire:Desc←SELECT whichEnd FROM
left=>DescR[i], right=>DescL[i], up=>DescD[i], ENDCASE=>DescU[i];
IF NoBead[wire] THEN RETURN ELSE BEGIN
wt:BeadType← Type[wire];
vert:BOOLEAN← whichEnd=up OR whichEnd=down;
s:INTEGER←IF wt=wireB THEN 6 ELSE 4;
x:INTEGER←Lfm[i]; y:INTEGER←Bot[i];
jt:BeadType← SELECT wt FROM wireR => jctnR,wireB => jctnB, ENDCASE => jctnG;
j1:Desc← Create[jt,x,y,s,s,i.p.circuit];
j2:Desc← Create[jt,x,y,s,s,i.p.circuit];
w1:Desc← IF vert THEN Create[wt,x,y+s,-s,s,i.p.circuit]
ELSE Create[wt,x+s,y,s,-s,i.p.circuit];
w2:Desc← IF vert THEN Create[wt,x+s,y,s,-s,i.p.circuit]
ELSE Create[wt,x,y+s,-s,s,i.p.circuit];
Attach[i,whichEnd,w1]; Attach[j2,whichEnd,wire];
Attach[w1,whichEnd,j1]; Attach[j2,bend,w2]; Attach[w2,bend,j1];
END; END;




--************************************************************************
--find room for a group of beads
RoomFor:PUBLIC PROCEDURE[ii:CARDINAL] RETURNS[r:BOOLEAN]= BEGIN
--make i legal with respect to the rest of the world
i:Desc←GetDesc[ii];
quit:BOOLEAN←FALSE;
NoName:PROCEDURE[j:Desc]=BEGIN
IF quit THEN RETURN ELSE BEGIN
d:Coord← Push[i,j];
quit←d#Zero AND ~TouchingBeads[i,j] AND ~TiedBeads[i,j]
AND Shift[-d.x,-d.y];
END; END;
EnumerateBeads[NoName];
RETURN[~quit];
END;

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

Shift:PUBLIC PROCEDURE[dx,dy:INTEGER] RETURNS[BOOLEAN]= BEGIN
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:CARDINAL IN [0..index) DO
IF shift[i] THEN BEGIN
a:Desc←GetDesc[address[i]];
IncrementX[a,dx];
IncrementY[a,dy];
END;
ENDLOOP;
RETURN[TRUE];
END;

--************************************************************************
--procedures that save state until a transformation is complete
Save:PUBLIC 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];
Save[i,FALSE,FALSE];
delete[deleteindex]← i;
deleteindex← deleteindex+ 1;
SaveAndClear[bpi,right];
SaveAndClear[bpi,left];
SaveAndClear[bpi,up];
SaveAndClear[bpi,down];
SaveAndClear[bpi,tied];
bpi.x← 2*maxX; bpi.y← 2*maxY;
Clear[bpi]; END;

--NONSENSE
SaveAndClear:PROCEDURE[bpi:BeadPtr,v:Variant]=BEGIN
t:CARDINAL←SELECT v FROM right=>bpi.beadR,left=>bpi.beadL, up=>bpi.beadU,
down=>bpi.beadD, tied=>bpi.beadT, ENDCASE=>ERROR;
IF t=noBead THEN RETURN;
Save[t,FALSE,FALSE];
SELECT v FROM
right=>bpi.beadL←noBead;
left =>bpi.beadR←noBead;
up =>bpi.beadD←noBead;
down =>bpi.beadU←noBead;
tied =>bpi.beadT←noBead;
ENDCASE=>ERROR;
END;

Restore:PUBLIC PROCEDURE= BEGIN
FOR i:CARDINAL DECREASING IN [0..index) DO
this:Desc←GetDesc[address[i]];
this.p↑←cache[i];
IF Type[this]=none THEN ReleaseBead[this];
ENDLOOP;
noMoves← deleteindex← index← 0;
END;

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

Commit:PUBLIC PROCEDURE=BEGIN
FOR i:INTEGER IN [0..deleteindex) DO
IF delete[i]=noBead THEN Error;
ReleaseBead[GetDesc[delete[i]]];
ENDLOOP;
noMoves← index← deleteindex←0;
oldtopBead← topBead;
END;

--************************************************************************
Rotate:PUBLIC PROCEDURE=
BEGIN FindBoundingBox[]; EnumerateBeads[RotateOne]; END;
Reflect:PUBLIC PROCEDURE=
BEGIN FindBoundingBox[]; EnumerateBeads[ReflectOne]; END;
RotateBack:PUBLIC PROCEDURE=
BEGIN FindBoundingBox[]; EnumerateBeads[RotateBackOne]; END;

RotateOne:PROCEDURE[i:Desc]=BEGIN
s:CARDINAL; t:INTEGER;
t←Bot[i]; i.p.y←maxX-Rtm[i]; i.p.x←t; t←i.p.w; i.p.w←i.p.h; i.p.h←t;
s←i.p.beadL; i.p.beadL←i.p.beadD; i.p.beadD←i.p.beadR;
i.p.beadR←i.p.beadU; i.p.beadU←s;
i.p.t←desP[i.p.t].rotate;
END;

ReflectOne:PUBLIC PROCEDURE[i:Desc]=BEGIN
s:CARDINAL; t:INTEGER;
t←Bot[i]; i.p.y←Lfm[i]; i.p.x←t; t←i.p.w; i.p.w←i.p.h; i.p.h←t;
s←i.p.beadL; i.p.beadL←i.p.beadD; i.p.beadD←s;
s←i.p.beadR; i.p.beadR←i.p.beadU; i.p.beadU←s;
i.p.t←desP[i.p.t].rotate;
END;

RotateBackOne:PUBLIC PROCEDURE[i:Desc]=BEGIN
s:CARDINAL; t:INTEGER;
t←Bot[i]; i.p.x←maxY-Top[i]; i.p.y←t; t←i.p.w; i.p.w←i.p.h; i.p.h←t;
s←i.p.beadL; i.p.beadL←i.p.beadU; i.p.beadU←i.p.beadR;
i.p.beadR←i.p.beadD; i.p.beadD←s;
i.p.t←desP[i.p.t].rotate;
END;

END..

AndOfRelatives:PUBLIC PROCEDURE[ii,jj:CARDINAL] RETURNS[BOOLEAN]= BEGIN
i:Desc←GetDesc[ii];
j:Desc←GetDesc[jj];
RETURN[~NoBeadL[i] AND ~NoBeadL[j]
OR ~NoBeadR[i] AND ~NoBeadR[j]
OR ~NoBeadU[i] AND ~NoBeadU[j]
OR ~NoBeadD[i] AND ~NoBeadD[j]];
END;

DeleteBead:PUBLIC PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
bpi:BeadPtr←Get[i];
bpt:BeadPtr←Get[topBead];
--switch the bead with the topBead
Error;
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;