-- beadsPut.mesa

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

Error:SIGNAL=CODE;

StartIncrementalDisplay:PROCEDURE=BEGIN END;
IncrementalDisplay:PROCEDURE=BEGIN END;
EndIncrementalDisplay:PROCEDURE=BEGIN END;

howMuch:PUBLIC [0..256);
cnt1,cnt2,cnt3,cnt4,cnt5,cnt6,cnt7,cnt8:LONG CARDINAL;
pushingY:[0..1024);
--i is the bead being processed (pushing j)
bi,bj:Desc;
delta:Coord;
wpi,wpj:WorkPtr;
iy,ih,jy,jh:INTEGER;
gain:INTEGER;



PositionBeads:PUBLIC PROCEDURE= BEGIN
  seen_seen1_seen2_FALSE; ClearCounts[]; InitNoodle[];
  EnumerateBeads[InitBackSortAndProcessed];
  StartIncrementalDisplay[];
  FOR pushingY_0,pushingY+1 UNTIL pushingY>topBead
    DO PlaceABead[GetDesc[GetW[pushingY].sort]]; ENDLOOP;
  EndIncrementalDisplay[];
  gain_maxY;
  EnumerateBeads[FindGain];
  EnumerateBeads[MoveDown];
  PrintCounts[];
  END;

PlaceABead:PROCEDURE[i:Desc]= BEGIN
  bi_i; wpi_Getw[i]; iy_wpi.newY; ih_Height[i];
  IF ~wpi.processed AND Type[i]#none THEN
      BEGIN cnt1_cnt1+1; []_TryAllBelow[i.z,Shoot]; END;
  wpi.processed_TRUE;
  IncrementalDisplay[];
  END;

ClearCounts:PROCEDURE= BEGIN cnt1_cnt2_cnt3_cnt4_cnt5_cnt6_cnt7_cnt8_0; END;

InitBackSortAndProcessed:PROCEDURE[i:Desc]=BEGIN
  wpi_Getw[i];
  GetW[wpi.sort].backSort_i.z;
  wpi.processed_VerticalWire[i];
  END;

Shoot:PROCEDURE[i,j:CARDINAL] RETURNS[ok:BOOLEAN] =BEGIN
  ok_TRUE;
  bj_GetDesc[j];  wpj_Getw[bj]; jy_Bot[bj]; jh_Height[bj];
  delta_Delta[bi,bj];
  delta.x_MAX[0,delta.x];
  cnt2_cnt2+1;
  SELECT TRUE FROM
    Type[bi]=none OR Type[bj]=none=>Error;
    VerticalWire[bj]=>RETURN;
    TiedBeads[bi,bj]=>TryT[];
    Unrelated[bi,bj]=>RETURN;
    LeftOf[bj,bi]=>TryR[];--probably backward!
    LeftOf[bi,bj]=>TryL[];--probably backward!
    NoWidths[bi,bj]=>RETURN;
    ENDCASE=>
        IF wpj.stiff
        THEN IF wpi.stiff THEN Try1[] ELSE Try3[]
        ELSE IF wpi.stiff THEN Try2[] ELSE Try4[];
  IF i=trackBead OR j=trackBead THEN ShowTracked[i,j];
  END;

TryT:PROCEDURE =BEGIN UpdateY[jy-Bot[bi]+jh]; END;

TryL:PROCEDURE =BEGIN IF wpj.stiff THEN UpdateY[MAX[ih,jh]]
 ELSE DoSegment[IF Tran[bi] THEN Lfm[bi]-2 ELSE Lfm[bi]+jh,maxX+1,iy+ih]; END;
 --zero is probably good enough for jh

TryR:PROCEDURE =BEGIN UpdateY[LowestPoint[bi].y+MAX[ih,jh]]; END;

Try1:PROCEDURE =BEGIN f:INTEGER; t:CARDINAL;
--neither i nor j is a wire
  IF ~Interact[bi,bj] THEN RETURN;
  t_32+delta.y-1;
  f_t-(SELECT howMuch FROM
    1=>0, 2=>t MOD 2, 4=>t MOD 4, 8=>t MOD 8, 16=>t MOD 16, ENDCASE=>ERROR);
  f_MIN[f-32+howMuch,MAX[Bot[bi]-jy-jh,delta.y]];
  UpdateY[-f];
  END;

--j is a wire, i is not
Try2:PROCEDURE =BEGIN
  DoSegment[Lfm[bi]-delta.x,Rtm[bi]+delta.x,iy-delta.y];
  END;

