-- beadsCtl23.mesa
-- went to long pointers
-- buried contacts
-- edge to edge constraints (flying wires)

DIRECTORY IODefs:FROM"IODefs",
SystemDefs:FROM"SystemDefs",
ImageDefs:FROM"ImageDefs",
StringDefs:FROM"StringDefs",
InlineDefs:FROM"InlineDefs",
MiscDefs:FROM"MiscDefs",
StreamDefs:FROM"StreamDefs",
BeadsDefs:FROM"BeadsDefs";
BeadsCtl:PROGRAM IMPORTS ImageDefs, InlineDefs, IODefs, StringDefs, MiscDefs,
BeadsDefs, StreamDefs, SystemDefs =
BEGIN OPEN BeadsDefs;

Error:SIGNAL=CODE;

firstTime,time:LONG CARDINAL;

fileName:STRING← [50];

cleanup,showSticks,doWires,doLocal,doCompression,processedBeads,
onePass,scour,moreBelow,dMachine,drop:BOOLEAN;

bothWays,disp,printAtBeginning,printAtEnd,lookAtBelow:BOOLEAN←FALSE;
replicateH,replicateV,swivel:CARDINAL;

-- ////// CONTROL //////

--Get:PROCEDURE[i:CARDINAL]RETURNS[BeadPtr]=INLINE
--BEGIN RETURN[LOOPHOLE[bead,BeadPtr]+InlineDefs.LongMult[i,SIZE[Bead]]]; END;

Main:PROCEDURE=BEGIN s:CARDINAL;
BeadsDefs.ShowStats["Beads Program Version=",1,5];
desP←@des;
SetDesTables[];
DO
-- ///////////////GET READY/////////////
InterrogateUserForParameters[];
AllocateBelowNoodle[];
AllocateBeadTable[];
GoGetTheBeads[];
AllocateWorkTable[];
FOR s IN [0..swivel) DO Rotate[]; ENDLOOP;
Replicate[TRUE];
Replicate[FALSE];
ScavageBeads[];
IF printAtBeginning THEN PrintG[];
IF disp THEN BEGIN StartDisplay[]; InitBeadWorking[]; Display[]; END;
FindBoundingBox[];
WriteOneNumber["Starting compression: ",maxX];
IODefs.WriteNumber[maxY, [10,FALSE,TRUE,5]];
IODefs.WriteChar[CR];
-- ///////////////COMPRESS/////////////
bendingWires←FALSE;
IF doCompression THEN Squeeze[16,FALSE];
IF doCompression THEN Squeeze[16,TRUE];
IF doCompression THEN Squeeze[8,FALSE];
IF doCompression THEN Squeeze[8,TRUE];
IF doCompression OR onePass THEN Squeeze[1,FALSE];
IF doCompression OR onePass THEN Squeeze[1,TRUE];
IF doLocal THEN Local[];
IF doLocal THEN Squeeze[1,FALSE];
IF doLocal THEN Squeeze[1,TRUE];
IF doLocal THEN BEGIN CheckBeads[]; ShowTime["local time = "]; END;
bendingWires←TRUE;
IF doWires THEN Squeeze[1,FALSE];
IF drop THEN Drop[FALSE];
IF doWires AND bothWays THEN Squeeze[1,TRUE];
IF drop THEN Drop[TRUE];
-- ///////////////TIDY UP/////////////
FullTest[];
TidyUp[];
IF printAtEnd THEN PrintG[];
IF disp AND BeadsDefs.ManipulateDisplay[] THEN PrintG[];
IF AskUser["Do you want to write out a file? "] THEN WriteOutBeads[];
IF ~dMachine THEN SystemDefs.FreeSegment[InlineDefs.LowHalf[bead]];
FreeBelowNoodle[];
ENDLOOP;
END;

