-- beadsFall4.mesa  September 15, 1979  1:16 PM
-- long pointers

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

Error:SIGNAL=CODE;
NoMoreBeads:SIGNAL=CODE;

freeNoodleChain:PUBLIC CARDINAL;

--////// UTILITIES //////

KeepMesaHappy:PROCEDURE =BEGIN IODefs.WriteChar['*]; END;

StartBentWire:PUBLIC PROCEDURE[i:CARDINAL,bw:BentWire] =BEGIN OPEN bw;
   bpi:BeadPtr_Get[i]; wpi:WorkPtr_GetW[i];
   oldOld_ old_topNoodle;   this_bpi.noodle;   next_noodleChain[this];
   oldX_ firstX_ thisX_bpi.x-bpi.h;   lastX_bpi.x+bpi.w;
   oldY_ thisY_wpi.newY;
   olddx_ olddy_0;
   dx_noodleDX[this];   dy_noodleDY[this];
   IF this=topNoodle THEN dx_lastX-thisX;
   nextX_ thisX+ dx;   nextY_ thisY+ dy;
   nextdx_noodleDX[ next];   nextdy_noodleDY[ next];
  END;

AdvanceBentWire:PUBLIC PROCEDURE[bw:BentWire] =BEGIN OPEN bw;
   oldOld_old;   old_ this;   this_ next;   next_noodleChain[this];
   oldX_ thisX;   oldY_ thisY;
   thisX_ nextX;   thisY_ nextY;
   dx_noodleDX[this];   dy_noodleDY[this];
   IF this=topNoodle THEN dx_lastX-thisX;
   olddx_noodleDX[ old];   olddy_noodleDY[ old];
   nextX_ thisX+ dx;   nextY_ thisY+ dy;
   nextdx_noodleDX[ next];   nextdy_noodleDY[ next];
  END;


GetFreeNoodle:PROCEDURE RETURNS[a:CARDINAL] =BEGIN
  a_freeNoodleChain;
  IF a>=topNoodle-1 THEN Error;--not enough noodles
  freeNoodleChain_noodleChain[a];
  END;

ReleaseNoodle:PROCEDURE[a:CARDINAL] =BEGIN
  IF a>topNoodle THEN Error;
  noodleChain[a]_freeNoodleChain;
  freeNoodleChain_a;
  END;

ChangeNoodle:PROCEDURE[this,chain:CARDINAL,x,y:INTEGER] =BEGIN
  IF this=topNoodle THEN Error;
  IF chain>topNoodle THEN Error;
  noodleDY[this]_y;
  noodleDX[this]_x;
  noodleChain[this]_chain;
  END;

IncrementNoodle:PROCEDURE[this:CARDINAL,x,y:INTEGER] =BEGIN
  IF this=topNoodle THEN RETURN;
  noodleDY[this]_noodleDY[this]+y;
  noodleDX[this]_noodleDX[this]+x;
  END;

ChangeNoodleChain:PROCEDURE[this,chain:CARDINAL] =BEGIN
  IF this>=topNoodle THEN Error;
  IF chain>topNoodle THEN Error;
  noodleChain[this]_chain;
  END;

MergeLeft:PUBLIC PROCEDURE[j,old:CARDINAL]=BEGIN
  this:CARDINAL;
  this_IF old=topNoodle THEN Get[j].noodle ELSE noodleChain[old];
  IncrementNoodle[old,noodleDX[this],noodleDY[this]];
  ReleaseLink[j,old];
  END;

MergeRight:PUBLIC PROCEDURE[j,old:CARDINAL]=BEGIN
  this:CARDINAL_IF old=topNoodle THEN Get[j].noodle ELSE noodleChain[old];
  IF this>=topNoodle THEN Error;
  IncrementNoodle[noodleChain[this],noodleDX[this],0];
  IncrementNoodle[old,0,noodleDY[this]];
  ReleaseLink[j,old];
  END;

ReleaseLink:PUBLIC PROCEDURE[j,old:CARDINAL]=BEGIN
  this:CARDINAL; bpj:BeadPtr;
  IF old>topNoodle THEN Error;
  IF old=topNoodle
   THEN BEGIN bpj_Get[j]; bpj.noodle_noodleChain[this_bpj.noodle]; END
   ELSE noodleChain[old]_noodleChain[this_noodleChain[old]];
  IF this>=topNoodle THEN Error;
  ReleaseNoodle[this];
  END;

--////// FALL //////

Fall:PUBLIC PROCEDURE= BEGIN
  seen2_0;
  ResetBelow[];
  EnumerateSortedBottomUp[FallOne];
  END;

FallOne:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  IF bpi.wire AND bpi.beadR=noBead THEN RETURN; 
  UNTIL IF bpi.wire THEN ~WireFall[i] ELSE ~BeadFall[i,0]
    DO ENDLOOP;
  END;

WireFall:PUBLIC PROCEDURE[j:CARDINAL] RETURNS[BOOLEAN]= BEGIN
  bpj:BeadPtr_Get[j];
  w:INTEGER_bpj.h;
  bw:BentWireData;
  right:CARDINAL_bpj.beadR;
  bpr:BeadPtr_Get[right];
  left:CARDINAL_bpj.beadL;
  bpl:BeadPtr_Get[left];
  bot:INTEGER_bpr.y;
  top:INTEGER_bot+bpr.h-w;
  transRight:BOOLEAN_SELECT bpr.t FROM tt,dd,ttV,ddV=>TRUE, ENDCASE=>FALSE;
  transLeft :BOOLEAN_SELECT bpl.t FROM tt,dd,ttV,ddV=>TRUE, ENDCASE=>FALSE;
  IF bpj.t=none THEN Error;
  BEGIN OPEN bw;  GetW[j].newY_bpj.y;  StartBentWire[j,@bw];
  --here belongs the drop slide
--  IF j=211 THEN Error;
  IF this#topNoodle THEN BEGIN
  IF thisY>nextY AND dx#0 AND ~transLeft AND DropSeg[j,thisX,nextX+w,nextY]
    THEN BEGIN
      IncrementNoodle[this,-dx,0]; IncrementNoodle[next,dx,0]; RETURN[TRUE];
      END;

  UNTIL this=topNoodle DO IF old#topNoodle THEN BEGIN
    IF thisY>oldY AND DropSeg[j,thisX,nextX+w,oldY] OR thisY=oldY
      THEN BEGIN MergeLeft[j,old]; RETURN[TRUE]; END;
    IF thisY>nextY AND DropSeg[j,thisX,nextX+w,nextY]
      THEN BEGIN MergeRight[j,old]; RETURN[TRUE]; END;
    END;
    AdvanceBentWire[@bw];
    ENDLOOP;

  IF  old#topNoodle AND ~transRight THEN BEGIN
    return:BOOLEAN_TRUE;
    SELECT TRUE FROM
      thisX=lastX AND oldOld#topNoodle=>ReleaseLink[j,oldOld];
      thisY IN [bot..top] AND thisY=oldY=>ReleaseLink[j,oldOld]; 
      thisY>oldY AND DropSeg[j,thisX,lastX+w,oldY]=>
          IF thisX=lastX THEN IncrementNoodle[old,0,oldY-thisY]
                         ELSE IncrementNoodle[old,lastX-thisX,0];
      thisY>top AND DropSeg[j,thisX,lastX+w,top]=>
          IncrementNoodle[old,0,top-thisY];
      thisY>bot AND bot>=oldY AND DropSeg[j,thisX,lastX+w,bot]=>
          IncrementNoodle[old,0,bot-thisY];
      ENDCASE=>return_FALSE;
    IF return THEN RETURN[TRUE];
    END;
  END;
  RETURN[bot>thisY -- AND DropSeg[j,thisX,lastX+w,thisY] --
       AND BeadFall[right,bot-thisY]];
  END; END;

BeadFall:PUBLIC PROCEDURE[i:CARDINAL,s:INTEGER] RETURNS[BOOLEAN]= BEGIN
  bw:BentWireData;
  BEGIN OPEN bw;
  bpi:BeadPtr_Get[i];
  right:CARDINAL_bpi.beadR; bpr:BeadPtr_Get[right];
  dblRight:CARDINAL_bpr.beadR; bprr:BeadPtr_Get[dblRight];
  left:CARDINAL_bpi.beadL;
  down:CARDINAL_bpi.beadD;
  noLeft:BOOLEAN_left=noBead;
  IF bpi.t=none THEN Error;
  IF bpi.beadT#noBead THEN RETURN[FALSE];
  IF down=noBead THEN-- IF s=0 THEN RETURN[FALSE] ELSE-- drop_maxY 
     ELSE BEGIN
     deltaY:INTEGER;
     dblDown:CARDINAL_Get[down].beadD;
     bpdd:BeadPtr_Get[dblDown];
     [,deltaY]_Deltas[i,dblDown];
     drop_bpi.y-bpdd.y-bpdd.h-deltaY;
     END;
  IF s#0 THEN drop_MIN[s,drop];
  IF drop<0 THEN Error;
  IF (noLeft AND s=0 OR s#0 AND ~noLeft) AND right#noBead THEN BEGIN
    GetW[right].newY_bpr.y;
    StartBentWire[right,@bw];
    IF this=topNoodle OR next=topNoodle AND nextX=lastX THEN dy_bprr.y-thisY;
    IF --this#topNoodle AND-- dy<0 THEN BEGIN
      drop_MIN[-dy,drop];
      IF drop#0 AND DropSeg[right,thisX,nextX,bpr.y-drop]
            AND DropBead[i,bpi.y-drop] THEN BEGIN
        bpi.y_bpi.y-drop;
        bpr.y_bpr.y-drop;
        IF bpi.y<0 OR bpr.y<0 THEN Seen2[];
        Track[i," dropped to ",bpi.y];
        Track[right," dropped to ",bpr.y];
        IF drop=-dy AND this#topNoodle THEN BEGIN
            bpr.noodle_next;
            IncrementNoodle[next,dx,0];
            ReleaseNoodle[this];
            END
        ELSE IncrementNoodle[this,0,drop];
        RETURN[TRUE];
        END;
      END;
    END;
  IF s#0 AND (right=noBead OR noLeft)
     AND drop#0 AND DropBead[i,bpi.y-drop] THEN BEGIN
     bpi.y_bpi.y-drop;
     IF bpi.y<0 THEN Error;
     Track[i," dropped to ",bpi.y];
     IF noLeft THEN BEGIN
       this:CARDINAL_GetFreeNoodle[];
       bpr.y_bpr.y-drop;
       IF bpr.y<0 THEN Error;
       Track[right," dropped to ",bpr.y];
       ChangeNoodle[this,bpr.noodle,0,drop];
       bpr.noodle_this;
       END;
     RETURN[TRUE];
     END;
  RETURN[FALSE];
  END; END;

Seen2:PROCEDURE=
  BEGIN IF seen2=0 THEN Error; IF (seen2_seen2+1)>5000 THEN seen2_0; END;

Track:PROCEDURE[i:CARDINAL,s:STRING,y:INTEGER]=BEGIN OPEN IODefs;
  IF i#trackBead THEN RETURN;
  WriteChar[CR];
  WriteNumber[i,  [10,FALSE,TRUE,5]];
  WriteString[s];
  WriteNumber[y,  [10,FALSE,TRUE,5]];
  END;

drop,seen2:INTEGER;

okL,okR,okY:INTEGER;

DropBead:PROCEDURE[i:CARDINAL,y:INTEGER] RETURNS[BOOLEAN]=BEGIN
  bpi:BeadPtr_Get[i];
  okL_bpi.x; okR_okL+bpi.w; okY_y;
  RETURN[TryAllBelow[i,FallOk]];
  END;

DropSeg:PROCEDURE[i:CARDINAL,l,r,y:INTEGER] RETURNS[BOOLEAN]= BEGIN
  IF l=r THEN RETURN[TRUE];
  okL_l; okR_r; okY_y;
  RETURN[TryAllBelow[i,FallOk]];
  END;

FallOk:PROCEDURE[i,j:CARDINAL] RETURNS[BOOLEAN] =BEGIN
  bpi:BeadPtr_Get[i];
  bpj:BeadPtr_Get[j];
  deltaX,deltaY:INTEGER;
--  IF bendingWires AND i=761 AND j=551 THEN Error;
  IF j=noBead
     OR i=j
     OR bpj.wire AND bpj.beadR=noBead
     OR desP[bpi.t].lessLevel#desP[bpj.t].lessLevel
     OR bpi.beadL=bpj.beadR
     OR bpi.beadR=bpj.beadL
     OR j=bpi.beadR
     OR j=bpi.beadL
     THEN RETURN[TRUE];
  IF bpj.wire AND TestWireSegment[j,i,okL,okR,okY] THEN
    BEGIN Track[i," not prevented from falling by ",j]; RETURN[TRUE]; END;
  [deltaX,deltaY]_Deltas[i,j];
  IF deltaX<0 THEN deltaX_0;
  IF ~bpj.wire AND
     ~(bpj.x<okR+deltaX AND bpj.x+bpj.w>okL-deltaX AND bpj.y+bpj.h>okY-deltaY)
          THEN RETURN[TRUE];
  Track[i," prevented from falling by ",j];
  RETURN[FALSE];
  END;

TestWireSegment:PROCEDURE[i,j:CARDINAL,l,r,y:INTEGER] RETURNS[BOOLEAN] =BEGIN
--i is a wire, j is not
--why right edge and left edge?
  bpi:BeadPtr_Get[i];
  bw:BentWireData;
  BEGIN OPEN bw;
  w:INTEGER_bpi.h;
  deltaX,deltaY,range1,range2,leftEdge,rightEdge:INTEGER;
  GetW[i].newY_bpi.y;
  StartBentWire[i,@bw];
  leftEdge_firstX+IfTrans[bpi.beadL,w+2];
  rightEdge_lastX-IfTrans[bpi.beadR,w+2];
  [deltaX,deltaY]_Deltas[i,j];
  IF deltaX<0 THEN deltaX_0;
  range1_l-w-deltaX;
  range2_r+deltaX;
  y_y-w-deltaY;
  UNTIL this=topNoodle DO
    IF thisX<range2 AND nextX>range1 AND thisY>y THEN RETURN[FALSE];
--    IF MAX[thisX,leftEdge]<range2 AND MIN[nextX,rightEdge]>range1
--            AND thisY>y THEN RETURN[FALSE];
    AdvanceBentWire[@bw];
    ENDLOOP;
  IF thisX<range2 AND lastX>range1 AND thisY>y THEN RETURN[FALSE];
--  IF MAX[thisX,leftEdge]<range2 AND MIN[r,rightEdge]>range1
--            AND thisY>y THEN RETURN[FALSE];
  RETURN[TRUE];
  END; END;


--////// FIX WIRES //////

FixWires:PUBLIC PROCEDURE= BEGIN EnumerateBeads[FixWire]; END;

FixWire:PUBLIC PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
  IF ~bpi.wire THEN RETURN;
  IF bpi.beadU#noBead THEN BEGIN
    bpd:BeadPtr_Get[bpi.beadD];
    bpi.y_bpd.y+bpd.h;
    bpi.h_Get[bpi.beadU].y-bpi.y;
    END ELSE BEGIN
    bpl:BeadPtr_Get[bpi.beadL];
    bpi.x_bpl.x+bpl.w;
    bpi.w_Get[bpi.beadR].x-bpi.x;
    END;
  END;

--////// TURN NOODLES TO BEADS //////

TurnWiresToBeads:PUBLIC PROCEDURE= BEGIN EnumerateBeads[TurnWire]; END;

TurnWire:PUBLIC PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  left,right,this:CARDINAL; dx,dy:INTEGER; short:BOOLEAN;
  bpr,bpl:BeadPtr;
  w:INTEGER_bpi.h;
  type:BeadType_bpi.t;
  jct:BeadType_SELECT type FROM wireR=>jctnR, wireB=>jctnB, ENDCASE=>jctnG;
  IF ~(bpi.wire AND bpi.beadU=noBead) THEN RETURN;
  DO
    this_bpi.noodle;
    left_bpi.beadL; bpl_Get[left];
    right_bpi.beadR; bpr_Get[right];
    IF this=topNoodle
    THEN BEGIN
      dy1:INTEGER_bpr.y-bpi.y;
      dy2:INTEGER_dy1+bpr.h-bpi.h;
      dy_MIN[MAX[dy1,dy2],MAX[dy1,0], MAX[dy2,0]];
      dx_bpr.x-bpi.x+w;
      END
    ELSE BEGIN dx_noodleDX[this]; dy_noodleDY[this]; END;
    short_ dx=0 AND this#topNoodle
       AND noBead=(IF dy<0 THEN bpl.beadD ELSE bpl.beadU);
    IF dx=0 AND this#topNoodle AND bpl.h#w THEN BEGIN
       dy1:INTEGER_bpl.y-bpi.y;
       dy2:INTEGER_bpl.y+bpl.h-bpi.y-w;
       IF dy<0 AND dy1<0 THEN BEGIN
         noodleDY[this]_noodleDY[this]-MAX[dy,dy1];
         bpi.y_bpi.y+MAX[dy,dy1];
         LOOP;
         END;
       IF dy>0 AND dy2>0 THEN BEGIN
         noodleDY[this]_noodleDY[this]-MIN[dy,dy2];
         bpi.y_bpi.y+MIN[dy,dy2];
         LOOP;
         END;
       END;
    IF dy=0 AND this=topNoodle AND ~short THEN EXIT;
    IF (dy#0 OR dx#0) AND (this=topNoodle OR bpi.x+dx#bpr.x+w)
    THEN BEGIN
      a:CARDINAL_IF short THEN noBead ELSE MakeBead[type,bpi,i];
      b:CARDINAL_IF short THEN left   ELSE MakeBead[jct,bpi,i];
      c:CARDINAL_IF dy=0  THEN noBead ELSE MakeBead[type,bpi,i];
      d:CARDINAL_IF dy=0  THEN b      ELSE MakeBead[jct,bpi,i];
      bpa:BeadPtr_Get[a];
      bpb:BeadPtr_Get[b];
      bpc:BeadPtr_Get[c];
      bpd:BeadPtr_Get[d];
      bpl.beadR_noBead;
      bpi.beadL_d; bpd.beadR_i;
      IF a#noBead THEN BEGIN
        bpa.beadL_left; bpl.beadR_a;
        bpb.beadL_a; bpa.beadR_b;
        END;
      IF c#noBead THEN BEGIN
        IF dy<0 THEN BEGIN
          bpc.beadU_b; bpb.beadD_c;
          bpd.beadU_c; bpc.beadD_d;
          END
        ELSE BEGIN
          bpc.beadD_b; bpb.beadU_c;
          bpd.beadD_c; bpc.beadU_d;
          END;
        END;
      IF a#noBead THEN BEGIN
        bpb.x_bpi.x+dx-w;
        bpa.y_bpb.y_bpi.y;
        FixWire[a,bpa];
        END;
      IF c#noBead THEN BEGIN
        bpc.x_bpd.x_bpi.x+dx-w;
        bpd.y_bpi.y+dy;
        FixWire[c,bpc];
        END;
      bpi.y_bpi.y+dy;
      FixWire[i,bpi];
      END;
    IF this=topNoodle THEN EXIT;
    bpi.noodle_noodleChain[this];
    ENDLOOP;
  END;

--///////////  SCOUR  /////

ScourBeads:PUBLIC PROCEDURE=BEGIN
  EnumerateBeads[ScourBead];
  FixWires[];
  END;

ScourBead:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
  conu,cond,room:BOOLEAN;
  up:CARDINAL_bpi.beadU;
  down:CARDINAL_bpi.beadD;
  bpu:BeadPtr_Get[up];
  bpd:BeadPtr_Get[down];
  IF bpi.t=none THEN Error;
  IF ~bpi.wire THEN BEGIN
     left:CARDINAL_bpi.beadL;
     right:CARDINAL_bpi.beadR;
     bpl:BeadPtr_Get[left];
     bpr:BeadPtr_Get[right];
     SELECT bpi.t FROM jctnG,jctnR,jctnB=>NULL; ENDCASE=>RETURN;
     SELECT TRUE FROM
     left=noBead AND right=noBead=>BEGIN
       IF up=noBead OR down=noBead THEN Error;
       bpd.beadU_bpu.beadU;
       Get[bpd.beadU].beadD_down;
       ReleaseBead[up];
       FixWire[down,bpd];
       END;
     up=noBead AND down=noBead=>BEGIN
       IF left=noBead OR right=noBead THEN Error;
       bpl.beadR_bpr.beadR;
       Get[bpl.beadR].beadL_left;
       ReleaseBead[right];
       FixWire[left,bpl];
       END;
     ENDCASE=>RETURN;
     ReleaseBead[i];
     RETURN;
     END;
  IF bpi.beadL#noBead THEN RETURN;
  IF bpu.y>=bpd.y+bpd.h+8 THEN RETURN;
  room_(bpu.beadL=noBead OR bpd.beadL=noBead)
     AND (bpu.beadR=noBead OR bpd.beadR=noBead);
  SELECT bpu.t FROM
    jctnG,jctnR,jctnB=>conu_FALSE; bg,rb,bf=>conu_TRUE; ENDCASE=>RETURN;
  SELECT bpd.t FROM
    jctnG,jctnR,jctnB=>cond_FALSE; bg,rb,bf=>cond_TRUE; ENDCASE=>RETURN;
  IF bpu.y+bpu.h<=bpd.y+bpd.h AND ~conu AND room THEN BEGIN
        Fix[leftRight,up,down];
        bpd.beadU_bpu.beadU;
        Get[bpd.beadU].beadD_down;
        ReleaseBead[up];
        ReleaseBead[i];
        RETURN;
        END;
  IF bpu.y<=bpd.y AND ~cond AND room THEN BEGIN
        Fix[leftRight,down,up];
        bpu.beadD_bpd.beadD;
        Get[bpu.beadD].beadU_up;
        ReleaseBead[down];
        ReleaseBead[i];
        RETURN;
        END;
  IF conu AND cond AND bpu.x=bpd.x AND bpu.y=bpd.y
     AND bpu.h=bpd.h AND bpu.w=bpd.w
     AND room THEN BEGIN
      s:CARDINAL_bpu.beadT; bps:BeadPtr_Get[s];
      t:CARDINAL_bpd.beadT; bpt:BeadPtr_Get[t];
      hooked:BOOLEAN_bps.beadD=bpt.beadU AND bps.beadD#noBead;
      IF bps.beadT=up AND bpt.beadT=down 
      AND (bps.beadL=noBead OR bpt.beadL=noBead)
      AND (bps.beadR=noBead OR bpt.beadR=noBead)
      AND (hooked OR (bps.beadU=noBead OR bpt.beadU=noBead)
                 AND (bps.beadD=noBead OR bpt.beadD=noBead))
      THEN BEGIN
        IF bps.beadD#noBead AND bpt.beadU#noBead AND bps.beadD#bpt.beadU
          THEN RETURN;
        Fix[leftRight,down,up];
        bpu.beadD_bpd.beadD;
        Get[bpu.beadD].beadU_up;
        ReleaseBead[down];
        ReleaseBead[i];
        Fix[leftRight,t,s];
        IF hooked THEN  Get[bps.beadD_bpt.beadD].beadU_s
                  ELSE Fix[upDown,t,s];
        IF hooked THEN ReleaseBead[bpt.beadU];
        ReleaseBead[t];
        END;
      END;
  END;

udlr:TYPE={leftRight,upDown};

Fix:PROCEDURE[dir:udlr,a,b:CARDINAL]=BEGIN try:CARDINAL;
  bpa:BeadPtr_Get[a]; bpb:BeadPtr_Get[b];
  SELECT dir FROM
  leftRight=>BEGIN
      IF (try_bpa.beadL)#noBead
        THEN BEGIN Get[try].beadR_b; bpb.beadL_try; END;
      IF (try_bpa.beadR)#noBead
        THEN BEGIN Get[try].beadL_b; bpb.beadR_try; END;
      END;
  ENDCASE=>BEGIN
      IF (try_bpa.beadU)#noBead
        THEN BEGIN Get[try].beadD_b; bpb.beadU_try; END;
      IF (try_bpa.beadD)#noBead
        THEN BEGIN Get[try].beadU_b; bpb.beadD_try; END;
      END;
  END;


-- ////////  MAKING AND DESTROYING BEADS  ////////
   -- //// GetFreeBead - the bead is trash
   -- //// ReleaseBead
   -- //// ScavageBeads - scavage the tables 
   -- //// MakeBead[type,bpi,i] gets a bead similar to bpi 

freeBeadList:CARDINAL;

MakeBead:PROCEDURE[type:BeadType,bpi:BeadPtr,i:CARDINAL] RETURNS[k:CARDINAL]= BEGIN
 bpk:BeadPtr;
 k_GetFreeBead[]; bpk_Get[k];
 bpk.t_type;
 bpk.beadR_bpk.beadL_bpk.beadU_bpk.beadD_bpk.beadT_noBead;
 bpk.w_bpk.h_bpi.h;
 bpk.wire_SELECT type FROM wireR, wireB, wireG=>TRUE, ENDCASE=>FALSE;
 bpk.noodle_topNoodle;
 bpk.nextBelow_noBelow;
 bpk.circuit_bpi.circuit;
 bpk.external_0;
 END;

GetFreeBead:PROCEDURE RETURNS[i:CARDINAL]=BEGIN
  i_freeBeadList;
  IF i#noBead THEN freeBeadList_Get[i].beadT
  ELSE BEGIN
    IF topBead=noBead-1 THEN SIGNAL NoMoreBeads;
    i_topBead_topBead+1;
    END;
  END;

ReleaseBead:PROCEDURE[i:CARDINAL]=BEGIN bpi:BeadPtr;
    bpi_Get[i];
    bpi.t_none;
    bpi.beadT_freeBeadList;
    bpi.wire_FALSE;
    freeBeadList_i;
  END;

ScavageBeads:PUBLIC PROCEDURE=BEGIN i:CARDINAL;
  FOR i DECREASING IN [0..topBead]
    DO IF Get[i].t=none THEN TrueReleaseBead[i]; ENDLOOP;
  freeBeadList_noBead;
  END;

TrueReleaseBead:PROCEDURE[i:CARDINAL]=BEGIN s,j:CARDINAL;
  IF i>topBead THEN Error;
  IF i#topBead THEN BEGIN
    bpi:BeadPtr_Get[i];
    bpi^_Get[topBead]^;
    Get[bpi.beadR].beadL_i;
    Get[bpi.beadL].beadR_i;
    Get[bpi.beadU].beadD_i;
    Get[bpi.beadD].beadU_i;
    IF bpi.beadT#noBead THEN BEGIN
      FOR s_i,j UNTIL (j_Get[s].beadT)=topBead DO ENDLOOP;
      Get[s].beadT_i;
      END;
    END;
  Track[i," released  ",0];
  Track[topBead," renamed to  ",i];
  --trackBead_SELECT trackBead FROM i=>noBead, topBead=>i, ENDCASE=>trackBead;
  topBead_topBead-1;
  END;


END..

  IF bpi.t=wireR AND Get[j].t=wireG AND Get[j].w>32 AND bendingWires
     AND FALSE THEN BEGIN
    IODefs.WriteChar[CR];
    IODefs.WriteNumber[j,  [10,FALSE,TRUE,5]];
    IODefs.WriteString["  width  "];
    IODefs.WriteNumber[Get[j].w,  [10,FALSE,TRUE,5]];
    IODefs.WriteString["  y  "];
    IODefs.WriteNumber[Get[j].y,  [10,FALSE,TRUE,5]];
    IODefs.WriteString["  pushing  "];
    IODefs.WriteNumber[i,  [10,FALSE,TRUE,5]];
    END;

Fall:  The intent of Fall is to try to let each bead move down in such a way that horizontal wires get straightened out and vertical wires get shortened ( if that is convenient and legal) There are several reasons to implement fall:
  1) a bent wire uses up more computer storage than a straight(er) one
  2) some cases of fall produce less colored area locally, which is electrically better.
  3) unnecessarily bent wires tend to inhibit further progress in compressing the diagram in the other dimension.

WireFall[i]: The intent of wire fall is to examine a horizontal wire for bends, and to straighten out the bends by dropping the higher wire segment if that is possible. There are three cases - a bend up, a bend down, and a bend of height 0 (not fundamental, but this is a good place to get rid of them). The details are complicated at each end by several constraints: a segment anchored to a transistor cannot drop, a segment anchored to a bead of larger width may slide along that bead, and should do so according to rules which depend on the next segment over, and one must watch out for zero width segments at the ends. WireFall mainpulates noodles directly.

 

(1792)\3819i31I4935i23I