--i is a wire, j is not
Try3:PROCEDURE =BEGIN
  w:INTEGER_Height[bi];
  thisX:INTEGER_Lfm[bi]-w;
  thisY:INTEGER_0;
  lowestY:INTEGER_maxY;
  leftEdge:INTEGER_LeftEdge[bi];
  rightEdge:INTEGER_RightEdge[bi];
  range1:INTEGER_Lfm[bj]-w-delta.x;
  range2:INTEGER_Rtm[bj]+delta.x;
  Lowest:PROCEDURE[d:Coord]=BEGIN
    IF MAX[thisX,leftEdge]<range2 AND MIN[thisX+d.x,rightEdge]>range1
            THEN lowestY_MIN[lowestY,thisY];
    thisX_thisX+d.x;
    thisY_thisY+d.y;
    END;
  FollowShortNoodle[bi,Lowest];
  Lowest[[rightEdge-thisX,0]];
  IF lowestY<maxY THEN UpdateY[lowestY-delta.y];
  END;

--both i and j are wires
Try4:PROCEDURE =BEGIN
  bw:BentWireData;
  wireWidthi:INTEGER=Height[bi];
  leftExt:INTEGER_delta.x-IfTran[bi,wireWidthi+2];
  rightExt:INTEGER_delta.x+wireWidthi;
  NoName:PROCEDURE=BEGIN
    DoSegment[bw.thisX-leftExt,bw.nextX+rightExt,bw.thisY-delta.y,FALSE];
    leftExt_delta.x;
    END;
  IF NoWidths[bi,bj] THEN Error;
  IF bi.p.beadR=bj.p.beadL OR bi.p.beadL=bj.p.beadR THEN Error;
  FollowNoodle[bi,@bw,NoName]; 
  rightExt_rightExt-IfTran[bi,wireWidthi];
  DoSegment[bw.thisX-leftExt,bw.lastX+rightExt,bw.thisY-delta.y];
  END;

UpdateY:PROCEDURE[del:INTEGER] =BEGIN
  newY:INTEGER_wpj.newY;
  BetterY:INTEGER_del+iy-jh;
  IF BetterY NOT IN [0..maxY] OR bj.z>topBead THEN
    BEGIN IF ~seen2 THEN Error; seen2_TRUE; BetterY_jy; END;
  IF BetterY+2<jy THEN {IF ~seen THEN Error; seen_TRUE; BetterY_jy};
  IF VerticalWire[bj] THEN Error;
  IF BetterY>=newY THEN RETURN;
  wpj.newY_BetterY;
  IF ~wpj.stiff THEN BEGIN
    []_MakeNewNoodle[topNoodle,bj.p,0,newY-BetterY];
    DoSegment[0,LeftEdge[bj]+jh,BetterY+jh];
    END;
  --ShowSpit[bj,BetterY];
  Push[bj];
  END;

seen,seen1,seen2:BOOLEAN_FALSE;

DoSegment:PROCEDURE[left,right,height:INTEGER,clean:BOOLEAN_TRUE] =BEGIN
  bw:BentWireData;
  IF left>=right OR ~Wir[bj] THEN Error;
  IF Rtm[bj]+Height[bj]<=left OR right<left THEN RETURN;
  BEGIN OPEN bw;
  Append:PROCEDURE[x,y:INTEGER] =BEGIN
    IF x<0 THEN Error;
    IF x=0 THEN IncrementNoodle[this,0,y]
    ELSE {old_this; this_MakeNewNoodle[old,bj.p,x,y];}; 
    END;
  SegSeg:PROCEDURE=BEGIN
    leftX:INTEGER_MAX[left,thisX];
    IF thisY<=height THEN RETURN;
    IF left>=nextX OR right<=thisX OR left=nextX AND left#(lastX+Height[bj])
     THEN RETURN;
    IF this=topNoodle THEN this_InsertNewNoodle[old,bj.p];
    SetNoodle[this,leftX-thisX,height-thisY];
    IF right<nextX
    THEN {Append[right-leftX,thisY-height]; Append[nextX-right,nextY-thisY]}
    ELSE Append[nextX-leftX,nextY-height];
    IF MIN[right,nextX]-thisX>0 THEN Push[bj];--rightis > thisX
         --this is not always necessary, should experiment!
    END;
  wire:INTEGER_Height[bj];
  left_MAX[left,Lfm[bj]]-wire;
  height_height-wire;
  FollowNoodle[bj,SegSeg];
  SegSeg[];
  IF clean THEN CleanNoodle[bj];
  END; END;

--CleanNoodle[j, a wire]:
-- If a wire segment has dx=0 or dy=0, then it should be removed for
--   efficiency. dx=0 is meaningful on the first segment
--If a wire bends within delta of a transistor, on either end, then the
--   wire must be straightened. either by dropping the transistor or a
--   segment of wire. Watch out - the bend might be within delta of both ends!
--If a wire bends up and then down again, without room inside the bend for
--   any bead to stick up, then the up/down must be dropped to the height
--   of the higher side. This is complicated when the bend up terminates on an
--   end bead on one side or another. This is not an efficiency matter! -
--   The little stub left sticking up might well be less than a wire wide, and
--   must be eliminated.
--One need not worry about a bend down and then up, since there is nothing
--   which can cause that to happen.