Drop:PROCEDURE[rot:BOOLEAN]=BEGIN
timeV5←timeV6←0;
time←MiscDefs.CurrentTime[];
IF rot THEN BeadsDefs.Reflect[];
FindBoundingBox[];
InitBeadWorking[];
SortOnY[];
ShowTime["init time = "];
MakeBelow[];
ShowTime["below time = "];
PrintSomeBelowStuff[];
Clean[];
ShowTime["drop time = "];
-- IF scour THEN ScourBeads[];
TurnWiresToBeads[];
ScavageBeads[];
ShowTime["cleanup time = "];
IF rot THEN BeadsDefs.Reflect[];
FindBoundingBox[];
IF disp THEN Display[];
WriteOneNumber["Dropped: ",0];
END;

Squeeze:PROCEDURE[howMuch:CARDINAL,rot:BOOLEAN]=BEGIN
timeV5←timeV6←0;
time←MiscDefs.CurrentTime[];
IF rot THEN BeadsDefs.Reflect[];
FindBoundingBox[];
InitBeadWorking[];
SortOnY[];
ShowTime["init time = "];
MakeBelow[];
ShowTime["below time = "];
PrintSomeBelowStuff[];
PutTheBeadsWhereTheyBelong[bendingWires,howMuch];
ShowTime["position time = "];
IF cleanup THEN CleanUp[];
IF scour THEN ScourBeads[];
TurnWiresToBeads[];
ScavageBeads[];
ShowTime["cleanup time = "];
IF rot THEN BeadsDefs.Reflect[];
FindBoundingBox[];
IF disp THEN Display[];
IF rot THEN WriteOneNumber[" New X: ",maxX]
ELSE WriteOneNumber[" New Y: ",maxY];
WriteOneNumber["Squeezed: ",howMuch];
END;

PrintSomeBelowStuff:PROCEDURE=BEGIN
IF lookAtBelow THEN ShowBelow[];
IODefs.WriteChar[CR];
IODefs.WriteString["Below Counts "];
PrintLong[timeV6];
PrintLong[timeV5];
END;

TidyUp:PROCEDURE=BEGIN
PrintBeads[];
IF ~dMachine THEN SystemDefs.FreeSegment[InlineDefs.LowHalf[work]];
time←firstTime;
ShowTime["total time = "];
WriteOneNumber["final number of beads= ",topBead];
MeasureWires[];
WriteOneNumber["worst size of Below Table= ",worstBelow];
END;

MeasureWires:PROCEDURE=BEGIN countT,countW,lengthW:INTEGER←0;
MeasureWire:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
IF bpi.wire THEN BEGIN
countW←countW+1;
lengthW←lengthW+(IF bpi.beadU=noBead THEN bpi.w ELSE bpi.h);
END;
SELECT bpi.t FROM tt,ttV,dd,ddV=>countT←countT+1; ENDCASE;
END;
EnumerateBeads[MeasureWire];
WriteOneNumber["number of wires= ",countW];
WriteOneNumber["total length of wires= ",lengthW];
WriteOneNumber["number of transistors= ",countT];
END;

AllocateBelowNoodle:PROCEDURE=BEGIN OPEN SystemDefs;
AllocateBelow[];
noodleChain←AllocateSegment[topNoodle+1];
noodleDX←AllocateSegment[topNoodle+1];
noodleDY←AllocateSegment[topNoodle+1];
END;

FreeBelowNoodle:PROCEDURE=BEGIN OPEN SystemDefs;
FreeBelow[];
FreeSegment[noodleChain];
FreeSegment[noodleDX];
FreeSegment[noodleDY];
END;

