-- beadsCreate.mesa

-- dd etc
-- two backfacing transistors!

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

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;

Stick:TYPE=RECORD[dir:Direction,color:Color,x,y,end:INTEGER];
maxStick:CARDINAL=300;
StickStuff:TYPE=ARRAY [0..maxStick] OF Stick;
StkPtr:TYPE=POINTER TO Stick;

stks: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;

pr,disp:BOOLEAN;


FromInputToBeads:PUBLIC PROCEDURE[fileName:STRING,print:BOOLEAN]=BEGIN
pr←print; disp←FALSE;
stks←SystemDefs.AllocateSegment[SIZE[StickStuff]];
StringDefs.AppendString[fileName,".stick"];
FromSilFileToSticks[fileName];
fileName.length←fileName.length-6;
xLo←yLo←10000; xHi←yHi←0;
EnumerateSticks[t,FindBoundsOfDiagram];
IF getWhatYouSee THEN EnumerateSticks[t,WhatYouSeeIsWhatYouGet];
IF getWhatYouSee THEN EliminateNulls[];
EnumerateSticks[t,MakeCloseTeeJctnsTouch];
CompressStickCoordinates[];
EnumerateSticks[t,PutTeeJctnsInBeadTable];
EnumerateSticks[t,PutCrossingsInBeadTable];
EnumerateSticks[t,YellowToRed];
EnumerateBeads[t,ConvertMultipleLevelsToTiedBeads];
EnumerateBeads[f,DoesBeadHaveNeighbors];
EnumerateBeads[t,RecordBeadsNeighbors];
EnumerateBeads[t,StickToBeadCoordinates];
EnumerateBeads[t,WiggleTiedBeadsUpAndDown];
EnumerateBeads[f,ClearWire];
EnumerateBeads[t,AddWires];
EnumerateBeads[f,SetHeightAndWidth];
EnumerateBeads[t,FixWire];
MakeCircuits[];
EnumerateBeads[f,SetTypeConstants];
SystemDefs.FreeSegment[stks];
WriteOneNumber["size of stick table= ",topStick+1];
END;

PMode:TYPE={t,f,s,b,n};

EnumerateSticks:PROCEDURE[m:PMode,call:PROCEDURE[CARDINAL]]=BEGIN
FOR j:CARDINAL IN [0..topStick]
DO IF stks[j].color#none THEN call[j]; ENDLOOP;
IF m=t THEN Show[s];
END;

EnumStksWhichMightTouch:PROCEDURE[i:CARDINAL,call:PROCEDURE[CARDINAL,StkPtr]]=
BEGIN
FOR j:CARDINAL IN [0..topStick]
DO s:StkPtr←@stks[j]; IF s.color#none AND i#j THEN call[j,s]; ENDLOOP;
END;

EnumerateBeads:PROCEDURE[m:PMode,call:PROCEDURE[Desc]]=BEGIN
BeadsDefs.EnumerateBeads[call]; IF m=t THEN Show[b]; END;

YellowToRed:PROCEDURE[i:CARDINAL]={IF stks[i].color=y THEN stks[i].color←r};
ClearWire:PROCEDURE[i:Desc]=BEGIN i.p.wire←FALSE; END;

Show:PROCEDURE[mode:PMode]=BEGIN
IF pr THEN SELECT mode FROM
s=>PrintAllSticks[topStick];
b=>PrintBeads[];
n,f=>NULL;
ENDCASE=>Error;
IF disp THEN SELECT mode FROM
s=>DisplayAllSticks[stks,topStick];
b=>DisplayBeads[];
n,f=>NULL;
ENDCASE=>Error;
END;

