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

DIRECTORY IODefs:FROM"IODefs",
SystemDefs:FROM"SystemDefs",
CedarLists: FROM "CedarLists",
CedarAtoms: FROM "CedarAtoms",
DisplayWorld: FROM "DisplayWorld",
CedarDocuments: FROM "CedarDocuments",
CedarIO:FROM"CedarIO",
BeadsInlines:FROM"BeadsInlines",
ImageDefs:FROM"ImageDefs",
StringDefs:FROM"StringDefs",
InlineDefs:FROM"InlineDefs",
MiscDefs:FROM"MiscDefs",
StreamDefs:FROM"StreamDefs",
BeadsDefs:FROM"BeadsDefs";
BeadsUser:PROGRAM IMPORTS CedarLists, CedarAtoms, CedarDocuments, DisplayWorld, CedarIO, BeadsInlines, ImageDefs, InlineDefs, IODefs, StringDefs, MiscDefs,
BeadsDefs, StreamDefs, SystemDefs
EXPORTS BeadsDefs =
BEGIN OPEN BeadsDefs, BeadsInlines;

--This rather diverse module contains the following parts:
-- control stuff, initialization and finalization
-- Allocation procedures
-- user interface procedures
-- file manipulation stuff
-- replication stuff
-- mics (PrintG, PrintB, ShowTime,InitBeadWorking)
-- Des initializations (Des=Process description parameters)

Error:SIGNAL=CODE;

firstTime:LONG CARDINAL;
time:PUBLIC 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;

InitBeadsProgram:PUBLIC PROCEDURE=BEGIN
BeadsDefs.ShowStats["Beads Program Version=",2,0];--starts print!
desP←@des;
SetDesTables[];
topBead←0;--for cedar display
IF documents THEN BEGIN
doc1:Doc←CedarDocuments.CreateDocument[name:$Typescript,
docClass:CedarDocuments.GetDocumentClass[$STREAMDOCUMENT]];
doc2:Doc←CedarDocuments.CreateDocument[name:$beads,
docClass:CedarDocuments.GetDocumentClass[$BEADSDOCUMENT]];
spec:List←l[classWindow,
l[$NEWVIEWBOX,ViewsDoc[doc1],Height[200]],
l[$NEWVIEWBOX,nextDown,ViewsDoc[doc2],Height[600]]
];
CedarDocuments.TypescriptDocument[doc1];
MakeDocumentOccupyScreen[MakeDoc[spec]];
CedarIO.PrintString["Beads Ready"];
END;
END;

Height:PROCEDURE[x:INTEGER] RETURNS[List]=BEGIN
RETURN[l[$HEIGHT,NEW[LONG INTEGER ← x]]];
END;

List:TYPE=CedarLists.ListOfRefAny;
Doc:TYPE=CedarDocuments.Document;
l:PROCEDURE[x1,x2,x3,x4,x5: REF ANY ← NIL] RETURNS [List]=CedarLists.List;

classWindow:List←l[$CLASS,$WINDOWDOCUMENT];
nextDown :List←l[$NEXT,$DOWN];

FirstDoc:PROCEDURE[doc:Doc] RETURNS[List]=
BEGIN RETURN[l[$NEWVIEWBOX,ViewsDoc[doc]]]; END;

DnDoc:PROCEDURE[doc:Doc] RETURNS[List]=
BEGIN RETURN[l[$NEWVIEWBOX,nextDown,ViewsDoc[doc]]]; END;

ViewsDoc:PROCEDURE[d:Doc] RETURNS[List]=BEGIN RETURN[l[$VIEWS,d]]; END;

screen:List←l[l[$WIDTH,NEW[LONG INTEGER ← 606]],l[$HEIGHT,NEW[LONG INTEGER ← 808]],
l[$BORDER,NEW[LONG INTEGER ← 000]]];

MakeDocumentOccupyScreen:PROCEDURE[d:Doc]=BEGIN
DisplayWorld.screenViewBox←CedarDocuments.CreateViewBox
[name:$ScreenViewBox,specsLst:screen,targetDocument:d];
CedarDocuments.displayOn←TRUE;
DisplayWorld.Refresh;
END;

MakeDoc:PROCEDURE [spec:List] RETURNS [Doc]=BEGIN
RETURN[CedarDocuments.CreateDocument[docClass:NIL,specsLst:spec]];
END;


stream:CedarIO.CedarStream;