CleanNoodle:PROCEDURE[j:Desc]=BEGIN
  bw:BentWireData;
  BEGIN OPEN bw;
  l:Desc_DescL[j];
  r:Desc_DescR[j];
  wpj:WorkPtr_Getw[j];
  wpr:WorkPtr_Getw[r];
  wire:INTEGER_Height[j];
  leftPivot:INTEGER_LeftEdge[j];
  rightPivot:INTEGER_RightEdge[j];
  rightY1:INTEGER_wpr.newY;
  rightY2:INTEGER_rightY1+MAX[Height[r]-wire,0];
  NoName:PROCEDURE={IF dx=0 AND old#topNoodle THEN MergeL[@bw]};
  StillNoName:PROCEDURE=BEGIN
    done_TRUE;
    SELECT TRUE FROM
      dx=0 AND old#topNoodle=>MergeR[@bw];
      dy=0=>MergeLPlus[@bw];
      nextX>rightPivot=>BEGIN
       Push[j];
       IF dy<0 THEN MoveJog[this,rightPivot-nextX,0] ELSE MergeLPlus[@bw];
       END;
      nextX<leftPivot AND dy<0=>BEGIN
        Push[j];
        wpj.newY_nextY;
        IF old#topNoodle THEN Error;
        IncrementNoodle[next,dx,0]; ReleaseNoodle[this,old,j];
        END;
      nextX<leftPivot=>BEGIN
        Push[j];
        IF next=topNoodle OR nextX+nextdx>leftPivot
             THEN MoveJog[this,leftPivot-nextX,0] ELSE MergeLPlus[@bw];
        END;
      NearRight[] AND thisY IN [rightY2..nextY)=>MergeLPlus[@bw];
      NearRight[] AND rightY1 IN [thisY..nextY)=>MoveJog[this,0,rightY1-nextY];
      Wicket[]=>IF olddy>-dy THEN MergeR[@bw] ELSE MergeL[@bw];
      nextX=lastX AND ~Trans[r]=>BEGIN
           SELECT nextY FROM
             >rightY2=>IncrementNoodle[this,0,rightY2-nextY];
             <rightY1=>IncrementNoodle[this,0,rightY1-nextY];
             ENDCASE;
           done_FALSE;
           END;
      ENDCASE=>done_FALSE;
    END;
  NearRight:PROCEDURE RETURNS[b:BOOLEAN]=INLINE {b_nextX>rightPivot-wire-8};
  Wicket:PROCEDURE RETURNS[b:BOOLEAN]=INLINE BEGIN
      b_nextX<MAX[leftPivot+8,thisX+wire+12]
         AND old#topNoodle AND olddy>0 AND dy<0; END;
  CheckWire[j];
  FollowNoodle[j,@bw,NoName];
  DO
    FollowNoodle[j,@bw,StillNoName];
    IF done THEN EXIT;
    ENDLOOP;
  CheckWire[j];
  END; END; 

Seen1:PROCEDURE=BEGIN IF ~seen1 THEN BEGIN seen1_TRUE; Error; END; END;

CheckWire:PROCEDURE[j:Desc] =BEGIN
  NoName:PROCEDURE[d:Coord]=BEGIN IF d.x<0 OR (thisY_thisY+d.y)+6<Bot[j]
       THEN Seen1[]; END;
  thisY:INTEGER_Getw[j].newY;
  NoName[Zero];
  FollowShortNoodle[j,NoName];
  END;

Push:PROCEDURE[i:Desc]=BEGIN
  wpi:WorkPtr_Getw[i];
  y:INTEGER_wpi.backSort-1;
  IF y<pushingY THEN BEGIN pushingY_y; cnt7_cnt7+1; END;
  wpi.processed_FALSE;
  END;

FindGain:PROCEDURE[i:Desc]=
   {IF ~VerticalWire[i] THEN gain_MIN[gain,Getw[i].newY+LowestPoint[i].x]};

MoveDown:PROCEDURE[i:Desc]=
   {i.p.y_IF Bot[i]#0 OR ~End[i] OR NoBeadU[i] THEN Getw[i].newY-gain ELSE 0};

LowestPoint:PROCEDURE[i:Desc] RETURNS[f:Coord]= BEGIN
  NoName:PROCEDURE[d:Coord]={f.x_MIN[f.x,f.y_f.y+d.y]};
  f_Zero;
  IF ~Getw[i].stiff THEN FollowShortNoodle[i,NoName];
  END;


PrintCounts:PUBLIC PROCEDURE= BEGIN
  IODefs.WriteChar[CR];
  PrintLong[cnt1];  PrintLong[cnt2];  PrintLong[cnt7];  PrintLong[cnt8];
  END;

ShowTracked:PROCEDURE[i,j:CARDINAL]=BEGIN OPEN IODefs;
    WriteChar[CR];
    WriteNumber[i,  [10,FALSE,TRUE,5]];
    WriteString[" put "];
    WriteNumber[j,  [10,FALSE,TRUE,5]];
    WriteString[" at "];
    WriteNumber[GetW[j].newY,  [10,FALSE,TRUE,5]];
    END;

END..


(1792)\2520i27I231i23I88i23I575i24I1110i2I