-- CreateBeads5.mesa
-- put in long pointers

-- dd etc
-- two backfacing transistors!

DIRECTORY IODefs:FROM"IODefs",
BeadsDefs:FROM"BeadsDefs",
InlineDefs:FROM"InlineDefs",
SystemDefs:FROM"SystemDefs",
StringDefs:FROM"StringDefs",
StreamDefs:FROM"StreamDefs";
CreateBeads:PROGRAM
IMPORTS InlineDefs,SystemDefs,StringDefs,StreamDefs,IODefs,BeadsDefs
EXPORTS BeadsDefs =
BEGIN OPEN BeadsDefs;

Error:SIGNAL=CODE;
IllegalInput:SIGNAL=CODE;

someBead:CARDINAL=noBead+1;

PackedInput:TYPE=RECORD[a:[0..17B],b:[0..7777B]];
PackedBytes:TYPE=RECORD[a,b:Byte];
Byte:TYPE=[0..256);
pieces:PackedBytes;
right:BOOLEAN;
altoYMax:CARDINAL=1000;
inputStream:StreamDefs.DiskHandle;

allSticks:POINTER TO StickStuff;
topStick:CARDINAL;
xLo,yLo,xHi,yHi:[0..10000];
stickScaling:CARDINAL=20;

--allContacts:ConStuff;
--topContact:CARDINAL←0;

getWhatYouSee:PUBLIC BOOLEAN;

--BeadType:TYPE={none,all,rg,rb,bg,tt,dd,ttV,ddV,endG,endR,endB,stub,
-- jctn,jctnR,jctnB,bf,wireG,wireR,wireB,wireO,of};

typeFromColor:ARRAY Color OF ARRAY Color OF BeadType←[
[none,endR,endB,endG,endR,endO],
[none,jctnR,rb,rg,jctnR,endO],
[none,rb,jctnB,bg,rb,endO],
[none,rg,bg,jctnG,rg,endO],
[none,jctnR,rb,rg,jctnR,endO],
[none,endO,endO,endO,endO,endO]];

ColorToLevel:ARRAY Color OF CARDINAL←[0,1,2,1,1,3];
--none,red,blue,green,yellow,orange
ColorToType:ARRAY Color OF ARRAY Color OF BeadType←--1st guy horizontal
[[none ,none ,none ,none ,none ,none],
[none ,jctnR,none , ttV ,jctnR, endO ],
[none ,none ,jctnB,none ,none , endO ],
[none , tt ,none ,jctnG, dd , endO ],
[none ,jctnR,none , ddV ,jctnR, endO ],
[none, endO , endO , endO , endO , endO ]];

-- Code: jctn,jctnR,jctnB,rb,bg,rg,all,other
TwoCodes:ARRAY [0..5] OF ARRAY [0..5] OF BeadType←[
[jctnG, rg , bg , all , bg , rg ],
[ rg ,jctnR, rb , rb , all , rg ],
[ bg , rb ,jctnB, rb , bg , all ],
[ all , rb , rb , rb , all , all ],
[ bg , all , bg , all , bg , all ],
[ rg , rg , all , all , all , rg ]];
inTry:CARDINAL;