InterrogateUserForParameters:PROCEDURE=BEGIN
DO
IODefs.WriteChar[CR];
replicateH←replicateV←1;
bothWays←fallBack←disp←debugBeads←lookAtBelow←showSticks
←printAtBeginning← getWhatYouSee ←FALSE;
scour←moreBelow←TRUE;
swivel←worstBelow←0;
trackBead←177777B;
AskForFileName["input file name= "];
IF fileName.length=0 THEN ImageDefs.StopMesa[];
processedBeads← AskUser["Is your input preprocessed? "];
dMachine←AskUser["Are you using a d machine’s extra memory? "];
noBead←IF dMachine THEN 8000
ELSE AskUserSize["Is your input small, medium, or large (s,m,or l)? "];
IF AskUser["Do you want debugging aids? "] THEN BEGIN
getWhatYouSee← AskUser["Do you want to turn on getWhatYouSee? "];
scour← ~AskUser["Do you want to turn off Scour beads? "];
showSticks← AskUser["Do you want me to print the sticks? "];
debugBeads← AskUser["Do you want me to print the beads? "];
lookAtBelow← AskUser["Do you want to see BELOW? "];
--moreBelow← AskUser["Do you want More Below? "];
IF AskUser["Do you want to track a beads? "]
THEN BEGIN
IODefs.WriteChar[CR];
IODefs.WriteString[" which bead? "];
trackBead ← IODefs.ReadDecimal[];
END;
END;
IF AskUser["Do you want Standard Processing? "] THEN BEGIN
doCompression←~processedBeads;
fallBack←cleanup←doWires←bothWays←drop←TRUE;
onePass← doLocal←FALSE; END
ELSE BEGIN
UNTIL ~AskUser["Rotate the whole picture 90 degrees? "]
DO swivel←swivel+1; ENDLOOP;
IF AskUser["do you want replication? "] THEN BEGIN
UNTIL ~AskUser["horizontal? "] DO replicateH←replicateH+1; ENDLOOP;
UNTIL ~AskUser["vertical? "] DO replicateV←replicateV+1; ENDLOOP;
END;
doCompression← ~processedBeads AND
AskUser["do you want standard compression? "];
onePass← ~doCompression AND AskUser["do you want one pass compression? "];
cleanup← AskUser["Do you want cleanup? "];
doWires← AskUser["Do you want to bend wires? "];
bothWays← doWires AND AskUser["Both Ways? "];
fallBack← doWires AND AskUser["Do you want fallback? "];
drop← AskUser["Do you want capicitance reduction(Drop)? "];
doLocal← AskUser["Do you want local transformations? "];
END;
IF ~AskUser["Do you want to change your mind? "] THEN EXIT;
ENDLOOP;
printAtEnd← noBead> 700 AND ~dMachine;
smallDisplay← noBead> 300 AND ~dMachine;
disp← (~printAtBeginning AND ~printAtEnd) OR dMachine;
noBelow← IF dMachine THEN 32000 ELSE 3000;
END;

GoGetTheBeads:PROCEDURE=BEGIN i:CARDINAL; bpi:BeadPtr;
firstTime←time←MiscDefs.CurrentTime[];
IF processedBeads THEN ReadInBeads[]
ELSE BeadsDefs.FromInputToBeads[fileName,FALSE];
FOR i IN [0..topBead] DO bpi←Get[i];
IF bpi.t=jctnG THEN
BEGIN IF noBead#bpi.beadT THEN Error ELSE EXIT; END;
ENDLOOP;
WriteOneNumber["number of beads= ",topBead];
ShowTime["readin time = "];
PrintBeads[];
-- BeadsDefs.PrintDes[@Des4,@Des5,@Des6];
BeadsDefs.CheckBeads[];
END;

Replicate:PROCEDURE[hor:BOOLEAN]= BEGIN
r:CARDINAL; --the number of replications
s:CARDINAL; --the number of beads being replicated = topBead+1
i:CARDINAL; --a loop index
bpi,bpiT:BeadPtr;
r←IF hor THEN replicateH ELSE replicateV;
IF r=1 THEN RETURN;
UNTIL (r←r-1)=0 DO
s←topBead+1;
IF s+s-1>=noBead THEN Error;
FindBoundingBox[];
FOR i IN [0..topBead] DO
bpi←Get[i];
bpiT←Get[s+i];
bpiT↑←bpi↑;
IF bpiT.beadR#noBead THEN bpiT.beadR←bpiT.beadR+s;
IF bpiT.beadL#noBead THEN bpiT.beadL←bpiT.beadL+s;
IF bpiT.beadU#noBead THEN bpiT.beadU←bpiT.beadU+s;
IF bpiT.beadD#noBead THEN bpiT.beadD←bpiT.beadD+s;
IF bpiT.beadT#noBead THEN bpiT.beadT←bpiT.beadT+s;
IF hor THEN bpiT.x←bpiT.x+maxX ELSE bpiT.y←bpiT.y+maxY;
ENDLOOP;
FOR i IN [0..topBead] DO
bpiT←Get[s+i];
IF hor AND bpiT.beadR#noBead
THEN SELECT bpiT.t FROM endG,endB,endR=>SearchH[bpiT]; ENDCASE;
IF ~hor AND bpiT.beadU#noBead
THEN SELECT bpiT.t FROM endG,endB,endR=>SearchV[bpiT]; ENDCASE;
ENDLOOP;
topBead←s+s-1;
FixWires[];
ENDLOOP;
MakeCircuits[];
END;