SetUpForRun:PUBLIC PROCEDURE RETURNS[cl,dw,dl,dc,op,sc,dr,bw,dis,lab:BOOLEAN]=
BEGIN
IF documents THEN stream←CedarIO.GetInputCedarStream[];
InterrogateUserForParameters[];
AllocateBelowNoodle[];
AllocateBeadTable[];
GoGetTheBeads[];
AllocateWorkTable[];
FOR s:CARDINAL IN [0..swivel) DO Rotate[]; ENDLOOP;
Replicate[TRUE];
Replicate[FALSE];
ScavageBeads[];
IF printAtBeginning THEN PrintG[];
FindBoundingBox[];
IF disp THEN BEGIN StartDisplay[]; InitBeadWorking[]; Display[]; END;
WriteOneNumber["Starting compression: ",maxX];
IODefs.WriteNumber[maxY, [10,FALSE,TRUE,5]];
IODefs.WriteChar[CR];
RETURN[cleanup,doWires,doLocal,doCompression,onePass,scour,
drop,bothWays,disp,lookAtBelow];
END;

Finalize:PUBLIC PROCEDURE=BEGIN
PrintBeads[];
FreeWorkTable[];
time←firstTime;
ShowTime["total time = "];
WriteOneNumber["final number of beads= ",topBead+1];
MeasureWires[];
WriteOneNumber["worst size of Below Table= ",worstBelow];
IF printAtEnd THEN PrintG[];
IF disp AND BeadsDefs.ManipulateDisplay[] THEN PrintG[];
IF AskUser["Do you want to write out a file? "] THEN WriteOutBeads[];
FreeBeadTable[];
FreeBelowNoodle[];
END;

MeasureWires:PROCEDURE=BEGIN countT,countW,lengthW:INTEGER←0;
MeasureWire:PROCEDURE[i:Desc]=BEGIN SELECT TRUE FROM
VerticalWire[i] =>{countW←countW+1; lengthW←lengthW+i.p.h};
HorizontalWire[i]=>{countW←countW+1; lengthW←lengthW+i.p.w};
Trans[i]=>countT←countT+1;
ENDCASE;
END;
EnumerateBeads[MeasureWire];
WriteOneNumber["number of wires= ",countW];
WriteOneNumber["total length of wires= ",lengthW];
WriteOneNumber["number of transistors= ",countT];
END;

--/////// ALLOCATION /////

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

FreeBeadTable:PROCEDURE=BEGIN
IF ~dMachine THEN SystemDefs.FreeSegment[InlineDefs.LowHalf[bead]];
END;

FreeWorkTable:PROCEDURE=BEGIN
IF ~dMachine THEN SystemDefs.FreeSegment[InlineDefs.LowHalf[work]];
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;

AllocateBelowNoodle:PROCEDURE=BEGIN OPEN SystemDefs;
AllocateBelow[];
AllocateNoodles[];
END;

FreeBelowNoodle:PROCEDURE=BEGIN OPEN SystemDefs;
FreeBelow[];
FreeNoodles[];
END;

--/////// TALK WITH USER ///////

documents:BOOLEAN←TRUE;

WriteChar:PROCEDURE[c:CHARACTER]=
{IF documents THEN CedarIO.PrintChar[c,stream] ELSE IODefs.WriteChar[c]};

ReadChar:PROCEDURE RETURNS[c:CHARACTER]=BEGIN
IF documents THEN {c←CedarIO.ReadChar[]; []←CedarIO.ReadChar[]}
ELSE c←IODefs.ReadChar[];
END;

WriteString:PROCEDURE[s:STRING]=
{IF documents THEN CedarIO.PrintString[s,stream] ELSE IODefs.WriteString[s]};

ReadID:PROCEDURE[s:STRING]=BEGIN
IF documents THEN BEGIN
atm:ATOM←NARROW[CedarIO.ReadRefAny[stream]];
t:REF READONLY TEXT←CedarAtoms.GetPName[atm];
IF t.length>s.maxlength THEN Error;
FOR i:CARDINAL IN [0..t.length) DO s[i]←t[i]; ENDLOOP;
s.length←t.length;
[]←CedarIO.ReadChar[];
END
ELSE IODefs.ReadID[s];
END;