FromInputToBeads:PUBLIC PROCEDURE[fileName:STRING,pr:BOOLEAN]=BEGIN
i:CARDINAL;
allSticks←SystemDefs.AllocateSegment[SIZE[StickStuff]];
StringDefs.AppendString[fileName,".stick"];
FromSilFileToSticks[fileName];
fileName.length←fileName.length-6;
IF pr THEN PrintAllSticks[allSticks,topStick];
FindBoundsOfStickDiagram[];
IF getWhatYouSee THEN BEGIN
FOR i IN [0..topStick] DO WhatYouSeeIsWhatYouGet[i]; ENDLOOP;
EliminateNulls[];
END;
IF pr THEN PrintAllSticks[allSticks,topStick];
FOR i IN [0..topStick] DO MakeCloseTeeJctnsTouch[i]; ENDLOOP;
IF pr THEN PrintAllSticks[allSticks,topStick];
CompressStickCoordinates[];
IF pr THEN PrintAllSticks[allSticks,topStick];
FOR i IN [0..topStick] DO PutTeeJctnsInBeadTable[i]; ENDLOOP;
IF pr THEN PrintBeads[];
FOR i IN [0..topStick] DO PutCrossingsInBeadTable[i]; ENDLOOP;
IF pr THEN PrintBeads[];
FOR i IN [0..topStick] DO IF allSticks[i].color=y THEN allSticks[i].color←r; ENDLOOP;
FOR i IN [0..topBead] DO Get[i].beadT←noBead; ENDLOOP;
FOR i IN [0..topBead] DO ConvertMultipleLevelsToTiedBeads[i]; ENDLOOP;
IF pr THEN PrintBeads[];
FOR i IN [0..topBead] DO DoesBeadHaveNeighbors[i]; ENDLOOP;
FOR i IN [0..topBead] DO RecordBeadsNeighbors[i]; ENDLOOP;
IF pr THEN PrintBeads[];
FOR i IN [0..topBead] DO StickToBeadCoordinates[i]; ENDLOOP;
IF pr THEN PrintBeads[];
FOR i IN [0..topBead] DO WiggleTiedBeadsUpAndDown[i]; ENDLOOP;
IF pr THEN PrintBeads[];
FOR i IN [0..topBead] DO Get[i].wire←FALSE; ENDLOOP;
FOR i IN [0..topBead] DO AddWires[i]; ENDLOOP;
IF pr THEN PrintBeads[];
FOR i IN [0..topBead] DO SetHeightAndWidth[i]; ENDLOOP;
FOR i IN [0..topBead] DO CorrectWireLength[i]; ENDLOOP;
IF pr THEN PrintBeads[];
MakeCircuits[];
FOR i IN [0..topBead] DO SetTypeConstants[i]; ENDLOOP;
SystemDefs.FreeSegment[allSticks];
WriteOneNumber["size of stick table= ",topStick];
END;

FromSilFileToSticks:PROCEDURE[inName:STRING]=BEGIN
a,i:CARDINAL; m:PackedInput;
s,x,y,xMax,yMax,f:CARDINAL; string:STRING←[100]; c:Color;
inTry←0;
inputStream←StreamDefs.NewWordStream[inName,StreamDefs.Read];
a←RW[]; SELECT a FROM 34562B,34563B=>NULL; ENDCASE=>Error;
topStick←0;
UNTIL inputStream.endof[inputStream] DO
IF (a←RW[])#177777B THEN Error; -- type non-macro
m←LOOPHOLE[RW[]]; x←m.b;
yMax←altoYMax-RW[]; IF yMax>altoYMax THEN Error;
m←LOOPHOLE[RW[]]; xMax←m.b;
c←SELECT m.a FROM 1=>r, 2=>y, 3=>g, 4=>b, 9=>o, ENDCASE=>none;
--black,red,yellow,green,cyan,violet,magenta,white,
--brown,orange,lime,turquoise,aqua,ultraviolet,pink,smoke
m←LOOPHOLE[RW[]]; f←m.a; y←altoYMax-m.b; IF y>3777B THEN Error;
IF f<=13 THEN BEGIN
s←RB[];
FOR i IN [0..s) DO string[i]←LOOPHOLE[RB[],CHARACTER]; ENDLOOP;
END;
IF c#none AND f=14 THEN BEGIN
w:CARDINAL←xMax-x;
h:CARDINAL←yMax-y;
allSticks[topStick]←IF h>w THEN [v,c,x+w/2,y,yMax]
ELSE [h,c,x,y+h/2,xMax];
topStick←topStick+1;
IF topStick>maxStick THEN Error;
END;
--process exception stuff
ENDLOOP;
topStick←topStick-1;
inputStream.destroy[inputStream];
END;
-- ///////////////
FindBoundsOfStickDiagram:PROCEDURE=BEGIN i:CARDINAL;
xLo←yLo←10000;
xHi←yHi←0;
FOR i IN [0..topStick] DO IF allSticks[i].color#none THEN BEGIN
is:Stick←allSticks[i];
IF is.dir=h THEN SetLoHi[is.x,is.y-4,is.end,is.y+4]
ELSE SetLoHi[is.x-4,is.y,is.x+4,is.end];
END; ENDLOOP;
END;

