-- BeadsPrint.mesa

DIRECTORY IODefs:FROM "IODefs",
CedarAtoms,
CedarDocuments,
DisplayWorld,
DocumentClasses,
CedarLists,
BeadsInlines:FROM"BeadsInlines",
InlineDefs:FROM "InlineDefs",
DisplayDefs:FROM "DisplayDefs",
BeadsDefs:FROM "BeadsDefs",
-- PressDevice:FROM "PressDevice",
SystemDefs:FROM "SystemDefs",
Graphics:FROM "Graphics";
BeadsPrint:PROGRAM IMPORTS --PressDevice-- CedarAtoms, DocumentClasses,CedarLists, DisplayWorld, BeadsInlines, DisplayDefs, IODefs, Graphics, SystemDefs, InlineDefs,BeadsDefs, CedarDocuments
EXPORTS BeadsDefs, CedarDocuments =BEGIN OPEN BeadsDefs, BeadsInlines;

Error:SIGNAL=CODE;

noBead:PUBLIC CARDINAL;
noBelow:PUBLIC CARDINAL;
topBead:PUBLIC CARDINAL;
bead:PUBLIC BeadPtr;
work:PUBLIC WorkPtr;
maxY:PUBLIC INTEGER;
maxX:PUBLIC INTEGER;
desP:PUBLIC POINTER TO desStuff;
debugBeads:PUBLIC BOOLEAN;
fallBack:PUBLIC BOOLEAN;
smallDisplay:PUBLIC BOOLEAN;
freeBeadList:PUBLIC CARDINAL;
documentDisplay:BOOLEAN←TRUE;
myDocument:CedarDocuments.Document;

geomStuff:TYPE=ARRAY [0..printBufTopRow] OF ARRAY [0..printBufTopCol] OF EightColors;
EightColors:TYPE=RECORD[a,b,c,d,e,f,g,h:Color];
printBufTopCol:CARDINAL=9;
printBufTopRow:CARDINAL=80;

geom:POINTER TO geomStuff←NIL;
cornerX,cornerY:INTEGER;
display:BOOLEAN←TRUE;

MouseButtons: POINTER TO CARDINAL = LOOPHOLE[177030B];
KeyBoard1: POINTER TO CARDINAL = LOOPHOLE[177034B];
KeyBoard2: POINTER TO CARDINAL = LOOPHOLE[177035B];
MouseX: POINTER TO CARDINAL = LOOPHOLE[426B];
MouseY: POINTER TO CARDINAL = LOOPHOLE[427B];
DisplayDBC: POINTER TO CARDINAL = LOOPHOLE[420B];
x0,y0: CARDINAL; --offset to the display
dxMax:CARDINAL;
dyMax:CARDINAL; --size of the display screen

noodleChain:PUBLIC POINTER TO ARRAY [0..10000] OF CARDINAL;
noodleDX:PUBLIC POINTER TO ARRAY [0..10000] OF INTEGER;
noodleDY:PUBLIC POINTER TO ARRAY [0..10000] OF INTEGER;

Des4:PUBLIC DesArray;
Des5:PUBLIC DesArray;
Des6:PUBLIC DesArray;
Des7:PUBLIC DesArray;

bendingWires:PUBLIC BOOLEAN;
trackBead:PUBLIC CARDINAL;

EnumerateBeads:PUBLIC PROCEDURE[call:PROCEDURE[Desc]]=BEGIN
FOR ii:CARDINAL IN [0..topBead]
DO i:Desc←GetDesc[ii]; IF Type[i]#none THEN call[i]; ENDLOOP;
END;

EnumerateSortedBottomUp:PUBLIC PROCEDURE[call:PROCEDURE[Desc]]= BEGIN
FOR ii:CARDINAL DECREASING IN [0..topBead]
DO i:Desc←GetDesc[GetW[ii].sort]; IF Type[i]#none THEN call[i]; ENDLOOP;
END;

