-- BeadsPrint5.mesa

DIRECTORY IODefs:FROM"IODefs",
InlineDefs:FROM"InlineDefs",
BeadsDefs:FROM"BeadsDefs",
PressDefs:FROM"PressDefs",
SystemDefs:FROM"SystemDefs",
GraphicsDefs:FROM"GraphicsDefs";
BeadsPrint:PROGRAM IMPORTS IODefs, GraphicsDefs, SystemDefs, PressDefs, InlineDefs,BeadsDefs
EXPORTS BeadsDefs =BEGIN OPEN BeadsDefs;
--GraphicDefs and PressDefs are Joe Maleson’s.

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;
Screen:POINTER TO GraphicsDefs.Bitmap;
OldDCB:CARDINAL;
DCBHead: POINTER TO CARDINAL= LOOPHOLE[420B];

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;
press:PressDefs.PressFileDescriptor;
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];
x0,y0: CARDINAL; --offset to the display
dxMax:CARDINAL;
dyMax:CARDINAL; --size of the display screen

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

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

bendingWires:PUBLIC BOOLEAN;
trackBead:PUBLIC CARDINAL;

EnumerateBeads:PUBLIC PROCEDURE[foo:PROCEDURE[CARDINAL,BeadPtr]]=BEGIN
i:CARDINAL; bpi:BeadPtr;
FOR i IN [0..topBead] DO
bpi←Get[i];
IF bpi.t#none THEN foo[i,bpi];
ENDLOOP;
END;

EnumerateSortedBottomUp:PUBLIC PROCEDURE[call:PROCEDURE[CARDINAL,BeadPtr]]=
BEGIN ii:CARDINAL;
FOR ii DECREASING IN [0..topBead] DO BEGIN
i:CARDINAL←GetW[ii].sort; bpi:BeadPtr←Get[i];
IF bpi.t#none THEN call[i,bpi];
END ENDLOOP;
END;

Deltas:PUBLIC PROCEDURE[i,j:CARDINAL] RETURNS[INTEGER,INTEGER] =BEGIN
bpi:BeadPtr←Get[i]; wpi:WorkPtr←GetW[i];
bpj:BeadPtr←Get[j]; wpj:WorkPtr←GetW[j];
si:CARDINAL←desP[bpi.t].short;
sj:CARDINAL←desP[bpj.t].short;
SELECT TRUE FROM
bpi.circuit#bpj.circuit=>BEGIN
IF bpi.wire AND bpj.wire THEN BEGIN
ie1:CARDINAL←IF bpi.beadR=noBead THEN bpi.beadU ELSE bpi.beadL;
ie2:CARDINAL←IF bpi.beadR=noBead THEN bpi.beadD ELSE bpi.beadR;
je1:CARDINAL←IF bpj.beadR=noBead THEN bpj.beadU ELSE bpj.beadL;
je2:CARDINAL←IF bpj.beadR=noBead THEN bpj.beadD ELSE bpj.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 bpi.w>0 AND bpj.w>0=>BEGIN
IF bpi.h<=0 OR bpj.h<=0 THEN Error;
-- RETURN[-MIN[bpi.w,bpj.w],-MIN[bpi.h,bpj.h]];
-- RETURN[-bpi.w,-bpi.h];
RETURN[-MAX[bpi.w,bpj.w],-MAX[bpi.h,bpj.h]];
END;
bpi.t=rb AND sj=6 OR bpi.t=bg AND sj=5=>
IF ContactWall[bpi,bpj] THEN RETURN[0,0];
bpj.t=rb AND si=6 OR bpj.t=bg AND si=5=>
IF ContactWall[bpj,bpi] THEN RETURN[0,0];
ENDCASE;
RETURN[Des7[si][sj],Des5[si][sj]];
END;

ContactWall:PROCEDURE[bpi,bpj:BeadPtr] RETURNS[BOOLEAN] =BEGIN
k:CARDINAL←bpi.beadT; bpk:BeadPtr←Get[k];
IF bpk.t=bf THEN BEGIN k←bpk.beadT; bpk←Get[k]; END;
RETURN[SELECT bpk.x-bpi.x FROM
>0=>bpk.x=bpj.x,
<0=>bpk.x+bpk.w=bpj.x+bpj.w,
ENDCASE=>IF bpk.y>bpi.y THEN bpk.y=bpj.y ELSE bpk.y+bpk.h=bpj.y+bpj.h];
END;

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

IfTrans:PUBLIC PROCEDURE[i:CARDINAL,a:INTEGER] RETURNS[INTEGER] =BEGIN
RETURN[SELECT Get[i].t FROM tt,dd,ttV,ddV=>a, ENDCASE=>0];
END;