SetLoHi:PROCEDURE[a,b,c,d:INTEGER]=BEGIN
IF a<xLo THEN xLo←a;
IF b<yLo THEN yLo←b;
IF c>xHi THEN xHi←c;
IF d>yHi THEN yHi←d;
END;
-- ///////////////
WhatYouSeeIsWhatYouGet:PROCEDURE[i:CARDINAL]=BEGIN
is:Stick←allSticks[i];
j:CARDINAL; js:Stick;
IF is.dir=h THEN FOR j IN (i..topStick] DO
js←allSticks[j];
IF js.dir=h AND is.color=js.color AND is.y=js.y AND js.x<=is.end
AND js.end>=is.x THEN BEGIN
js.x←MIN[is.x,js.x];
js.end←MAX[is.end,js.end];
allSticks[i].color←none;
EXIT;
END;
IF js.dir=h AND (is.color=r AND js.color=g OR is.color=g AND js.color=r)
AND is.y=js.y AND js.x<is.end
AND js.end>is.x THEN BEGIN--should complain if vert wire nearby
SELECT TRUE FROM
is.x>=js.x AND is.end<=js.end => allSticks[i].color←none;
js.x>=is.x AND js.end<=is.end => allSticks[j].color←none;
is.x>js.x => js.end←is.x;
ENDCASE=>is.end←js.x;
EXIT;
END;
ENDLOOP
ELSE FOR j IN (i..topStick] DO
js←allSticks[j];
IF js.dir=v AND is.color=js.color AND is.x=js.x AND js.y<=is.end
AND js.end>=is.y THEN BEGIN
js.y←MIN[is.y,js.y];
js.end←MAX[is.end,js.end];
allSticks[i].color←none;
EXIT;
END;
IF js.dir=v AND (is.color=r AND js.color=g OR is.color=g AND js.color=r)
AND is.x=js.x AND js.y<is.end
AND js.end>is.y THEN BEGIN--should complain if vert wire nearby
SELECT TRUE FROM
is.y>=js.y AND is.end<=js.end => allSticks[i].color←none;
js.y>=is.y AND js.end<=is.end => allSticks[j].color←none;
is.y>js.y => js.end←is.y;
ENDCASE=>is.end←js.y;
EXIT;
END;
ENDLOOP;
END;