DeltaZ:PUBLIC PROCEDURE[ii,jj:CARDINAL] RETURNS[Coord] =BEGIN
i:Desc←GetDesc[ii]; wpi:WorkPtr←Getw[i];
j:Desc←GetDesc[jj]; wpj:WorkPtr←Getw[j];
si:CARDINAL←desP[Type[i]].short;
sj:CARDINAL←desP[Type[j]].short;
SELECT TRUE FROM
i.p.circuit#j.p.circuit=>BEGIN
IF i.p.wire AND j.p.wire THEN BEGIN
ie1:CARDINAL←IF NoBeadR[i] THEN i.p.beadU ELSE i.p.beadL;
ie2:CARDINAL←IF NoBeadR[i] THEN i.p.beadD ELSE i.p.beadR;
je1:CARDINAL←IF NoBeadR[j] THEN j.p.beadU ELSE j.p.beadL;
je2:CARDINAL←IF NoBeadR[j] THEN j.p.beadD ELSE j.p.beadR;
IF ie1=je1 OR ie1=je2 OR ie2=je1 OR ie2=je2 THEN RETURN[[0,0]];
END;
RETURN[[Des6[si][sj],Des4[si][sj]]];
END;
si=sj AND si IN [5..7] AND Width[i]>0 AND Width[j]>0=>BEGIN
IF Height[i]<=0 OR Height[j]<=0 THEN Error;
-- RETURN[[-MIN[Width[i],Width[j]],-MIN[Height[i],Height[j]]]];
-- RETURN[[-Width[i],-Height[i]]];
RETURN[[-MAX[Width[i],Width[j]],-MAX[Height[i],Height[j]]]];
END;
Type[i]=rb AND sj=6 OR Type[i]=bg AND sj=5=>
IF ContactWall[i,j] THEN RETURN[[0,0]];
Type[j]=rb AND si=6 OR Type[j]=bg AND si=5=>
IF ContactWall[j,i] THEN RETURN[[0,0]];
ENDCASE;
RETURN[[Des7[si][sj],Des5[si][sj]]];
END;

ContactWall:PROCEDURE[i,j:Desc] RETURNS[BOOLEAN] =BEGIN
k:Desc←DescT[i];
IF Type[k]=bf THEN k←DescT[k];
RETURN[SELECT Lfm[k]-Lfm[i] FROM
>0=>Lfm[k]=Lfm[j],
<0=>Rtm[k]=Rtm[j],
ENDCASE=>IF Bot[k]>Bot[i] THEN Bot[k]=Bot[j] ELSE Top[k]=Top[j]];
END;

WriteOneNumber:PUBLIC PROCEDURE[s:STRING,n:INTEGER]= BEGIN OPEN IODefs;
WriteChar[CR]; WriteString[s]; WriteNumber[n,[10,FALSE,TRUE,6]];
END;

InitBeadWork:PUBLIC PROCEDURE[i:Desc]= BEGIN
wi:WorkPtr←Getw[i];
w:INTEGER←Height[i];
ti:BeadType←Type[i];
wi.sort←i.z;
i.p.nextBelow←noBelow;
wi.chain←noBead;
wi.newY←maxY-w;
i.p.noodle←topNoodle;
wi.processed←FALSE;
wi.seen←noBead;
wi.stiff←~bendingWires OR ~HorizontalWire[i]
OR ti=wireO
OR Width[i]+w<IfTranL[i,w+2]+IfTranR[i,w+2]
OR Width[i]<0 --no need--;
END;

ShowStats:PUBLIC PROCEDURE[s:STRING,a,b:CARDINAL]=BEGIN
OPEN IODefs;
WriteChar[CR]; WriteString[s]; WriteNumber[a,[10,FALSE,TRUE,6]];
WriteNumber[b,[10,FALSE,TRUE,6]]; WriteChar[CR];
END;