InitBeadWork:PUBLIC PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
wi:WorkPtr←GetW[i];
w:INTEGER←bpi.h;
ti:BeadType←bpi.t;
wi.sort←i;
bpi.nextBelow←noBelow;
wi.chain←noBead;
wi.newY←maxY-bpi.h;
bpi.noodle←topNoodle;
wi.processed←FALSE;
wi.seen←noBead;
wi.stiff←~bendingWires OR ~bpi.wire OR bpi.beadR=noBead
OR ti=wireO
OR bpi.w+bpi.h<
IfTrans[bpi.beadL,w+2]+IfTrans[bpi.beadR,w+2]
OR bpi.w<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;

PrintAllSticks:PUBLIC PROCEDURE[st:POINTER TO StickStuff,top:CARDINAL]=
BEGIN OPEN IODefs;
i:CARDINAL; a:Stick;
WriteChar[CR];
FOR i IN [0..top] DO
a←st[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

PrintAllContacts:PUBLIC PROCEDURE[c:POINTER TO ConStuff,top:CARDINAL]=
BEGIN OPEN IODefs;
i:CARDINAL;
WriteChar[CR];
FOR i IN [0..top] DO
WriteChar[CR];
WriteNumber[i,[10,FALSE,TRUE,3]];
WriteString[BeadTypeToString[c[i].t]];
WriteNumber[c[i].x, [10,FALSE,TRUE,5]];
WriteNumber[c[i].y, [10,FALSE,TRUE,5]];
ENDLOOP;
END;--print sticks

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[b:CARDINAL,bpi:BeadPtr]= BEGIN OPEN IODefs;
WriteChar[CR];
WriteNumber[b, [10,FALSE,TRUE,3]];
WriteString[" ["];
WriteString[BeadTypeToString[bpi.t]];
WriteNumber[bpi.x, [10,FALSE,TRUE,4]];
WriteString[","];
WriteNumber[bpi.y, [10,FALSE,TRUE,4]];
WriteString[","];
WriteNumber[bpi.h, [10,FALSE,FALSE,4]];
WriteString[","];
WriteNumber[bpi.w, [10,FALSE,FALSE,4]];
WriteString[","];
WriteNumber[bpi.external, [10,FALSE,TRUE,2]];
WriteChar[’]];
IF bpi.beadU#noBead OR bpi.beadD#noBead OR bpi.beadL#noBead
OR bpi.beadR#noBead OR bpi.beadT#noBead
THEN BEGIN
WriteString[" udlrt="];
PrintNeighbor[bpi.beadU];
PrintNeighbor[bpi.beadD];
PrintNeighbor[bpi.beadL];
PrintNeighbor[bpi.beadR];
PrintNeighbor[bpi.beadT];
WriteString[" n "];
IF bpi.noodle#topNoodle
THEN WriteNumber[bpi.noodle, [10,FALSE,TRUE,4]]
ELSE WriteString[" xx "];
WriteString[" c "];
WriteNumber[bpi.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=
BEGIN maxX←maxY←0; EnumerateBeads[OneBound]; END;

OneBound:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
maxX←MAX[bpi.x+bpi.w,maxX];
maxY←MAX[bpi.y+bpi.h,maxY];
END;

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

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;
PressDefs.InitPressFileDescriptor[@press,name];
EnumerateBeads[PutPattern];
PressDefs.ClosePressFile[@press];
display←TRUE;
SystemDefs.FreeSegment[geom];
END;--print geom

scale:INTEGER;

PutPattern:PROCEDURE[b:CARDINAL,bpi:BeadPtr]=BEGIN
type:BeadType←bpi.t;
x:INTEGER←bpi.x;
y:INTEGER←bpi.y;
h:INTEGER←bpi.h;
w:INTEGER←bpi.w;
c:Color←desP[type].color;
IF h<=0 OR w<=0 THEN RETURN;
IF ~bpi.wire OR bpi.beadR=noBead 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 bpi.beadR#noBead THEN BEGIN
this:CARDINAL;
dy,nextX,nextY:INTEGER;
wid:INTEGER←bpi.h;
thisX:INTEGER←bpi.x-wid;
thisY:INTEGER←bpi.y;
FOR this←bpi.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←bpi.w+bpi.x;
nextY←Get[bpi.beadR].y;
PutBox[c,thisX,thisY,nextX-thisX,wid];
PutBox[c,nextX,MIN[thisY,nextY],wid,ABS[nextY-thisY]+wid];
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
x1,y1,w1,w2:INTEGER;
IF m>1000 OR n>1000 OR color=o THEN RETURN;
IF display THEN BEGIN DisplayBox[color,x,y,m,n]; RETURN; END;
SELECT color FROM
r=>PressDefs.SetColor[@press,220,128,255];
g=>PressDefs.SetColor[@press,080,128,255];
b=>PressDefs.SetColor[@press,140,064,255];
none=>PressDefs.SetColor[@press,140,000,000];
ENDCASE;
x1←cornerX+scale*x;
y1←cornerY+scale*y;
w1←scale*m;
w2←scale*n;
IF x1>2*halfWidth OR y1>2*halfHeight OR x1+w1>2*halfWidth
OR y1+w2>2*halfHeight THEN RETURN;
PressDefs.PutRectangle[@press,x1,y1,w1,w2];
END;--PutBox


--
-- Graphics Display Procedures
--
StartDisplay:PUBLIC PROCEDURE= BEGIN --initialize the screen
dxMax←dyMax←IF smallDisplay THEN 256 ELSE 512;
GraphicsDefs.SetDefaultBitmap[dxMax,dyMax];
OldDCB← DCBHead↑;
Screen ← GraphicsDefs.TurnOnGraphics[];
END;

Display:PUBLIC PROCEDURE= BEGIN
GraphicsDefs.EraseArea[0,0,dxMax,dyMax];
x0←y0←177767B;
SELECT MAX[maxX,maxY] FROM
>255 => scale←1;
>127 => scale←IF smallDisplay THEN 1 ELSE 2;
>63 => scale←IF smallDisplay THEN 2 ELSE 4;
ENDCASE => scale←4;
EnumerateBeads[PutPattern];
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)];
GraphicsDefs.EraseArea[0,0,dxMax,dyMax];
EnumerateBeads[PutPattern];
END;
RedButton[] =>
BEGIN
x0←MouseX↑/scale +x0;
y0←(dyMax-MouseY↑)/scale +y0;
GraphicsDefs.EraseArea[0,0,dxMax,dyMax];
EnumerateBeads[PutPattern];
END;
KeyBoard1↑= 177757B =>BEGIN print←TRUE; EXIT; END; --p was hit
KeyBoard2↑= 167777B =>BEGIN print←FALSE; EXIT; END; --q was hit
ENDCASE;
ENDLOOP;
TurnOffGraphics[];
DCBHead↑← OldDCB;
[]← IODefs.ReadChar[];
END;