EliminateNulls:PROCEDURE=BEGIN
i:CARDINAL←0;
UNTIL i=topStick DO
IF allSticks[i].color=none
THEN allSticks[i]←allSticks[(topStick←topStick-1)+1]
ELSE i←i+1;
ENDLOOP;
END;
-- ///////////////
MakeCloseTeeJctnsTouch:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
is:Stick←allSticks[i];
IF is.color=none THEN RETURN;
IF Close[is.x,xLo] THEN is.x←xLo;
IF Close[is.y,yLo] THEN is.y←yLo;
IF is.dir=h THEN IF CloseS[is.end,xHi] THEN is.end←xHi ELSE NULL
ELSE IF CloseS[is.end,yHi] THEN is.end←yHi ELSE NULL;
FOR j IN [0..topStick] DO IF i#j THEN BEGIN
js:Stick←allSticks[j];
IF is.dir=js.dir THEN BEGIN
IF is.dir=h AND CloseS[is.y,js.y] AND is.y#js.y
AND (WithinS[is.end,js.x,js.end] OR WithinS[is.x,js.x,js.end])
THEN Error;
IF is.dir=v AND CloseS[is.x,js.x] AND is.x#js.x
AND (WithinS[is.end,js.y,js.end] OR WithinS[is.y,js.y,js.end])
THEN Error;
END
ELSE BEGIN
IF is.dir=h AND WithinS[is.y,js.y,js.end] THEN BEGIN
IF CloseS[is.x,js.x] THEN is.x←js.x;
IF CloseS[is.end,js.x] THEN is.end←js.x;
END;
IF is.dir=v AND WithinS[is.x,js.x,js.end] THEN BEGIN
IF CloseS[is.y,js.y] THEN is.y←js.y;
IF CloseS[is.end,js.y] THEN is.end←js.y;
END;
END;
END; ENDLOOP;
allSticks[i]←is;
END;
-- ///////////////
CompressStickCoordinates:PROCEDURE=BEGIN i:CARDINAL;
s,ad,c:INTEGER;
s←0;
FOR c IN [xLo..xHi] DO
ad←IF c=xLo OR c=xHi THEN 1 ELSE 0;
FOR i IN [0..topStick] DO
IF allSticks[i].x=c THEN BEGIN allSticks[i].x←s; ad←1; END;
IF allSticks[i].end=c AND allSticks[i].dir=h
THEN BEGIN allSticks[i].end←s; ad←1; END;
ENDLOOP;
s←s+ad;
ENDLOOP;
xLo←0; xHi←s-1;
s←0;
FOR c IN [yLo..yHi] DO
ad←IF c=xLo OR c=xHi THEN 1 ELSE 0;
FOR i IN [0..topStick] DO
IF allSticks[i].y=c THEN BEGIN allSticks[i].y←s; ad←1; END;
IF allSticks[i].end=c AND allSticks[i].dir=v
THEN BEGIN allSticks[i].end←s; ad←1; END;
ENDLOOP;
s←s+ad;
ENDLOOP;
yLo←0; yHi←s-1;
END;

-- ///////////////
PutTeeJctnsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN is:Stick←allSticks[i];
IF is.color=none THEN RETURN;
SeeIfButts[is.x,is.y,i];
IF is.dir=h THEN SeeIfButts[is.end,is.y,i] ELSE SeeIfButts[is.x,is.end,i];
END;