seeB:Bead;
seeW:Work;

See:PROCEDURE[i:CARDINAL]= BEGIN seeB←Get[i]↑; seeW←GetW[i]↑; END;

PrintDes:PUBLIC PROCEDURE[x,y,z:POINTER TO DesArray]= BEGIN OPEN IODefs;
i,j:CARDINAL;
WriteChar[CR];
WriteString[" Des4, Des5 AND Des6"];
FOR i IN [0..7] DO
WriteChar[CR];
FOR j IN [0..7] DO WriteNumber[x[i][j], [10,FALSE,TRUE,3]]; ENDLOOP;
WriteString[" "];
FOR j IN [0..7] DO WriteNumber[y[i][j], [10,FALSE,TRUE,3]]; ENDLOOP;
WriteString[" "];
FOR j IN [0..7] DO WriteNumber[z[i][j], [10,FALSE,TRUE,3]]; ENDLOOP;
ENDLOOP;
WriteChar[CR];
END;

PrintLong:PUBLIC PROCEDURE[i:LONG CARDINAL]= BEGIN
OPEN IODefs;
k:CARDINAL← 0;
WHILE i> 10000 DO
i← i/10;
k← k+ 1; ENDLOOP;
WriteNumber[InlineDefs.LowHalf[i],[10,FALSE,TRUE,5]];
WriteChar[’E];
WriteNumber[k,[10,FALSE,TRUE,1]];
END;

BeadTypeToString:PROCEDURE[t:BeadType] RETURNS [STRING]=BEGIN
RETURN[SELECT t FROM
none =>" none",
all =>" all",
rg =>" rg",
rb =>" rb",
bg =>" bg",
tt =>" ttH",
dd =>" ddH",
ttV =>" ttV",
ddV =>" ddV",
endG =>" endG",
endR =>" endR",
endB =>" endB",
stub =>" stub",
jctnG=>"jctnG",
jctnR=>"jctnR",
jctnB=>"jctnB",
bf =>" bf",
wireG=>"wireG",
wireR=>"wireR",
wireB=>"wireB",
wireO=>"wireO",
endO =>" endO",
ENDCASE=>ERROR];
END;

PrintBeads:PUBLIC PROCEDURE= BEGIN OPEN IODefs;
IF debugBeads THEN BEGIN WriteChar[CR]; EnumerateBeads[PrintBead]; END;
END;

PrintBead:PROCEDURE[i:Desc]= BEGIN OPEN IODefs;
WriteChar[CR];
WriteNumber[i.z, [10,FALSE,TRUE,3]];
WriteString[" ["];
WriteString[BeadTypeToString[Type[i]]];
WriteNumber[Lfm[i], [10,FALSE,TRUE,4]];
WriteString[","];
WriteNumber[Bot[i], [10,FALSE,TRUE,4]];
WriteString[","];
WriteNumber[Height[i], [10,FALSE,FALSE,4]];
WriteString[","];
WriteNumber[Width[i], [10,FALSE,FALSE,4]];
WriteString[","];
WriteNumber[i.p.external, [10,FALSE,TRUE,2]];
WriteChar[’]];
IF ~(NoBeadU[i] AND NoBeadD[i] AND NoBeadL[i]
AND NoBeadR[i] AND NoBeadT[i])
THEN BEGIN
WriteString[" udlrt="];
PrintNeighbor[i.p.beadU];
PrintNeighbor[i.p.beadD];
PrintNeighbor[i.p.beadL];
PrintNeighbor[i.p.beadR];
PrintNeighbor[i.p.beadT];
WriteString[" n "];
IF i.p.noodle#topNoodle
THEN WriteNumber[i.p.noodle, [10,FALSE,TRUE,4]]
ELSE WriteString[" xx "];
WriteString[" c "];
WriteNumber[i.p.circuit, [10,FALSE,TRUE,4]];
END;
END;--print bead

