-- 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..


(1792)\i13I1i6I356i46I973i21I35i26I7227b14B1431i13I1478b28B3b12B26i23I166b7B296b17B538i9I57i10I21i2I70b9B181b10B182b12B182b15B104b10B326i10I42i9I42i12I42i5I