SeeIfButts:PROCEDURE[x,y:INTEGER,i:CARDINAL]=BEGIN j:CARDINAL;
ic:Color←allSticks[i].color;
IF Close[x,xHi] OR Close[x,xLo] OR Close[y,yHi] OR Close[y,yLo]
THEN Cc[x,y,none,ic]
ELSE FOR j IN [0..topStick] DO IF i#j THEN BEGIN
js:Stick←allSticks[j];
IF js.dir=h AND Close[y,js.y] AND Within[x,js.x,js.end]
OR js.dir=v AND Close[x,js.x] AND Within[y,js.y,js.end]
THEN Cc[x,y,ic,js.color];
END; ENDLOOP;
END;
-- ///////////////
PutCrossingsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
is:Stick←allSticks[i];
IF is.color=none THEN RETURN;
FOR j IN [0..topStick] DO BEGIN
js:Stick←allSticks[j];
IF is.dir=h AND js.dir=v AND is.y IN (js.y..js.end)
AND js.x IN (is.x..is.end)
THEN BEGIN
type:BeadType←ColorToType[is.color][js.color];
IF type#none THEN InsertContact[js.x,is.y,type];
END;
END; ENDLOOP;
END;
-- ///////////////
ConvertMultipleLevelsToTiedBeads:PROCEDURE[i:CARDINAL]= BEGIN
bpi:BeadPtr←Get[i];
bpt1,bpt2:BeadPtr;
SELECT bpi.t FROM
rg,all=>BEGIN
InsertBead[bpi↑];
bpt1←Get[topBead];
InsertBead[bpi↑];
bpt2←Get[topBead];
bpt1.t←rb; bpt1.beadT←topBead;
bpt2.t←bf; bpt2.beadT←i;
bpi .t←bg; bpi .beadT←topBead-1;
END;
rb=>BEGIN
InsertBead[bpi↑];
bpt1←Get[topBead];
bpt1.beadT←i;
bpt1.t←bf;
bpi.beadT←topBead;
bpi.external←bpt1.external←2;
END;
bg=>BEGIN
InsertBead[bpi↑];
bpt1←Get[topBead];
bpt1.beadT←i;
bpt1.t←bf;
bpi.beadT←topBead;
bpi.external←bpt1.external←2;
END;
ENDCASE;
END;
-- ///////////////
DoesBeadHaveNeighbors:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
bpi:BeadPtr←Get[i];
bpi.beadR←bpi.beadL←bpi.beadU←bpi.beadD←noBead;
FOR j IN [0..topStick] DO BEGIN js:Stick←allSticks[j];
IF SELECT js.color FROM
r,y=>SELECT bpi.t FROM all,jctnR,rg,rb,tt,ttV,dd,ddV,endR=>TRUE,
ENDCASE=>FALSE,
g=> SELECT bpi.t FROM all,jctnG,rg,bg,tt,ttV,dd,ddV,endG=>TRUE,
ENDCASE=>FALSE,
b=> SELECT bpi.t FROM all,jctnB,endB,bf=>TRUE, ENDCASE=>FALSE,
ENDCASE=>FALSE THEN BEGIN
IF js.dir=h AND bpi.y=js.y THEN BEGIN
IF bpi.x IN [js.x..js.end) THEN bpi.beadR←someBead;
IF bpi.x IN (js.x..js.end] THEN bpi.beadL←someBead;
END;
IF js.dir=v AND bpi.x=js.x THEN BEGIN
IF bpi.y IN [js.y..js.end) THEN bpi.beadU←someBead;
IF bpi.y IN (js.y..js.end] THEN bpi.beadD←someBead;
END;
END;
END; ENDLOOP;
END;
-- ///////////////
RecordBeadsNeighbors:PROCEDURE[i:CARDINAL]=BEGIN j:CARDINAL;
bpi:BeadPtr←Get[i];
bpa:BeadPtr;
Find:PROCEDURE[q:CARDINAL] RETURNS[aBead:CARDINAL]=BEGIN
min:BOOLEAN←q=0 OR q=2;
ext:INTEGER←IF min THEN 10000 ELSE 0;
aBead←noBead;
FOR j IN [0..topBead] DO BEGIN
bpj:BeadPtr←Get[j];
sameX:BOOLEAN;
jx:INTEGER←bpj.x; jy:INTEGER←bpj.y;
ay,by:INTEGER;
IF q<2 THEN BEGIN ay←jy; by←bpi.y; sameX←(jx=bpi.x); END
ELSE BEGIN ay←jx; by←bpi.x; sameX←(jy=bpi.y); END;
IF sameX
AND (IF min THEN ay IN (by..ext] ELSE ay IN [ext..by))
AND (IF q<2 THEN desP[bpi.t].bitPerLevelV=desP[bpj.t].bitPerLevelV
ELSE desP[bpi.t].bitPerLevel=desP[bpj.t].bitPerLevel)
THEN BEGIN ext←ay; aBead←j; END;
END; ENDLOOP;
bpa←Get[aBead];
IF noBead=(SELECT q FROM 0=>bpa.beadD, 1=>bpa.beadU,
2=>bpa.beadL, ENDCASE=>bpa.beadR)
THEN aBead←noBead;
END;
IF bpi.beadU=someBead THEN bpi.beadU←Find[0];
IF bpi.beadD=someBead THEN bpi.beadD←Find[1];
IF bpi.beadR=someBead THEN bpi.beadR←Find[2];
IF bpi.beadL=someBead THEN bpi.beadL←Find[3];
END;
-- ///////////////
StickToBeadCoordinates:PROCEDURE[i:CARDINAL]=BEGIN
bpi:BeadPtr←Get[i];
m:CARDINAL←bpi.x; n:CARDINAL←bpi.y;
bpi.x←m*stickScaling; bpi.y←n*stickScaling;
END;
-- ///////////////
WiggleTiedBeadsUpAndDown:PROCEDURE[i:CARDINAL]= BEGIN
New:TYPE=RECORD[rx,ry,gx,gy,bx,by:INTEGER];
bpi:BeadPtr←Get[i];
IF bpi.t=bg AND Get[bpi.beadT].t=rb THEN BEGIN
green:CARDINAL=i;
red:CARDINAL←bpi.beadT;
blue:CARDINAL←Get[red].beadT;
bpg:BeadPtr←Get[green];
bpr:BeadPtr←Get[red];
bpb:BeadPtr←Get[blue];
IF bpb.t#bf OR bpb.beadT#green THEN Error;
BEGIN
lc:Color←IF bpg.beadL#noBead THEN g
ELSE IF bpr.beadL#noBead THEN r ELSE none;
rc:Color←IF bpg.beadR#noBead THEN g
ELSE IF bpr.beadR#noBead THEN r ELSE none;
uc:Color←IF bpg.beadU#noBead THEN g
ELSE IF bpr.beadU#noBead THEN r ELSE none;
dc:Color←IF bpg.beadD#noBead THEN g
ELSE IF bpr.beadD#noBead THEN r ELSE none;
new:New;
IF bpr.beadL#noBead AND bpg.beadL#noBead THEN IllegalInput;
IF bpr.beadR#noBead AND bpg.beadR#noBead THEN IllegalInput;
IF bpr.beadU#noBead AND bpg.beadU#noBead THEN IllegalInput;
IF bpr.beadD#noBead AND bpg.beadD#noBead THEN IllegalInput;
new←SELECT TRUE FROM --There has got to be a better way!
lc=g AND rc=g AND uc=r =>[0,6,0, 0,0, 0],
lc=g AND rc=g =>[0,-6,0,0,0,-6],
lc=r AND rc=r AND uc=g =>[0,0,0, 6,0, 0],
lc=r AND rc=r =>[0,0,0,-6,0,-6],
uc=g AND dc=g AND lc=r =>[-6,0,0,0,-6,0],
uc=g AND dc=g =>[ 6,0,0,0, 0,0],
uc=r AND dc=r AND lc=g =>[0,0,-6,0,-6,0],
uc=r AND dc=r =>[0,0,6,0, 0, 0],
lc#g AND rc#g AND uc=g =>[0,0,0, 6,0, 0],
lc#g AND rc#g =>[0,0,0,-6,0,-6],
lc#r AND rc#r AND uc=r =>[0, 6,0,0,0, 0],
lc#r AND rc#r =>[0,-6,0,0,0,-6],
uc#g AND dc#g AND rc=g =>[0,0, 6,0, 0,0],
uc#g AND dc#g =>[0,0,-6,0,-6,0],
uc#r AND dc#r AND rc=r =>[ 6,0,0,0, 0,0],
ENDCASE => [-6,0,0,0,-6,0];
bpr.x←bpr.x+new.rx;
bpg.x←bpg.x+new.gx;
bpb.x←bpb.x+new.bx;
bpr.y←bpr.y+new.ry;
bpg.y←bpg.y+new.gy;
bpb.y←bpb.y+new.by;
bpr.external← --1 means 6hx8w--
bpg.external← --1 means 6hx8w--
bpb.external←IF new.ry#0 OR new.gy#0 THEN 1 ELSE 0;
--1 means 12hx8w--
END;
END;
END;
-- ///////////////
AddWires:PROCEDURE[i:CARDINAL]=BEGIN k:CARDINAL;
bi:BeadPtr←Get[i];
bpk,bpt:BeadPtr;
IF (k←bi.beadR)#noBead THEN BEGIN
bpk←Get[k];
IF (topBead←topBead+1) NOT IN [0..noBead) THEN ERROR;
bpt←Get[topBead];
bpt.y←bi.y+10-((bi.y+10) MOD 20);
bpt.beadU←bpt.beadD←bpt.beadT←noBead;
bpt.beadL←i;
bpt.beadR←k;
bpt.t←desP[bi.t].rwc;
bpt.external←0;
bi.beadR←bpk.beadL←topBead;
SetTypeConstants[topBead];
END;
IF (k←bi.beadU)#noBead THEN BEGIN
bpk←Get[k];
IF (topBead←topBead+1) NOT IN [0..noBead) THEN ERROR;
bpt←Get[topBead];
bpt.x←bi.x+10-((bi.x+10) MOD 20);
bpt.beadL←bpt.beadR←bpt.beadT←noBead;
bpt.beadD←i;
bpt.beadU←k;
bpt.t←desP[bi.t].uwc;
bpt.external←0;
bi.beadU←bpk.beadD←topBead;
SetTypeConstants[topBead];
END;
END;