SearchH:PROCEDURE[bpi:BeadPtr]=BEGIN j:CARDINAL;
FOR j IN [0..topBead] DO BEGIN
bpj:BeadPtr←Get[j];
IF bpj.y=bpi.y AND bpj.t=bpi.t AND bpj.beadL#noBead THEN BEGIN
left:CARDINAL←bpj.beadL; bpl:BeadPtr←Get[left];
wireRight:CARDINAL←bpi.beadR; bpwr:BeadPtr←Get[wireRight];
right:CARDINAL←bpwr.beadR; bpr:BeadPtr←Get[right];
IF left>=noBead OR right>=noBead OR wireRight>=noBead THEN Error;
bpl.beadR←right;
bpr.beadL←left;
bpj.t←bpi.t←bpwr.t←none;
RETURN;
END;
END; ENDLOOP;
Error;
END;

SearchV:PROCEDURE[bpi:BeadPtr]=BEGIN j:CARDINAL;
FOR j IN [0..topBead] DO BEGIN
bpj:BeadPtr←Get[j];
IF bpj.x=bpi.x AND bpj.t=bpi.t AND bpj.beadD#noBead THEN BEGIN
down:CARDINAL←bpj.beadD; bpd:BeadPtr←Get[down];
wireUp:CARDINAL←bpi.beadU; bpwu:BeadPtr←Get[wireUp];
up:CARDINAL←bpwu.beadU; bpu:BeadPtr←Get[up];
IF down>=noBead OR up>=noBead OR wireUp>=noBead THEN Error;
bpd.beadU←up;
bpu.beadD←down;
bpj.t←bpi.t←bpwu.t←none;
RETURN;
END;
END; ENDLOOP;
Error;
END;

AskUser:PROCEDURE[s:STRING] RETURNS[BOOLEAN]=
BEGIN RETURN[GetFirstChar[s]=’y]; END;

AskUserSize:PROCEDURE[s:STRING] RETURNS[CARDINAL]= BEGIN
RETURN[SELECT GetFirstChar[s] FROM ’l=>900, ’m=>700, ENDCASE=>300];
END;

GetFirstChar:PROCEDURE[s:STRING] RETURNS[char:CHARACTER]= BEGIN OPEN IODefs;
WriteChar[CR]; WriteString[s]; WriteChar[char←ReadChar[]]; END;

ReadInBeads:PROCEDURE= BEGIN
OPEN StreamDefs;
inputStream:DiskHandle;
StringDefs.AppendString[fileName,".bead"];
inputStream← NewWordStream[fileName,Read];
fileName.length←fileName.length-5;
inputStream.reset[inputStream];
topBead← ReadBlock[inputStream,InlineDefs.LowHalf[bead],noBead*16]/16- 1;
inputStream.destroy[inputStream];
InitBeadWorking[];
END;

WriteOutBeads:PROCEDURE= BEGIN
OPEN StreamDefs;
outputStream:DiskHandle;
AskForFileName[" output file name= "];
StringDefs.AppendString[fileName,".bead"];
outputStream← NewWordStream[fileName,Write+Append];
outputStream.reset[outputStream];
[]← WriteBlock[outputStream,InlineDefs.LowHalf[bead],(topBead+1)*16];
outputStream.destroy[outputStream];
END;

AskForFileName:PROCEDURE[s:STRING]= BEGIN
OPEN IODefs; i:CARDINAL;
WriteChar[CR];
WriteString[s];
ReadID[fileName !Rubout=>RETRY];
FOR i IN [0..fileName.length) DO
IF fileName[i]=’. THEN BEGIN fileName.length←i; EXIT; END;
ENDLOOP;
END;