PrintNeighbor:PROCEDURE[q:CARDINAL]=BEGIN OPEN IODefs;
IF q=noBead THEN WriteString[" xx"] ELSE WriteNumber[q, [10,FALSE,TRUE,4]];
END;

PrintBend:PROCEDURE[q:CARDINAL]=BEGIN OPEN IODefs;
SELECT q FROM
-1=>WriteChar[’ ];
wholeWire=>WriteChar[’W];
ENDCASE=>WriteNumber[q,[10,FALSE,TRUE,3]];
END;

-- - - PRINT GEOMETRY - - -

FindBoundingBox:PUBLIC PROCEDURE= { maxX←maxY←0; EnumerateBeads[OneBound]; };
OneBound:PROCEDURE[i:Desc]={maxX←MAX[Rtm[i],maxX]; maxY←MAX[Top[i],maxY]};

halfHeight:INTEGER=12000;
halfWidth:INTEGER=8000;
showHeight:INTEGER;
showWidth:INTEGER;

PrintGeometry:PUBLIC PROCEDURE[name:STRING]= BEGIN
display←FALSE;
geom←SystemDefs.AllocateSegment[SIZE[geomStuff]];
FindBoundingBox[];
scale←MIN[100,2*halfHeight/maxY,2*halfWidth/maxX];
cornerX←halfWidth-scale/2*maxX;
cornerY←halfHeight-scale/2*maxY;
showHeight←2*halfHeight;
showWidth←2*halfWidth;
StartHardcopy[name];
EnumerateBeads[PutPattern];
EndHardcopy[];
display←TRUE;
SystemDefs.FreeSegment[geom];
END;--print geom

Display:PUBLIC PROCEDURE= BEGIN
EraseArea[0,0,dxMax,dyMax];
x0←y0←177767B;
scale←SELECT MAX[maxX,maxY] FROM
>255 =>1,
>127 =>IF smallDisplay THEN 1 ELSE 2,
>63 =>IF smallDisplay THEN 2 ELSE 4,
ENDCASE =>4;
cornerX←scale*x0;
cornerY←scale*y0;
showHeight←15000;
showWidth←15000;
ReallyDisplay[];
END;

DisplayA:PUBLIC PROCEDURE[context:Graphics.DisplayContext]= BEGIN
IF topBead=0 THEN RETURN;
displayContext←context;
EnumerateBeads[PutPattern];
END;

scale:INTEGER;

PutPattern:PROCEDURE[i:Desc]=BEGIN
type:BeadType←Type[i];
x:INTEGER←Lfm[i];
y:INTEGER←Bot[i];
h:INTEGER←Height[i];
w:INTEGER←Width[i];
c:Color←desP[type].color;
IF h<=0 OR w<=0 THEN RETURN;
IF ~HorizontalWire[i] THEN PutBox[c,x,y,w,h];
SELECT type FROM
tt =>BEGIN PutBox[r,x,y-3,w,3]; PutBox[r,x,y+h,w,3]; END;
dd =>BEGIN PutBox[r,x,y-2,w,2]; PutBox[r,x,y+h,w,2]; END;
ttV=>BEGIN PutBox[r,x-3,y,3,h]; PutBox[r,x+w,y,3,h]; END;
ddV=>BEGIN PutBox[r,x-2,y,2,h]; PutBox[r,x+w,y,2,h]; END;
bf=>PutBox[none,x+2,y+2,w-4,h-4]; --show contacts
wireR,wireB,wireG=>IF NoBeadU[i] THEN BEGIN
compilerBug:CARDINAL;
this:CARDINAL;
dy,nextX,nextY:INTEGER;
wid:INTEGER←h;
thisX:INTEGER←x-wid;
thisY:INTEGER←y;
FOR this←i.p.noodle,noodleChain[this] UNTIL this=topNoodle DO
IF this>topNoodle THEN Error;
PutBox[c,thisX,thisY,noodleDX[this],wid];
dy←noodleDY[this];
nextX←thisX+noodleDX[this];
nextY←thisY+dy;
PutBox[c,nextX,MIN[thisY,nextY],wid,ABS[dy]+wid];
thisX←nextX;
thisY←nextY;
ENDLOOP;
nextX←x+w;
nextY←Get[i.p.beadR].y;
PutBox[c,thisX,thisY,nextX-thisX,wid];
compilerBug←ABS[nextY-thisY]+wid;
PutBox[c,nextX,MIN[thisY,nextY],wid,compilerBug];
END;
jctnG,jctnR,jctnB,endG,endR,endB,bg,rb,wireO,endO=>NULL;
ENDCASE=>Error;
END;--put pattern