-- ///////////////

SetHeightAndWidth:PROCEDURE[i:CARDINAL]=BEGIN
bpi:BeadPtr←Get[i];
type:BeadType←bpi.t;
bpi.h←desP[type].h;
bpi.w←desP[type].w;
SELECT type FROM-- ext=0,1,or2
bf=>BEGIN
bpi.h←IF bpi.external=1 THEN 12 ELSE 8;
bpi.w←IF bpi.external=0 THEN 12 ELSE 8;
END;
bg,rb=>BEGIN
bpi.h←IF bpi.external=1 THEN 6 ELSE 8;
bpi.w←IF bpi.external=0 THEN 6 ELSE 8;
END;
ENDCASE;
END;

CorrectWireLength:PROCEDURE[i:CARDINAL]=BEGIN
bpi:BeadPtr←Get[i];
IF bpi.wire THEN BEGIN
one,other:CARDINAL;
t:INTEGER;
type:BeadType←bpi.t;
IF bpi.beadU=noBead THEN BEGIN
one←bpi.beadL;
other←bpi.beadR;
t←bpi.x←Get[one].x+Get[one].w;
bpi.w←Get[other].x-t;
END
ELSE BEGIN
one←bpi.beadD;
other←bpi.beadU;
t←bpi.y←Get[one].y+Get[one].h;
bpi.h←Get[other].y-t;
END;
END;
END;
-- ///////////////
MakeCircuits:PUBLIC PROCEDURE=BEGIN i:CARDINAL; k:INTEGER←-1;
FOR i IN [0..topBead] DO Get[i].circuit←noBead; ENDLOOP;
FOR i IN [0..topBead]
DO BEGIN foo:CARDINAL←Get[i].circuit;
IF foo=noBead THEN SetCircuit[i,k←k+1];
END;
ENDLOOP;
END;