PrintG:PROCEDURE=BEGIN
FreeBelowNoodle[];
StringDefs.AppendString[fileName,".press"];
BeadsDefs.PrintGeometry[fileName];
fileName.length←fileName.length-6;
AllocateBelowNoodle[];
END;

PrintB:PROCEDURE=BEGIN t:BOOLEAN←debugBeads; debugBeads←TRUE;
PrintBeads[]; debugBeads←t; END;

ShowTime:PROCEDURE[s:STRING]= BEGIN
oldTime:LONG CARDINAL←time;
time←MiscDefs.CurrentTime[];
WriteOneNumber[s,InlineDefs.LowHalf[time-oldTime]];
END;

-- ////// INITIALIZATION //////

AllocateBeadTable:PROCEDURE=BEGIN i:CARDINAL; bpi:BeadPtr;
topBead←177777B;
IF dMachine THEN bead←LOOPHOLE[1000000B]
ELSE bead←SystemDefs.AllocateSegment[SIZE[Bead]*noBead];
FOR i IN [0..noBead] DO
bpi←Get[i];
bpi.beadU←bpi.beadD←bpi.beadL←bpi.beadR←bpi.beadT←noBead;
ENDLOOP;
END;

AllocateWorkTable:PROCEDURE=BEGIN
IF dMachine THEN work←LOOPHOLE[1400000B]
ELSE work←SystemDefs.AllocateSegment[SIZE[Work]*noBead];
IF ~dMachine THEN MiscDefs.Zero[InlineDefs.LowHalf[work],SIZE[Work]*noBead];
END;

InitBeadWorking:PROCEDURE=INLINE BEGIN EnumerateBeads[InitBeadWork]; END;

SortOnY:PROCEDURE=BEGIN i,j,si,sj:CARDINAL; yi,yj:INTEGER; bpsi,bpsj:BeadPtr;
wpi,wpj:WorkPtr;
FOR i IN [0..topBead) DO
wpi←GetW[i]; si←wpi.sort; bpsi←Get[si]; yi←bpsi.y;
FOR j IN (i..topBead] DO
wpj←GetW[j]; sj←wpj.sort; bpsj←Get[sj]; yj←bpsj.y;
IF yj>yi THEN BEGIN wpj.sort←si; si←wpi.sort←sj; yi←yj; END;
ENDLOOP;
ENDLOOP;
END;


