-- beadsbelow4.mesa
-- watch out for push through!

DIRECTORY IODefs:FROM"IODefs",
          InlineDefs:FROM"InlineDefs",
          SystemDefs:FROM"SystemDefs",
          BeadsDefs:FROM"BeadsDefs";
BeadsBelow:PROGRAM IMPORTS InlineDefs, IODefs, BeadsDefs,SystemDefs
                   EXPORTS BeadsDefs =
BEGIN OPEN BeadsDefs;

--/// The operations on the below table are:
--///   Allocate:  assign storage (only)
--///   Reset:     set up a couple of parameters
--///   Make:      build the data structure from the beads
--///   TryAll:    use the structure to enumerate all j below i
--///   Free:      release storage
--///   Show:      print the structure (for debugging only)

Error:SIGNAL=CODE;

worstBelow:PUBLIC CARDINAL;-- a storage performance monitor
moreBelow:PUBLIC BOOLEAN;-- a debugging switch
timeV5,timeV6:PUBLIC LONG CARDINAL_0;-- performance monitors

maxSpit:CARDINAL=4500;
belowData:LONG POINTER TO ARRAY[0..2] OF CARDINAL_NIL;
belowNext:LONG POINTER TO ARRAY[0..2] OF CARDINAL_NIL;
spit:PtrToCardArray;
topBelow:CARDINAL;
processNo:CARDINAL;

bpi,bps:BeadPtr;
bi,bs:CARDINAL;
iy,level,delta:INTEGER;
flag:BOOLEAN;
flagBead:CARDINAL;

AllocateBelow:PUBLIC PROCEDURE=BEGIN OPEN SystemDefs;
  doradoBelowBase1:LONG CARDINAL=1600000B;
  doradoBelowBase2:LONG CARDINAL=1700000B;
  spit_AllocateSegment[maxSpit+1];
  IF noBelow >6000 THEN BEGIN
    belowData_LOOPHOLE[doradoBelowBase1];
    belowNext_LOOPHOLE[doradoBelowBase2];
    END
  ELSE BEGIN
    belowData_AllocateSegment[noBelow+1];
    belowNext_AllocateSegment[noBelow+1];
    END;
  END;

FreeBelow:PUBLIC PROCEDURE=BEGIN OPEN SystemDefs;
  FreeSegment[spit];
  IF noBelow >6000 THEN BEGIN
    FreeSegment[InlineDefs.LowHalf[belowData]];
    FreeSegment[InlineDefs.LowHalf[belowNext]];
    END;
  END;

ResetBelow:PUBLIC PROCEDURE=BEGIN END;

ShowBelow:PUBLIC PROCEDURE=BEGIN EnumerateBeads[Show2]; END;

Show1:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN OPEN IODefs; s:CARDINAL;
   WriteChar[CR ];
   WriteNumber[i,  [10,FALSE,TRUE,3]];
   WriteString[": "];
   FOR s_Get[i].nextBelow, belowNext[s] UNTIL s=noBelow
     DO WriteNumber[belowData[s],[10,FALSE,TRUE,4]]; ENDLOOP;
  END;

Show2:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN OPEN IODefs;
   bi_i;
   IF bpi.wire AND bpi.beadR=noBead THEN RETURN;
   WriteChar[CR ];
   WriteNumber[i,  [10,FALSE,TRUE,3]];
   WriteString[": "];
   []_TryAllBelow[i,Show3];
  END;

