-- beadsFall.mesa
-- consists of 4 independent parts: Fall, Scavage, FixWires, Noodles To Beads

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

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

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

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

TrueFall:PUBLIC PROCEDURE= BEGIN
  EnumerateBeads[NewYGetsY];
  ResetBelow[];
  EnumerateSortedBottomUp[FallOne];
  FixWires[];
  END;

FallTwo:PUBLIC PROCEDURE[j:Desc,hm:INTEGER]=
  BEGIN IF BeadFall[j,hm] THEN FallOne[j]; END;

FallOne:PUBLIC PROCEDURE[i:Desc]= BEGIN
  IF VerticalWire[i] THEN RETURN; 
  UNTIL IF i.p.wire THEN ~WireFall[i] ELSE ~BeadFall[i,0] DO ENDLOOP;
  END;

WireFall:PUBLIC PROCEDURE[j:Desc] RETURNS[BOOLEAN]= BEGIN
  w:INTEGER_Height[j];
  bw:BentWireData;
  r:Desc_DescR[j];
  l:Desc_DescL[j];
  IF Type[j]=none OR ~j.p.wire THEN Error;
  BEGIN OPEN bw;
  NoName:PROCEDURE=BEGIN
    SELECT TRUE FROM
      (thisY>oldY AND DropSeg[j,thisX,nextX+w,oldY] OR thisY=oldY)
        AND old#topNoodle=>{MergeL[@bw]; done_TRUE};
      thisY>nextY AND DropSeg[j,thisX,nextX+w,nextY]
        AND (old#topNoodle OR ~Trans[l])=>{MergeR[@bw]; done_TRUE};
      ENDCASE;
    END;
  Getw[j].newY_Bot[j];
  StartBentWire[j.z,@bw];
  --here belongs the drop slide
  IF this#topNoodle THEN BEGIN
    FollowNoodle[j,@bw,NoName];
    IF done THEN RETURN[TRUE];
    IF  old#topNoodle AND ~Trans[r] THEN
      BEGIN nextY_Top[r]-w; NoName[]; IF done THEN RETURN[TRUE];
            nextY_Bot[r];   NoName[]; IF done THEN RETURN[TRUE]; END;
    END;
  RETURN[Bot[r]>thisY -- AND DropSeg[j,thisX,lastX+w,thisY] --
       AND BeadFall[r,Bot[r]-thisY]];
  END; END;

BeadFall:PUBLIC PROCEDURE[i:Desc,s:INTEGER] RETURNS[BOOLEAN]= BEGIN
  bw:BentWireData;
  BEGIN OPEN bw;
  r:Desc_DescR[i];
  d:Desc_DescD[i];
  rr:Desc_DescR[r];
  noLeft:BOOLEAN_NoBeadL[i];
  IF Type[i]=none THEN Error;
  IF ~NoBeadT[i] THEN RETURN[FALSE];
  IF NoBead[d] THEN-- IF s=0 THEN RETURN[FALSE] ELSE-- drop_maxY 
    ELSE {dd:Desc_DescD[d]; drop_Bot[i]-Top[dd]-Delta[i,dd].y};
  IF s#0 THEN drop_MIN[s,drop];
  IF drop<0 THEN Error;
  IF noLeft = (s=0) AND ~NoBead[r] THEN BEGIN
    Getw[r].newY_Bot[r];
    StartBentWire[r.z,@bw];
    IF this=topNoodle OR next=topNoodle AND nextX=lastX THEN dy_Bot[rr]-thisY;
    IF --this#topNoodle AND-- dy<0 THEN BEGIN
      drop_MIN[-dy,drop];
      IF drop#0 AND DropSeg[r,thisX,nextX,Bot[r]-drop]
            AND DropBead[i,Bot[i]-drop] THEN BEGIN
        MakeNewY[i];
        MakeNewY[r];
        IF drop=-dy AND this#topNoodle THEN BEGIN
            IncrementNoodle[next,dx,0];
            ReleaseNoodle[this,topNoodle,r];
            END
        ELSE IncrementNoodle[this,0,drop];
        RETURN[TRUE];
        END;
      END;
    END;
  IF s#0 AND (NoBead[r] OR noLeft)
     AND drop#0 AND DropBead[i,Bot[i]-drop] THEN BEGIN
     MakeNewY[i];
     IF noLeft THEN {[]_MakeNewNoodle[topNoodle,r.p,0,drop]; MakeNewY[r]};
     RETURN[TRUE];
     END;
  RETURN[FALSE];
  END; END;

MakeNewY:PROCEDURE[b:Desc]=BEGIN
  IncrementY[b,-drop];
  IF Bot[b]<0 THEN Seen2[];
  Track[b.z," dropped to ",Bot[b]];
  END;

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

Track:PUBLIC 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_0;

okL,okR,okY:INTEGER;

DropBead:PROCEDURE[i:Desc,y:INTEGER] RETURNS[BOOLEAN]=INLINE
  BEGIN RETURN[DropSeg[i,Lfm[i],Rtm[i],y]]; END;

DropSeg:PROCEDURE[i:Desc,l,r,y:INTEGER] RETURNS[BOOLEAN]= BEGIN
  okL_l; okR_r; okY_y;
  RETURN[l=r OR TryAllBelow[i,FallOk]];
  END;

FallOk:PROCEDURE[ii,jj:CARDINAL] RETURNS[BOOLEAN] =BEGIN
  IF jj=noBead OR ii=jj THEN RETURN[TRUE];
  BEGIN
  i:Desc_GetDesc[ii];
  j:Desc_GetDesc[jj];
  IF VerticalWire[j] OR Unrelated[i,j] OR LeftOf[i,j] OR LeftOf[j,i]
     THEN RETURN[TRUE];
  IF j.p.wire AND TestWireSegment[j,i,okL,okR,okY] THEN
    BEGIN Track[i.z," not prevented from falling by ",j.z]; RETURN[TRUE]; END;
  BEGIN
  delta:Coord_Delta[i,j];
  IF delta.x<0 THEN delta.x_0;
  IF ~j.p.wire AND
     ~(Lfm[j]<okR+delta.x AND Rtm[j]>okL-delta.x AND Top[j]>okY-delta.y)
          THEN RETURN[TRUE];
  Track[i.z," prevented from falling by ",j.z];
  RETURN[FALSE];
  END; END; END;

TestWireSegment:PROCEDURE[i,j:Desc,l,r,y:INTEGER] RETURNS[BOOLEAN] =BEGIN
--i is a wire, j is not
--why right edge and left edge?
  bw:BentWireData;
  BEGIN OPEN bw;
  w:INTEGER_Height[i];
  delta:Coord_Delta[i,j];
  IF delta.x<0 THEN delta.x_0;
  y_y-w-delta.y;
  Getw[i].newY_Bot[i];
  StartBentWire[i.z,@bw];
  BEGIN
  leftEdge:INTEGER_firstX+IfTranL[i,w+2];
  rightEdge:INTEGER_lastX-IfTranR[i,w+2];
  range1:INTEGER_l-w-delta.x;
  range2:INTEGER_r+delta.x;
  NoName:PROCEDURE=BEGIN
    IF thisX<range2 AND nextX>range1 AND thisY>y THEN done_TRUE;
--    IF MAX[thisX,leftEdge]<range2 AND MIN[nextX,rightEdge]>range1
--            AND thisY>y THEN {done_FALSE; RETURN};
    END;
  FollowNoodle[i,@bw,NoName];
  IF ~done THEN NoName[];
  RETURN[~done];
  END; END; END;


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

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

FixWire:PUBLIC PROCEDURE[i:Desc]=BEGIN
  IF VerticalWire[i]
    THEN {SetY[i,Top[DescD[i]]]; SetH[i,Bot[DescU[i]]-Bot[i]]};
  IF HorizontalWire[i]
    THEN {SetX[i,Rtm[DescL[i]]]; SetW[i,Lfm[DescR[i]]-Lfm[i]]};
  END;

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

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

TurnWire:PUBLIC PROCEDURE[i:Desc]= BEGIN
  IF HorizontalWire[i] THEN BEGIN
  w:INTEGER=Height[i];
  type:BeadType_Type[i];
  jct:BeadType_SELECT type FROM wireR=>jctnR, wireB=>jctnB, ENDCASE=>jctnG;
  DO
    chn:CARDINAL; dx,dy:INTEGER;
    this:CARDINAL_i.p.noodle;
    l:Desc_DescL[i];
    r:Desc_DescR[i];
    IF this=topNoodle THEN BEGIN
      dy1:INTEGER_Bot[r]-Bot[i];
      dy2:INTEGER_Top[r]-Top[i];
      dy_MIN[MAX[dy1,dy2],MAX[dy1,0], MAX[dy2,0]];
      dx_Lfm[r]-Lfm[i]+w;
      END
    ELSE [dx,dy,chn]_GetNoodle[this];
    BEGIN
    short:BOOLEAN_ dx=0 AND this#topNoodle
       AND (IF dy<0 THEN NoBeadD[l] ELSE NoBeadU[l]);
    IF dx=0 AND this#topNoodle AND Height[l]#w THEN BEGIN
       Jig:PROCEDURE[a:INTEGER]={IncrementNoodle[this,0,-a]; IncrementY[i,a]};
       dy1:INTEGER_Bot[l]-Bot[i];
       dy2:INTEGER_Top[l]-Top[i];
       IF dy<0 AND dy1<0 THEN {Jig[MAX[dy,dy1]]; LOOP};
       IF dy>0 AND dy2>0 THEN {Jig[MIN[dy,dy2]]; LOOP};
       END;
    IF dy=0 AND this=topNoodle AND ~short THEN EXIT;
    IF (dy#0 OR dx#0) AND (this=topNoodle OR Lfm[i]+dx#Lfm[r]+w) THEN BEGIN
      n:Desc=GetDesc[noBead];
      a:Desc_IF short THEN n ELSE MakeBead[type,i];
      b:Desc_IF short THEN l ELSE MakeBead[jct ,i];
      c:Desc_IF dy=0  THEN n ELSE MakeBead[type,i];
      d:Desc_IF dy=0  THEN b ELSE MakeBead[jct ,i];
      l.p.beadR_noBead;
      i.p.beadL_d.z; d.p.beadR_i.z;
      IF ~NoBead[a] THEN {HookLR[l,a]; HookLR[a,b]};
      IF ~NoBead[c] THEN BEGIN
        IF dy<0 THEN {HookUD[d,c]; HookUD[c,b]}
                ELSE {HookUD[b,c]; HookUD[c,d]};
        END;
      IF ~NoBead[a] THEN {b.p.x_Lfm[i]+dx-w; a.p.y_b.p.y_Bot[i]; FixWire[a]};
      IF ~NoBead[c] THEN {c.p.x_d.p.x_Lfm[i]+dx-w;d.p.y_Bot[i]+dy;FixWire[c]};
      IncrementY[i,dy];
      FixWire[i];
      END;
    IF this=topNoodle THEN EXIT;
    i.p.noodle_chn;
    END; ENDLOOP;
  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 

MakeBead:PROCEDURE[type:BeadType,i:Desc] RETURNS[k:Desc]= BEGIN
 k_GetFreeBead[];
 k.p.t_type;
 k.p.w_k.p.h_Height[i];
 k.p.wire_Wire[k];
 k.p.circuit_i.p.circuit;
 END;

GetFreeBead:PUBLIC PROCEDURE RETURNS[i:Desc]=BEGIN
  i_GetDesc[freeBeadList];
  IF i.z NOT IN [0..noBead] THEN Error;
  IF freeBeadList#noBead THEN
    BEGIN i_GetDesc[freeBeadList];
     freeBeadList_i.p.beadT; topBead_MAX[topBead,i.z]; END
  ELSE BEGIN
    Error;
    IF topBead=noBead-1 THEN SIGNAL NoMoreBeads ELSE topBead_topBead+1;
    i_GetDesc[topBead];
    END;
  i.p.noodle_topNoodle;
  i.p.nextBelow_noBelow;
  i.p.beadR_i.p.beadL_i.p.beadU_i.p.beadD_i.p.beadT_noBead;
  i.p.external_0;
  END;

END..
(1792)\1445i31I3183i23I