SetCircuit:PROCEDURE[i:CARDINAL,k:INTEGER]=BEGIN
bpi:BeadPtr←Get[i];
foo:CARDINAL←bpi.circuit;
IF i=noBead OR foo#noBead THEN RETURN;
bpi.circuit←k;
SELECT bpi.t FROM tt,dd=>NULL;
ENDCASE=>BEGIN
TryCircuitH[bpi.beadL,k]; TryCircuitH[bpi.beadR,k]; END;
SELECT bpi.t FROM ttV,ddV=>NULL;
ENDCASE=>BEGIN
TryCircuitV[bpi.beadU,k]; TryCircuitV[bpi.beadD,k]; END;
SetCircuit[bpi.beadT,k];
END;

TryCircuitH:PROCEDURE[m:CARDINAL,k:INTEGER]=
BEGIN SELECT Get[m].t FROM tt,dd=>NULL; ENDCASE=>SetCircuit[m,k]; END;

TryCircuitV:PROCEDURE[m:CARDINAL,k:INTEGER]=
BEGIN SELECT Get[m].t FROM ttV,ddV=>NULL; ENDCASE=>SetCircuit[m,k]; END;

-- ///////////////


Cc:PROCEDURE[x,y:INTEGER,ic,jc:Color]=BEGIN
InsertContact[x,y,typeFromColor[ic][jc]]; END;