-- //////Des TABLES //////
--DesRec:TYPE=REC[level,short,h:INTEGER,print:CHARACTER,toCode:INTEGER,etc
des:ARRAY BeadType OF DesRec←[
--none:-- [4,0,00,’N,7],
--all:-- [4,0,08,’A,6],
--rg:-- [4,0,08,’R,5],
--rb:-- [1,5,08,’B,3],
--bg:-- [0,6,08,’G,4],
--tt:-- [1,1,04,’t,7],
--dd:-- [1,3,04,’d,7],
--ttV:-- [1,2,04,’T,7],
--ddV:-- [1,4,16,’D,7],
--end:-- [0,6,04,’E,7],
--endR:-- [1,5,04,’E,7],
--endB:-- [2,7,06,’E,7],
--stub:-- [4,0,00,’S,7],
--jctn:-- [0,6,04,’g,0],
--jctnR:--[1,5,04,’r,1],
--jctnB:--[2,7,06,’b,2],
--bf:-- [2,7,08,’F,7],
--wireG:--[0,6,04,’W,7],
--wireR:--[1,5,04,’w,7],
--wireB:--[2,7,06,’W,7],
--wireO:--[3,5,04,’O,8],
--of:-- [3,5,04,’o,8]
];

--BeadType:TYPE=;
--des[object].toWire is the distance from a green wire to the object;
--des[object].h is the height of the object;
--des[object].w is the width of the object;
--des[object].wsR is the width of a horr wire coming out to the right of i
--des[object].wsU is the width of a vert wire coming up out of i
--short={empty,transH,transV,depH,depV,jctnR,jctnG,jctnB,contact}
--Des4[i,j] is the vert spacing of i above j off wire;
--Des5[i,j] is the vert spacing of i above j on wire;
--Des6[i,j] is the horr spacing of i to the right of j off wire;

LevelRec:TYPE=RECORD[toWire,toWireR,ws,lessLevel,bitPerLevel:INTEGER,
blueOnly,rgOnly,rg:BOOLEAN,color:Color,rwc:BeadType];

LevelTable:ARRAY[0..5) OF LevelRec←[
[6,2,4,1,1,FALSE, TRUE, TRUE,g,wireG],
[2,4,4,1,2,FALSE, TRUE,FALSE,r,wireR],
[6,0,6,2,4, TRUE,FALSE, TRUE,b,wireB],
[4,4,4,3,5,FALSE,FALSE,FALSE,o,wireO],
[0,0,0,4,0,FALSE,FALSE,FALSE,none,none]];

SetDesTables:PROCEDURE=BEGIN-- zeros all mean never used
i,j:CARDINAL; b,r:BeadType; l:INTEGER;
FOR b IN BeadType DO
l←des[b].level;
des[b].rotate←b;
des[b].stickOutToRight←0;
des[b].trueIfTrans←FALSE;
des[b].toWire←LevelTable[l].toWire;
des[b].toWireR←LevelTable[l].toWireR;
des[b].wsR←des[b].wsU←LevelTable[l].ws;
des[b].lessLevel←LevelTable[l].lessLevel;
des[b].bitPerLevel←LevelTable[l].bitPerLevel;
des[b].color←LevelTable[l].color;
des[b].rwc←LevelTable[l].rwc;
ENDLOOP;
des[ttV].stickOutToRight←3; des[ddV].stickOutToRight←2;
des[tt].rwc←des[dd].rwc←wireG;
des[tt].rg←des[dd].rg←TRUE;
des[tt].rotate←ttV; des[dd].rotate←ddV;
des[ttV].rotate←tt; des[ddV].rotate←dd;
des[tt].trueIfTrans←des[dd].trueIfTrans
←des[ttV].trueIfTrans←des[ddV].trueIfTrans←TRUE;
des[tt].bitPerLevel←1; des[dd].bitPerLevel←1;
FOR b IN BeadType DO
r←des[b].rotate;
des[b].w←des[r].h;
des[b].ug←des[r].rg;
des[b].bitPerLevelV←des[r].bitPerLevel;
des[b].uwc←des[r].rwc;
ENDLOOP;
Des4←[
[ 0, 0, 0, 0, 0, 0, 0, 0],
[ 0,10, 7, 9, 7, 7, 5, 0],
[ 0, 7, 4, 6, 4, 4, 2, 0],
[ 0, 9, 6, 8, 6, 6, 4, 0],
[ 0, 7, 4, 6, 4, 4, 2, 0],
[ 0, 7, 4, 6, 4, 4, 2, 0],
[ 0, 5, 2, 4, 2, 2, 6, 0],
[ 0, 0, 0, 0, 0, 0, 0, 6]];
Des5←[
[ 0, 0, 0, 0, 0, 0, 0, 0],
[ 0, 4, 4, 4, 4, 2, 2, 0],-- this is probably wrong
[ 0, 4, 4, 4, 4, 2, 2, 0],
[ 0, 4, 4, 4, 4, 2, 2, 0],
[ 0, 4, 4, 4, 4, 2, 2, 0],
[ 0, 2, 2, 2, 2,-4, 2, 0],
[ 0, 2, 2, 2, 2, 2,-4, 0],
[ 0, 0, 0, 0, 0, 0, 0,-6]];
FOR i IN [0..7] DO FOR j IN [0..7] DO
Des6[i][j]← Des4[Transpose[i]][Transpose[j]];
Des7[i][j]← Des5[Transpose[i]][Transpose[j]];
ENDLOOP; ENDLOOP;
END;

Transpose:PROCEDURE[i:CARDINAL] RETURNS[CARDINAL]= INLINE BEGIN
RETURN[SELECT i FROM 1 =>2, 2 =>1, 3 =>4, 4 =>3, ENDCASE =>i];
END;

Main[];

END..