Show3:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]=BEGIN OPEN IODefs;
  y:INTEGER;
  [,y]_Deltas[i,j];
  y_y+Get[j].h;
  WriteChar['( ];
  WriteNumber[j,[10,FALSE,TRUE,4]];
  WriteChar['  ];
  WriteNumber[y,[10,FALSE,TRUE,4]];
  WriteChar[IF StrictlyBelow[j] THEN 'T ELSE 'F ];
  WriteChar[') ];
  RETURN[TRUE];
  END;

MakeBelow:PUBLIC PROCEDURE=
  BEGIN InitBelow[];  SetBelow[0]; SetBelow[1];  SetBelow[2]; END;

--must be three passes because a red can wipe a green out of spit without shielding it

InitBelow:PROCEDURE=BEGIN i:CARDINAL; wpi:WorkPtr;
  FOR i IN [0..topBead]
    DO wpi_GetW[i]; wpi.seen_noBead; wpi.oldY_Get[i].y; ENDLOOP;
  MyResetBelow[];
  flag_FALSE;
  topBelow_177777B;
  FOR i IN [0..noBelow] DO belowNext[i]_noBelow; ENDLOOP;
  END;

MyResetBelow:PROCEDURE=BEGIN i:CARDINAL;
  FOR i IN [0..topBead] DO GetW[i].processNo_0; ENDLOOP;
  processNo_0;
 END;

SetBelow:PROCEDURE[l:INTEGER] =BEGIN
  --level - 0,1,2,3 are green, red, blue,orange. Transistors are red.
  s:INTEGER;
  level_l;
  delta_SELECT l FROM 0,2=>6, ENDCASE=>4;
  IF maxX+10>=maxSpit THEN Error;
  FOR s IN [0..maxX] DO spit[s]_noBead; ENDLOOP;
  EnumerateSortedBottomUp[SetOneBead];
  IF topBelow>worstBelow THEN worstBelow_topBelow;
  END;

SetOneBead:PROCEDURE[i:CARDINAL,bpix:BeadPtr] =BEGIN
  soh:INTEGER_desP[bpix.t].stickOutToRight;
  low:INTEGER_MAX[bpix.x-soh,0];
  high:INTEGER_MIN[bpix.x+bpix.w+soh,maxX];
  bpi_bpix;
  bi_i;
  iy_bpi.y;
  IF bpi.t=none THEN Error;
  IF bpi.wire AND bpi.beadU#noBead OR bpi.w<0 THEN RETURN;
  SELECT desP[bpi.t].level FROM
      level=>BEGIN
        s:[0..10000];
        ReadyBelow[low-delta,high+delta,i];
        FOR s IN [low..high) DO spit[s]_i; ENDLOOP;
        END;
      1-level=>ReadyBelow[low-2,high+2,i];
      ENDCASE;
  END;

ReadyBelow:PROCEDURE[lowE,highE:[0..10000],i:CARDINAL]=BEGIN
  s:[0..10000];  ss:CARDINAL;  bpss:BeadPtr;
  IF lowE NOT IN [0..maxX] THEN lowE_0;
  IF highE NOT IN [0..maxX] THEN highE_maxX;
  FOR s IN [lowE..highE)  DO 
    ss_spit[s];
    IF ss#noBead AND GetW[ss].seen#bi THEN BEGIN
      bpss_Get[ss];
      criticalC_bpss.circuit;
      criticalLevel_desP[bpss.t].level;
      LikelyBelow[ss];
      END;
    ENDLOOP;
  END;

LikelyBelow:PROCEDURE[j:CARDINAL]=BEGIN
  bpj:BeadPtr_Get[j];
  wpj:WorkPtr_GetW[j];
  IF j=noBead OR j=bi OR wpj.seen=bi OR bpj.circuit#criticalC THEN RETURN;
  wpj.seen_bi;
  flagBead_j;
  IF ~(bpj.wire AND bpj.beadU#noBead)
     AND StrictlyBelow[j]
     AND bpj.w>=0
     AND desP[bpj.t].level=criticalLevel
     AND ~(bpi.beadL=bpj.beadR AND bpi.beadL#noBead)
     AND ~(bpi.beadR=bpj.beadL AND bpi.beadR#noBead)
     THEN BEGIN
       flag_TRUE;
       IF TryAllBelow[bi,Dummy] THEN AddToBelow[bi,j];
       flag_FALSE;
       IF bpi.circuit=bpj.circuit THEN []_TryAllBelow[j,SeeThru];
       END;
  LikelyBelow[bpj.beadR];
  LikelyBelow[bpj.beadL];
  LikelyBelow[bpj.beadU];
  LikelyBelow[bpj.beadD];
  LikelyBelow[bpj.beadT];
  END;

SeeThru:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]=
 BEGIN LikelyBelow[j]; RETURN[TRUE]; END;

StrictlyBelow:PROCEDURE[j:CARDINAL] RETURNS[BOOLEAN]=BEGIN
  bpj:BeadPtr_Get[j];
  deltaX:INTEGER;
  bendableI:BOOLEAN_bendingWires AND bpi.wire;
  bendableJ:BOOLEAN_bendingWires AND bpj.wire;
  extraRightOfJ:INTEGER_0;
  extraLeftOfI:INTEGER_0;
  extraRightOfI:INTEGER_0;
  extraLeftOfJ:INTEGER_0;
  IF bendableI THEN extraRightOfI_IF Get[bpi.beadR].t=tt THEN 0 ELSE bpi.h;
  IF bendableI THEN extraLeftOfI_IF Get[bpi.beadL].t=tt THEN 0 ELSE bpi.h;
  IF bendableJ THEN extraRightOfJ_IF Get[bpj.beadR].t=tt THEN 0 ELSE bpj.h;
  IF bendableJ THEN extraLeftOfJ_IF Get[bpj.beadL].t=tt THEN 0 ELSE bpj.h;
  [deltaX,]_Deltas[bi,j];
  RETURN[ ~(bpj.wire AND bpj.beadR=noBead)
     AND bpi.x<bpj.x+bpj.w+deltaX+extraRightOfJ+extraLeftOfI
     AND bpj.x<bpi.x+bpi.w+deltaX+extraRightOfI+extraLeftOfJ
     AND bpj.y<=bpi.y];
  END;

criticalC:INTEGER;
criticalLevel:INTEGER;

Dummy:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN]=BEGIN
  Error;
  RETURN[TRUE];
  END;

AddToBelow:PROCEDURE[i,s:CARDINAL]=BEGIN
  bs_s; bps_Get[s];--really local
  timeV6_timeV6+1;
--   IODefs.WriteChar[CR ];
--   IODefs.WriteString["AddToBelow "];
--   IODefs.WriteNumber[i,  [10,FALSE,TRUE,3]];
--   IODefs.WriteNumber[s,  [10,FALSE,TRUE,3]];
  IF i>topBead OR s>topBead THEN Error;
  IF s=noBead THEN Error;
  IF bpi.wire AND bpi.beadR=noBead THEN Error;
  IF bps.wire AND bps.beadR=noBead THEN Error;
  IF desP[bpi.t].lessLevel#desP[bps.t].lessLevel THEN Error;
  IF bpi.beadL=bps.beadR AND bpi.beadL#noBead THEN Error;
  IF bpi.beadR=bps.beadL AND bpi.beadR#noBead THEN Error;
  IF bpi.y<bps.y THEN Error;--whether this is <= is very trickey
  InsertBelow[bpi,i,s];
  END;

InsertBelow:PROCEDURE[bpi:BeadPtr,i,s:CARDINAL]=BEGIN
  IF (topBelow_topBelow+1)=noBelow THEN Error;
  timeV5_timeV5+1;
  belowData[topBelow]_s;
  belowNext[topBelow]_bpi.nextBelow;
  bpi.nextBelow_topBelow;
  IF s=trackBead THEN WriteOneNumber["  Bead Above=",i];
  IF i=trackBead THEN WriteOneNumber["                      Bead Below=",s];
  END;

TryAllBelow:PUBLIC PROCEDURE[i:CARDINAL,call:ProcessPair] RETURNS[BOOLEAN]=
  BEGIN
  bpi:BeadPtr_Get[i];
  left:CARDINAL_bpi.beadL;
  right:CARDINAL_bpi.beadR;
  IF bpi.wire AND left=noBead THEN Error;
  IF processNo=177777B THEN BEGIN Error; MyResetBelow[]; END;
  processNo_processNo+1;
  RETURN[TryABeadAndItsTies[bpi,i,i,TRUE,call]
    AND TryABeadAndItsTies[bpi,i,left,FALSE,call]
    AND TryABeadAndItsTies[bpi,i,right,FALSE,call]
    AND TryJustBelow[bpi,i,i,call]
    AND (~bendingWires OR ~bpi.wire OR
      TryJustBelow[bpi,i,left,call] AND TryJustBelow[bpi,i,right,call])];
  END;

TryABeadAndItsTies:
  PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,q:BOOLEAN,call:ProcessPair]
  RETURNS[BOOLEAN]= BEGIN
  k:CARDINAL_j;
  pbj:BeadPtr_Get[j];
  pbk:BeadPtr;
  IF j=noBead THEN RETURN[TRUE];
  IF i#j AND ~CallBelow[bpi,i,j,call] THEN RETURN[FALSE];
  DO
    k_Get[k].beadT; pbk_Get[k];
    IF k=j OR k=noBead THEN RETURN[TRUE];
    IF (pbk.y<=pbj.y OR q) 
     AND ( ~CallBelow[bpi,i,k,call]
       OR pbk.y<=pbj.y
          AND (~CallBelow[bpi,i,pbk.beadR,call] OR ~CallBelow[bpi,i,pbk.beadL,call]))
          THEN RETURN[FALSE];
    IF desP[bpi.t].lessLevel=desP[pbk.t].lessLevel
          AND ~TryJustBelow[bpi,i,k,call] THEN RETURN [FALSE];
    ENDLOOP;
  END;

TryJustBelow:PROCEDURE[bpi:BeadPtr,i,s:CARDINAL,call:ProcessPair]
  RETURNS [t:BOOLEAN]=
  BEGIN
  j:CARDINAL_Get[s].beadD;
  k:CARDINAL_Get[j].beadD;
  l:CARDINAL_Get[k].beadT;
  m:CARDINAL_Get[l].beadT;
  t_ j=noBead OR k=noBead
     OR MeLeftRight[bpi,i,k,call] AND (l=noBead
             OR MeLeftRight[bpi,i,l,call] AND (m=k OR MeLeftRight[bpi,i,m,call]));
  IF ~t THEN RETURN[FALSE];
  FOR j_Get[s].nextBelow, belowNext[j] UNTIL j=noBelow
     DO IF ~MeLeftRight[bpi,i,belowData[j],call] THEN RETURN[FALSE]; ENDLOOP;
  RETURN[TRUE];
  END;

MeLeftRight:PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,call:ProcessPair] RETURNS [t:BOOLEAN]= BEGIN
    bpj:BeadPtr_Get[j];
    IF bpi.beadT=j OR bpj.beadT=i THEN Error;
    IF desP[bpi.t].lessLevel#desP[bpj.t].lessLevel THEN RETURN[TRUE];
    IF j=noBead THEN RETURN[TRUE];
    RETURN[cft[bpi,i,j,call]
       AND cft[bpi,i,bpj.beadR,call]
       AND cft[bpi,i,bpj.beadL,call]];
    END;

cft:PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,call:ProcessPair] RETURNS [t:BOOLEAN]= BEGIN
    bpj:BeadPtr;
    IF j=noBead THEN RETURN[TRUE];
    IF flag THEN RETURN[j#flagBead];
    bpj_Get[j];
    IF bpi.beadT=j OR bpj.beadT=i THEN Error;
    IF desP[bpi.t].lessLevel#desP[bpj.t].lessLevel THEN Error;
    RETURN[ GetW[j].processNo=processNo OR CallBelow[bpi,i,j,call]];
    END;

CallBelow:PROCEDURE[bpi:BeadPtr,i,j:CARDINAL,call:ProcessPair] RETURNS[BOOLEAN]=BEGIN
  wpj:WorkPtr;
  bpj:BeadPtr;
  IF j=noBead THEN RETURN[TRUE];
  IF flag THEN RETURN[j#flagBead];
  wpj_GetW[j];
  IF wpj.processNo=processNo THEN RETURN[TRUE];
  wpj.processNo_processNo;
  bpj_Get[j];
  IF wpj.oldY>=GetW[i].oldY+bpi.h AND desP[bpi.t].level#desP[bpj.t].level
     THEN RETURN[TRUE];
  IF desP[bpi.t].lessLevel#desP[bpj.t].lessLevel
     AND bpi.beadT#j AND bpj.beadT#i THEN RETURN[TRUE];
  IF j=i THEN RETURN[TRUE];--move up?
  RETURN[call[i,j]];
  END;

END..


(1792)\1156b13B398b9B205b10B30b9B879b9B4290i36I383b11B3079i10I