PutBox:PROCEDURE[color:Color,x,y,m,n:CARDINAL]=BEGIN
IF m>1000 OR n>1000 OR color=o THEN RETURN;
BEGIN
mode:Mode←IF display THEN screen ELSE press;
x2: INTEGER←scale*x-cornerX;
y2: INTEGER←scale*y-cornerY;
w: CARDINAL←MIN[scale*m,showWidth-x2];
h: CARDINAL←MIN[scale*n,showHeight-y2];
IF x2 ~IN [0..showWidth) OR y2~IN[0..showHeight) THEN RETURN;
--IF mode=screen THEN y2←dyMax-y2-h;
SetColor[color,mode];
Graphics.DrawRectangle[displayContext,[x2,y2],[x2+w,y2+h]];
END END;--DisplayBox

-- Graphics Display Procedures

ReallyDisplay:PROCEDURE=BEGIN
IF documentDisplay THEN DisplayWorld.Refresh[]
ELSE DisplayA[myDisplayContext];
END;

ManipulateDisplay:PUBLIC PROCEDURE RETURNS[print:BOOLEAN]= BEGIN
x1,y1:CARDINAL;
DO SELECT TRUE FROM
BlueButton[] => Display[];
YellowButton[] =>
BEGIN
x1←MouseX↑/scale +x0;
y1←(dyMax-MouseY↑)/scale +y0;
scale←dxMax/MAX[(x1-x0),(y1-y0)];
EraseArea[0,0,dxMax,dyMax];
ReallyDisplay[];
END;
RedButton[] =>
BEGIN
x0←MouseX↑/scale +x0;
y0←(dyMax-MouseY↑)/scale +y0;
EraseArea[0,0,dxMax,dyMax];
ReallyDisplay[];
END;
KeyBoard1↑= 177757B =>BEGIN print←TRUE; EXIT; END; --p was hit
KeyBoard2↑= 167777B =>BEGIN print←FALSE; EXIT; END; --q was hit
ENDCASE;
ENDLOOP;
TurnOffGraphics[];
[]← IODefs.ReadChar[];
END;

MouseType:TYPE=RECORD[r,b,y:BOOLEAN];

Mouse:PROCEDURE RETURNS[MouseType]=BEGIN
RETURN[[InlineDefs.BITAND[4,MouseButtons↑]=0,
InlineDefs.BITAND[2,MouseButtons↑]=0,
InlineDefs.BITAND[1,MouseButtons↑]=0]]; END;

RedButton:PROCEDURE RETURNS[s:BOOLEAN]=
BEGIN s←Mouse[].r; UNTIL ~Mouse[].r DO ENDLOOP; END;

BlueButton:PROCEDURE RETURNS[s:BOOLEAN]=
BEGIN s←Mouse[].b; UNTIL ~Mouse[].b DO ENDLOOP; END;

YellowButton:PROCEDURE RETURNS[s:BOOLEAN]=
BEGIN s←Mouse[].y; UNTIL ~Mouse[].y DO ENDLOOP; END;

--deviceContext:PressDevice.DeviceContext;
displayContext:Graphics.DisplayContext;
myDisplayContext:Graphics.DisplayContext;