DisplayBeads:PROCEDURE=BEGIN END;
DisplayAllSticks:PROCEDURE[s:POINTER TO StickStuff,i:CARDINAL]=BEGIN 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;
stks[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;
-- ///////////////
FindBoundsOfDiagram:PROCEDURE[i:CARDINAL]=BEGIN
is:Stick←stks[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;

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←stks[i];
j:CARDINAL; js:Stick;
IF is.dir=h THEN FOR j IN (i..topStick] DO
js←stks[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];
stks[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 => stks[i].color←none;
js.x>=is.x AND js.end<=is.end => stks[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←stks[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];
stks[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 => stks[i].color←none;
js.y>=is.y AND js.end<=is.end => stks[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 stks[i].color=none
THEN stks[i]←stks[(topStick←topStick-1)+1] ELSE i←i+1;
ENDLOOP;
END;
-- ///////////////
MakeCloseTeeJctnsTouch:PROCEDURE[i:CARDINAL]=BEGIN
is:Stick←stks[i];
lim:INTEGER←IF is.dir=h THEN xHi ELSE yHi;
IF Close[is.x,xLo] THEN is.x←xLo;
IF Close[is.y,yLo] THEN is.y←yLo;
IF CloseS[is.end,lim] THEN is.end←lim;
FOR j:CARDINAL IN [0..topStick] DO IF i#j THEN BEGIN
js:Stick←stks[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;
stks[i]←is;
END;
-- ///////////////
CompressStickCoordinates:PROCEDURE=BEGIN
CompressX:PROCEDURE[i:CARDINAL]=BEGIN
psi:StkPtr←@stks[i];
IF psi.x=c THEN {psi.x←s; ad←1;} ;
IF psi.end=c AND psi.dir=h THEN {psi.end←s; ad←1};
END;
CompressY:PROCEDURE[i:CARDINAL]=BEGIN
psi:StkPtr←@stks[i];
IF psi.y=c THEN BEGIN psi.y←s; ad←1; END;
IF psi.end=c AND psi.dir=v THEN {psi.end←s; ad←1;};
END;
s,ad,c:INTEGER;
s←0;
FOR c IN [xLo..xHi] DO
ad←IF c=xLo OR c=xHi THEN 1 ELSE 0;
EnumerateSticks[f,CompressX];
s←s+ad;
ENDLOOP;
xLo←0; xHi←s-1;
s←0;
FOR c IN [yLo..yHi] DO
ad←IF c=yLo OR c=yHi THEN 1 ELSE 0;
EnumerateSticks[f,CompressY];
s←s+ad;
ENDLOOP;
yLo←0; yHi←s-1;
Show[s];
END;

-- ///////////////
PutTeeJctnsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN is:Stick←stks[i];
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
SeeIfOneButs:PROCEDURE[j:CARDINAL,js:StkPtr]=BEGIN
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;
ic:Color←stks[i].color;
IF Close[x,xHi] OR Close[x,xLo] OR Close[y,yHi] OR Close[y,yLo]
THEN Cc[x,y,none,ic];
EnumStksWhichMightTouch[i,SeeIfOneButs];
END;
-- ///////////////
PutCrossingsInBeadTable:PROCEDURE[i:CARDINAL]=BEGIN
SeeIfOneCrosses:PROCEDURE[j:CARDINAL,js:StkPtr]=BEGIN
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;
is:Stick←stks[i];
EnumStksWhichMightTouch[i,SeeIfOneCrosses];
END;
-- ///////////////
ConvertMultipleLevelsToTiedBeads:PROCEDURE[i:Desc]= BEGIN
SELECT i.p.t FROM
rg,all=>BEGIN
a:Desc←InsertBead[i.p↑];
b:Desc←InsertBead[i.p↑];
a.p.t←rb; a.p.beadT←b.z;
b.p.t←bf; b.p.beadT←i.z;
i.p.t←bg; i.p.beadT←a.z;
END;
rb,bg=>BEGIN
a:Desc←InsertBead[i.p↑];
a.p.t←bf; a.p.beadT←i.z;
i.p.beadT←a.z;
i.p.external←a.p.external←2;
END;
ENDCASE;
END;
-- ///////////////
DoesBeadHaveNeighbors:PROCEDURE[i:Desc]=BEGIN
i.p.beadR←i.p.beadL←i.p.beadU←i.p.beadD←noBead;
FOR j:CARDINAL IN [0..topStick] DO js:Stick←stks[j];
IF SELECT js.color FROM
r,y=>SELECT i.p.t FROM all,jctnR,rg,rb,tt,ttV,dd,ddV,endR=>TRUE,
ENDCASE=>FALSE,
g=> SELECT i.p.t FROM all,jctnG,rg,bg,tt,ttV,dd,ddV,endG=>TRUE,
ENDCASE=>FALSE,
b=> SELECT i.p.t FROM all,jctnB,endB,bf=>TRUE, ENDCASE=>FALSE,
ENDCASE=>FALSE THEN BEGIN
IF js.dir=h AND Bot[i]=js.y THEN BEGIN
IF Lfm[i] IN [js.x..js.end) THEN i.p.beadR←someBead;
IF Lfm[i] IN (js.x..js.end] THEN i.p.beadL←someBead;
END;
IF js.dir=v AND Lfm[i]=js.x THEN BEGIN
IF Bot[i] IN [js.y..js.end) THEN i.p.beadU←someBead;
IF Bot[i] IN (js.y..js.end] THEN i.p.beadD←someBead;
END;
END;
ENDLOOP;
END;
-- ///////////////
RecordBeadsNeighbors:PROCEDURE[i:Desc]=BEGIN
Find:PROCEDURE[q:CARDINAL] RETURNS[aBead:CARDINAL]=BEGIN
NoName:PROCEDURE[j:Desc]=BEGIN
ay:INTEGER←IF q<2 THEN Bot[j] ELSE Lfm[j];
by:INTEGER←IF q<2 THEN Bot[i] ELSE Lfm[i];
sameX:BOOLEAN←IF q<2 THEN Lfm[j]=Lfm[i] ELSE Bot[j]=Bot[i];
IF sameX
AND (IF min THEN ay IN (by..ext] ELSE ay IN [ext..by))
AND (IF q<2 THEN desP[i.p.t].bitPerLevelV=desP[j.p.t].bitPerLevelV
ELSE desP[i.p.t].bitPerLevel =desP[j.p.t].bitPerLevel)
THEN BEGIN ext←ay; aBead←j.z; END;
END;
min:BOOLEAN←q=0 OR q=2;
ext:INTEGER←IF min THEN 10000 ELSE 0;
aBead←noBead;
BeadsDefs.EnumerateBeads[NoName];
BEGIN
a:Desc←GetDesc[aBead];
IF noBead=(SELECT q FROM 0=>a.p.beadD, 1=>a.p.beadU,
2=>a.p.beadL, ENDCASE=>a.p.beadR)
THEN aBead←noBead;
END; END;
IF i.p.beadU=someBead THEN i.p.beadU←Find[0];
IF i.p.beadD=someBead THEN i.p.beadD←Find[1];
IF i.p.beadR=someBead THEN i.p.beadR←Find[2];
IF i.p.beadL=someBead THEN i.p.beadL←Find[3];
END;
-- ///////////////
StickToBeadCoordinates:PROCEDURE[i:Desc]=BEGIN
m:CARDINAL←Lfm[i]; n:CARDINAL←Bot[i];
i.p.x←m*stickScaling; i.p.y←n*stickScaling;
END;
-- ///////////////
WiggleTiedBeadsUpAndDown:PROCEDURE[i:Desc]= BEGIN
New:TYPE=RECORD[rx,ry,gx,gy,bx,by:INTEGER];
IF i.p.t=bg AND Get[i.p.beadT].t=rb THEN BEGIN
g:Desc←i;
r:Desc←GetDesc[i.p.beadT];
b:Desc←GetDesc[r.p.beadT];
IF b.p.t#bf OR b.p.beadT#g.z THEN Error;
BEGIN
lc:Color←IF ~NoBeadL[g] THEN g ELSE IF NoBeadL[r] THEN none ELSE r;
rc:Color←IF ~NoBeadR[g] THEN g ELSE IF NoBeadR[r] THEN none ELSE r;
uc:Color←IF ~NoBeadU[g] THEN g ELSE IF NoBeadU[r] THEN none ELSE r;
dc:Color←IF ~NoBeadD[g] THEN g ELSE IF NoBeadD[r] THEN none ELSE r;
new:New;
IF ~NoBeadL[r] AND ~NoBeadL[g] THEN IllegalInput;
IF ~NoBeadR[r] AND ~NoBeadR[g] THEN IllegalInput;
IF ~NoBeadU[r] AND ~NoBeadU[g] THEN IllegalInput;
IF ~NoBeadD[r] AND ~NoBeadD[g] 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];
r.p.x←r.p.x+new.rx;
g.p.x←g.p.x+new.gx;
b.p.x←b.p.x+new.bx;
r.p.y←r.p.y+new.ry;
g.p.y←g.p.y+new.gy;
b.p.y←b.p.y+new.by;
r.p.external← --1 means 6hx8w--
g.p.external← --1 means 6hx8w--
b.p.external←IF new.ry#0 OR new.gy#0 THEN 1 ELSE 0;
--1 means 12hx8w--
END;
END;
END;
-- ///////////////
AddWires:PROCEDURE[i:Desc]=BEGIN
IF ~NoBeadR[i] THEN BEGIN
k:Desc←GetDesc[i.p.beadR];
t:Desc←GetFreeBead[];
t.p.y←i.p.y+10-((i.p.y+10) MOD 20);
t.p.beadL←i.z;
t.p.beadR←k.z;
t.p.t←desP[i.p.t].rwc;
i.p.beadR←k.p.beadL←topBead;
SetTypeConstants[t];
END;
IF ~NoBeadU[i] THEN BEGIN
k:Desc←GetDesc[i.p.beadU];
t:Desc←GetFreeBead[];
t.p.x←i.p.x+10-((i.p.x+10) MOD 20);
t.p.beadD←i.z;
t.p.beadU←k.z;
t.p.t←desP[i.p.t].uwc;
i.p.beadU←k.p.beadD←topBead;
SetTypeConstants[t];
END;
END;

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

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

-- ///////////////
MakeCircuits:PUBLIC PROCEDURE=
BEGIN cNo←0; EnumerateBeads[f,ClearCircuit]; EnumerateBeads[f,MakeCir]; END;

cNo:INTEGER;

ClearCircuit:PROCEDURE[i:Desc]=
BEGIN i.p.circuit←IF Type[i]=wireO OR Type[i]=EndO THEN 0 ELSE noBead; END;

MakeCir:PROCEDURE[i:Desc]=
BEGIN IF i.p.circuit=LOOPHOLE[noBead] THEN SetCircuit[i,cNo←cNo+1]; END;

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

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

TryCircuitV:PROCEDURE[mm:CARDINAL,k:INTEGER]= BEGIN
m:Desc←GetDesc[mm];
SELECT m.p.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
IF type=none THEN RETURN;
IF topBead#177777B THEN FOR ii:CARDINAL IN [0..topBead] DO
i:Desc←GetDesc[ii];
IF Close[x,Lfm[i]] AND Close[y,Bot[i]]
THEN BEGIN i.p.t←CombineTypes[i.p.t,type]; RETURN; END;
ENDLOOP;
BEGIN
t:Desc←GetFreeBead[];
t.p.x←x; t.p.y←y; t.p.t←type;
END; 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] RETURNS[t:Desc]=
BEGIN t←GetFreeBead[]; t.p↑←b; SetTypeConstants[t]; END;

SetTypeConstants:PROCEDURE[i:Desc]=
BEGIN IF i.z NOT IN [0..noBead) THEN ERROR ELSE i.p.wire←Wire[i]; END;

CheckBeads:PUBLIC PROCEDURE=BEGIN BeadsDefs.EnumerateBeads[CheckBead]; END;

CheckBead:PROCEDURE[i:Desc]=BEGIN
IF ~NoBeadR[i] THEN BEGIN
k:Desc←GetDesc[i.p.beadR];
IF k.p.beadL#i.z THEN Error;
IF Rtm[i]#Lfm[k] THEN Error;
END;
IF ~NoBeadU[i] THEN BEGIN
k:Desc←GetDesc[i.p.beadU];
IF k.p.beadD#i.z THEN Error;
IF Top[i]#Bot[k] THEN Error;
END;
END;

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

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

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

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

WithinS:PROCEDURE[a,b,c:INTEGER] RETURNS[BOOLEAN]=
INLINE 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;

PrintAllSticks:PROCEDURE[top:CARDINAL]=
BEGIN OPEN IODefs;
WriteChar[CR];
FOR i:CARDINAL IN [0..top] DO
a:Stick←stks[i];
WriteChar[CR];
WriteNumber[i,[10,FALSE,TRUE,3]];
WriteString[SELECT a.dir FROM v=>" vert ", ENDCASE=>" horr "];
WriteString[SELECT a.color FROM
r=>" red", g=>"green", b=>" blue", ENDCASE=>"error"];
WriteNumber[a.x, [10,FALSE,TRUE,5]];
WriteNumber[a.y, [10,FALSE,TRUE,5]];
WriteNumber[a.end,[10,FALSE,TRUE,5]];
ENDLOOP;
END;--print sticks

END..