RedButton:PROCEDURE RETURNS[BOOLEAN]= BEGIN
IF (MouseButtons↑ MOD 8) < 4
THEN BEGIN
UNTIL (MouseButtons↑ MOD 8) > 3 DO ENDLOOP;
RETURN [TRUE];
END
ELSE RETURN [FALSE];
END;

BlueButton:PROCEDURE RETURNS[BOOLEAN]= BEGIN
IF (MouseButtons↑ MOD 4) < 2
THEN BEGIN
UNTIL (MouseButtons↑ MOD 4) > 1 DO ENDLOOP;
RETURN [TRUE];
END
ELSE RETURN [FALSE];
END;

YellowButton:PROCEDURE RETURNS[BOOLEAN]= BEGIN
IF (MouseButtons↑ MOD 2) = 0
THEN BEGIN
UNTIL (MouseButtons↑ MOD 2) # 0 DO ENDLOOP;
RETURN [TRUE];
END
ELSE RETURN [FALSE];
END;

TurnOffGraphics:PROCEDURE= BEGIN
DCBHead↑← 0;
SystemDefs.FreeSegment[Screen.bits- 4];
Screen.bits← NIL;
END;


DisplayBox:PROCEDURE[color:Color,x,y,m,n:CARDINAL]=BEGIN
x1,y1,x2,y2: CARDINAL;
x1←scale*(x-x0+m);
y1←dyMax-scale*(y-y0+n);
x2←scale*(x-x0);
y2←dyMax-scale*(y-y0);
IF x2>15000 OR y2>15000 OR color=o THEN RETURN;
IF x1>15000 THEN x1←0;
IF y1>15000 THEN y1←0;

SELECT color FROM
b=>GraphicsDefs.SetGrayLevel[14]; --light grey
g=>GraphicsDefs.SetGrayLevel[10]; --dark grey
r=>GraphicsDefs.SetGrayLevel[3]; --almost black
none=>GraphicsDefs.SetGrayLevel[0];--black
ENDCASE;
GraphicsDefs.PutGray[x1,y1,x2,y2];
END;--DisplayBox



END..