ReadDecimal:PROCEDURE RETURNS[x:INTEGER]=BEGIN
IF documents THEN BEGIN
y:REF INTEGER←NARROW[CedarIO.ReadRefAny[stream]];
[]←CedarIO.ReadChar[];
RETURN[y↑];
END
ELSE RETURN[IODefs.ReadDecimal[]];
END;

InterrogateUserForParameters:PROCEDURE=BEGIN
DO
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
WriteChar[CR];
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;

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
WriteChar[CR]; WriteString[s];
char←ReadChar[];
IF ~documents THEN WriteChar[char];
END;

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

--////BEADS IO //////

--Put in a Unique file ID

GoGetTheBeads:PROCEDURE=BEGIN
firstTime←time←MiscDefs.CurrentTime[];
IF processedBeads THEN ReadInBeads[] ELSE FromInputToBeads[fileName,FALSE];
FOR ii:CARDINAL IN [0..topBead] DO i:Desc←GetDesc[ii];
IF i.p.t=jctnG THEN {IF NoBeadT[i] THEN EXIT ELSE Error};
ENDLOOP;
WriteOneNumber["number of beads= ",topBead+1];
ShowTime["readin time = "];
PrintBeads[];
-- PrintDes[@Des4,@Des5,@Des6];
CheckBeads[];
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;

--///// REPLICATION /////

Replicate:PROCEDURE[hor:BOOLEAN]= BEGIN
r:CARDINAL←IF hor THEN replicateH ELSE replicateV;
s:CARDINAL;
Fix:PROCEDURE[x:CARDINAL] RETURNS[CARDINAL]=BEGIN
RETURN[x+(IF x#noBead THEN s ELSE 0)]; END;
Copy:PROCEDURE[i:Desc]=BEGIN
j:Desc←GetDesc[s+i.z];
j.p↑←i.p↑;
j.p.beadR←Fix[j.p.beadR]; j.p.beadL←Fix[j.p.beadL];
j.p.beadU←Fix[j.p.beadU]; j.p.beadD←Fix[j.p.beadD];
j.p.beadT←Fix[j.p.beadT];
IF hor THEN IncrementX[j,maxX] ELSE IncrementY[j,maxY];
END;
Link:PROCEDURE[i:Desc]=BEGIN
iT:Desc←GetDesc[s+i.z];
IF ~End[iT] THEN RETURN;
IF hor AND ~NoBeadR[iT] THEN SearchH[iT];
IF ~hor AND ~NoBeadU[iT] THEN SearchV[iT];
END;
IF r=1 THEN RETURN;
UNTIL (r←r-1)=0 DO
s←topBead+1;
IF s+s-1>=noBead THEN Error;
FindBoundingBox[];
EnumerateBeads[Copy];
EnumerateBeads[Link];
topBead←s+s-1;
FixWires[];
ENDLOOP;
MakeCircuits[];
END;

SearchH:PROCEDURE[i:Desc]=BEGIN
FOR jj:CARDINAL IN [0..topBead] DO
j:Desc←GetDesc[jj];
IF Bot[j]=Bot[i] AND j.p.t=i.p.t AND ~NoBeadL[j] THEN BEGIN
l:Desc←GetDesc[j.p.beadL];
wr:Desc←GetDesc[i.p.beadR];
r:Desc←GetDesc[wr.p.beadR];
IF l.z>=noBead OR r.z>=noBead OR wr.z>=noBead THEN Error;
l.p.beadR←r.z;
r.p.beadL←l.z;
j.p.t←i.p.t←wr.p.t←none;
RETURN;
END;
ENDLOOP;
Error;
END;

SearchV:PROCEDURE[i:Desc]=BEGIN
FOR jj:CARDINAL IN [0..topBead] DO BEGIN
j:Desc←GetDesc[jj];
IF Lfm[j]=Lfm[i] AND j.p.t=i.p.t AND ~NoBeadD[j] THEN BEGIN
d:Desc←GetDesc[j.p.beadD];
wu:Desc←GetDesc[i.p.beadU];
u:Desc←GetDesc[wu.p.beadU];
IF d.z>=noBead OR u.z>=noBead OR wu.z>=noBead THEN Error;
d.p.beadU←u.z;
u.p.beadD←d.z;
j.p.t←i.p.t←wu.p.t←none;
RETURN;
END;
END; ENDLOOP;
Error;
END;

--//////MISC///////

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;

InitBeadWorking:PROCEDURE=INLINE BEGIN EnumerateBeads[InitBeadWork]; 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;

END..