StartHardcopy:PROCEDURE[name:STRING]=BEGIN
-- deviceContext←PressDevice.New[name];
displayContext←Graphics.NewContext[--deviceContext--];
END;

EndHardcopy:PROCEDURE=BEGIN --PressDevice.Free[@deviceContext]; --END;

Mode:TYPE={press,screen};

SetColor:PROCEDURE[c:Color,m:Mode]=BEGIN
SELECT c FROM r,g,b,none=>NULL; ENDCASE=>Error;
Graphics.SetColor[displayContext,SELECT c FROM
r=>[220,128,255],
g=>[080,128,255],
b=>[140,064,255],
ENDCASE=>[140,000,000]];
Graphics.SetTexture[displayContext,SELECT c FROM
b=>125252B, --light grey
g=>122645B, --dark grey
r=>170360B, --almost black
ENDCASE=>Graphics.black];--black
END;

EraseArea:PROCEDURE[x,y,w,h:INTEGER]=BEGIN OPEN Graphics;
IF documentDisplay THEN RETURN;
SetPaint[displayContext,replace];
SetColor[displayContext,[0,0,0]];
SetTexture[displayContext,0];
DrawRectangle[displayContext,[x,y],[x+w,y+h]];
SetPaint[displayContext,paint];
END;

StartDisplay:PUBLIC PROCEDURE= BEGIN --initialize the screen
dxMax←dyMax←IF smallDisplay THEN 256 ELSE 600;
IF documentDisplay THEN RETURN;
DisplayDefs.DisplayOff[white];
IF dougsDcb#0 THEN DisplayDBC↑←dougsDcb;
myDisplayContext←Graphics.NewContext[NIL];
END;

dougsDcb:CARDINAL←0;

l:PROCEDURE[x1,x2,x3,x4,x5: REF ANY ← NIL] RETURNS [CedarLists.ListOfRefAny]=CedarLists.List;
screen:CedarLists.ListOfRefAny←l[l[$WIDTH,NEW[LONG INTEGER ← 606]],l[$HEIGHT,NEW[LONG INTEGER ← 808]],
l[$BORDER,NEW[LONG INTEGER ← 000]]];

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

TurnOffGraphics:PROCEDURE= BEGIN
IF documentDisplay THEN RETURN;
dougsDcb←DisplayDBC↑;
DisplayDefs.DisplayOn[];
END;

--OPEN CedarDocuments, DocumentClasses, CedarAtoms, CedarLists;

DisplayContext: TYPE = Graphics.DisplayContext;
Doc: TYPE = CedarDocuments.Document;

-- DocumentRecord: PUBLIC TYPE = DocumentClasses.DocumentRecord;-- -- export this type

DocumentProcs: PUBLIC TYPE = DocumentClasses.DocumentProcs;

BeadsDocumentRecord: DocumentClasses.DocumentProcs ← [
className: $BEADSDOCUMENT,
init: InitBeadsDocument,
paint: PaintBeadsDocument,
boundingBox: BeadsBoundingBox];

InitBeadsDocument:DocumentClasses.InitDocProc -- [document: Document, base: REF ANY] -- =
BEGIN END;

BeadsBoundingBox: DocumentClasses.BoundingBoxProc -- [document: Doc, boundingBox: LONG POINTER To DocumentClasses.BoundingBox] -- =
BEGIN boundingBox↑ ←[[0,0],[600,600]]; END;

PaintBeadsDocument: DocumentClasses.PaintDocProc =
-- [document: Document, inViewBox: ViewBox, displayContext: DisplayContext] --
BEGIN DisplayA[displayContext]; END;


BeadsDocument:CedarDocuments.DocumentClass ← NEW[DocumentProcs ← BeadsDocumentRecord];

CedarAtoms.PutProp[$BEADSDOCUMENT, $DOCUMENTCLASS, BeadsDocument];


END..