InsertContact:PROCEDURE[x,y:INTEGER,type:BeadType]=BEGIN i:CARDINAL;
bpi,bpt:BeadPtr;
IF type=none THEN RETURN;
IF topBead#177777B THEN FOR i IN [0..topBead] DO
bpi←Get[i];
IF Close[x,bpi.x] AND Close[y,bpi.y]
THEN BEGIN bpi.t←CombineTypes[bpi.t,type]; RETURN; END;
ENDLOOP;
topBead←topBead+1;
IF topBead>noBead THEN Error;
bpt←Get[topBead];
bpt.x←x;
bpt.y←y;
bpt.t←type;
bpt.external←0;
END;

CombineTypes:PROCEDURE[s,t:BeadType] RETURNS[BeadType]=BEGIN
s1:CARDINAL←desP[s].toCode;
t1:CARDINAL←desP[t].toCode;
IF s1>6 OR t1>6 THEN Error;
RETURN[IF s1=6 OR t1=6 THEN all ELSE TwoCodes[s1][t1]];
END;

InsertBead:PUBLIC PROCEDURE[b:Bead]=BEGIN
IF (topBead←topBead+1) NOT IN [0..noBead) THEN ERROR;
Get[topBead]↑←b;
SetTypeConstants[topBead];
END;

SetTypeConstants:PUBLIC PROCEDURE[i:CARDINAL]=BEGIN
bpi:BeadPtr←Get[i];
IF i NOT IN [0..noBead) THEN ERROR;
bpi.wire←SELECT bpi.t FROM wireG,wireR,wireB,wireO=>TRUE, ENDCASE=>FALSE;
END;

CheckBeads:PUBLIC PROCEDURE=BEGIN
i,k:CARDINAL;
FOR i IN [0..topBead] DO BEGIN
bpi:BeadPtr←Get[i];
bpk:BeadPtr;
IF (k←bpi.beadR)#noBead THEN BEGIN
bpk←Get[k];
IF bpk.beadL#i THEN Error;
IF bpi.x+bpi.w#bpk.x THEN Error;
END;
IF (k←bpi.beadU)#noBead THEN BEGIN
bpk←Get[k];
IF bpk.beadD#i THEN Error;
IF bpi.y+bpi.h#bpk.y THEN Error;
END;
END; ENDLOOP;
END;

TwoClose:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
BEGIN RETURN[Close[a,b] OR Close[a,c]]; END;

Close:PROCEDURE[a,b:INTEGER] RETURNS[BOOLEAN]=BEGIN RETURN[a=b]; END;

Within:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
BEGIN RETURN[a IN [b..c]]; END;

CloseS:PROCEDURE[a,b:INTEGER] RETURNS[BOOLEAN]=
BEGIN RETURN[a-b IN [-1..1]]; END;

WithinS:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
BEGIN RETURN[a IN [b-1..c+1]]; END;

RW:PROCEDURE RETURNS[CARDINAL]=
BEGIN right←FALSE; RETURN[inputStream.get[inputStream]]; END;

RB:PROCEDURE RETURNS[Byte]=BEGIN
IF right THEN pieces.a←pieces.b ELSE pieces←LOOPHOLE[RW[]];
right←~right; RETURN[pieces.a]; END;

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

END..