--beadsLocal.mesa August 21, 1979  11:30 AM
-- move beads
DIRECTORY IODefs:FROM"IODefs",
          BeadsInlines:FROM"BeadsInlines",
          InlineDefs:FROM"InlineDefs",
          BeadsDefs:FROM"BeadsDefs";
BeadsLocal:PROGRAM IMPORTS BeadsInlines, InlineDefs, IODefs,BeadsDefs EXPORTS BeadsDefs=
  BEGIN OPEN BeadsDefs, BeadsInlines;

KeepMesaHappy:PROCEDURE =BEGIN IODefs.WriteChar['*]; END;
Error:SIGNAL=CODE;
--************************************************************************
--control procedures
CleanUp:PUBLIC PROCEDURE= BEGIN
  Initialize[];
  ResetBelow[];
  EnumerateBeads[Local2];
 -- EnumerateBeads[Local3];
 -- EnumerateBeads[Local3a];
  END;

Local:PUBLIC PROCEDURE=BEGIN
  LocalStuff;    -- Reflect[];
  --LocalStuff;     Reflect[];
  --LocalStuff;     Rotate[];
  --LocalStuff;     Rotate[];
    END;

LocalStuff:PROCEDURE= BEGIN
  EnumerateBeads[InitBeadWork];
  Initialize[];
 -- EnumerateBeads[PartWiggle];
  EnumerateBeads[Transformation1];
  EnumerateBeads[Transformation2];
  EnumerateBeads[Transformation3];
  EnumerateBeads[Transformation4];
  EnumerateBeads[Transformation5];
  EnumerateBeads[Local1];
  END;


--************************************************************************
--transformations and local optimizations
--Local#1 deletes unneeded junctions
--Local#2 pulls horseshoes down tight
--Local#3 pulls in hooks
--Transformation#1 flips transistors
--Transformation#2 rotates contacts
--Transformation#3 merges contacts
--Transformation#4 also flips transistors
--Wiggle moves beads back and forth to see if the beads can be moved up

PartWiggle:PROCEDURE[k:Desc]=BEGIN
  Wiggle:PROCEDURE[j:Desc]= BEGIN
    i:Desc;
    min:Coord_Delta[k,j];
    IF k.p.wire OR j.p.wire THEN RETURN;-- why?
    IF Bot[j]> Bot[k] THEN {i_j; j_k} ELSE i_k;-- j is now below i
    IF min.y#Bot[i]-Top[j]
       OR Lfm[j]>= Rtm[i]+ min.x
       OR Rtm[j]<= Lfm[i]- min.x
       OR TouchingBeads[i,j]
       OR TiedBeads[i,j]
       OR DescU[DescU[j]]=i THEN RETURN;
    IF     ~GoodMove[j.z,Rtm[i]+min.x-Lfm[j]]
       AND ~GoodMove[j.z,Lfm[i]-(Rtm[j]+ min.x)] THEN Restore[];
    END;
  EnumerateBeads[Wiggle];
  END;

GoodMove:PROCEDURE[jj,x:INTEGER] RETURNS[b:BOOLEAN]=BEGIN
  b_Move[bead,jj,x,2]; IF b THEN Commit[] ELSE Abort[]; END;

Transformation1:PROCEDURE[i:Desc]= BEGIN
  k,m,n:Desc;
  IF i.p.t= ttV AND NoBeadR[i] AND
     (m_DescL[k_DescL[i]]).p.t= rb AND
     (n_DescT[m]).p.t= bf --AND
     --Get[n].beadR#noBead-- THEN BEGIN
	Attach[k.z,right,i.z];
	Attach[k.z,left,m.z];
	TryTo[Move[bead,m.z,2+Rtm[i]-Rtm[m],0]];
	END;
  END;

Transformation2:PROCEDURE[i:Desc]= BEGIN--rotate a contact
  IF i.p.t# bf THEN RETURN ELSE BEGIN
  k:Desc_DescT[i];
  j:Desc_DescT[k];
  IF k.p.t =bg AND j.p.t= rb AND Height[i]>Width[i] AND  Bot[j]< Bot[k]
  THEN BEGIN
     rotateRight:BOOLEAN;
     SELECT TRUE FROM
        i.p.h< i.p.w => RETURN;
        Lfm[j]>Lfm[k] => RETURN;
	~NoBeadL[j] AND ~NoBeadR[j] => RETURN;
	~NoBeadL[k] AND ~NoBeadR[k] => RETURN;
	~NoBeadR[j] AND ~NoBeadR[k] => RETURN;
	~NoBeadL[j] AND ~NoBeadL[k] => RETURN;
	~NoBeadL[j] AND ~NoBeadU[k] => rotateRight_ TRUE;
	~NoBeadD[j] AND ~NoBeadL[k] => rotateRight_ TRUE;
	~NoBeadR[j] AND ~NoBeadU[k] => rotateRight_ FALSE;
	~NoBeadD[j] AND ~NoBeadR[k] => rotateRight_ TRUE;
	~NoBeadL[j] AND ~NoBeadR[k] => rotateRight_ TRUE;
	~NoBeadR[j] AND ~NoBeadL[k] => rotateRight_ FALSE;
	~NoBeadU[j] AND ~NoBeadD[k] => rotateRight_ 
		 Bot[DescD[j]]<Bot[DescU[k]];
	ENDCASE => RETURN;
     ClearShift[]; Put[i.z,-2,2,8,12]; 
     IF rotateRight THEN BEGIN Put[j.z,-2,2,8,6]; Put[k.z, 4,-4,8,6]; END
		    ELSE BEGIN Put[j.z, 4,2,8,6]; Put[k.z,-2,-4,8,6]; END;
     Process[];
     END;
  END; END;

Transformation3:PROCEDURE[i:Desc]= BEGIN
  bi:Bead_ i.p^;
  j,k:Desc_GetDesc[noBead];
  SELECT i.p.t FROM rb,bg=>NULL; ENDCASE=>RETURN;
  FOR jj:CARDINAL IN (i.z..topBead] DO
    j_GetDesc[jj];
    IF j.p.t=i.p.t AND i.p.circuit=j.p.circuit AND Overlap[i.z,j.z]
      THEN {k_j; EXIT};
    ENDLOOP;
  IF NoBead[k] THEN RETURN ELSE BEGIN
	bt,bk:Bead_ k.p^;
	t:CARDINAL;
	l:Desc_GetDesc[Find[bf,i.z]]; loopL:BOOLEAN_DescT[l]#i;
	m:Desc_GetDesc[Find[bf,k.z]]; loopM:BOOLEAN_DescT[m]#k;
	horizontal,vertical:Variant;
	IF loopM AND loopL THEN RETURN; --budding contacts
	IF loopM THEN BEGIN --a budding contact
		tt:Desc_i; i_k; k_tt;  --we don't want k to be a 3-way contact
		tt_m; m_l; l_tt;
		bk_bi; bi_bt; END;
	t_ Find[IF i.p.t= bg THEN rb ELSE bg,i.z];
	RemovePaths[m.z,l.z,tied];  RemovePaths[k.z,i.z,tied];
	Attach[noBead,tied,k.z];
	horizontal_ IF bk.x< bi.x THEN down ELSE up;
	vertical_ IF bk.y< bi.y  THEN left ELSE right;
	IF (NumRelatives[k.z]+ NumRelatives[m.z])*4>= noBead- topBead 
	   THEN BEGIN Restore[]; RETURN; END;
	InsertJogs[k,horizontal,vertical];
	InsertJogs[m,horizontal,vertical];
	AttachAll[k.z,i.z]; AttachAll[m.z,l.z];
	Remove[k.z]; Remove[m.z];
	TryTo[Move[bead,i.z,0,0]];
	END;
    END;

TryTo:PROCEDURE[b:BOOLEAN]=INLINE {IF b THEN Commit[] ELSE Restore[] };

Transformation4:PROCEDURE[i:Desc]= BEGIN
  j,k,l,m,n,rb,bg,bf:Desc;
  IF (i.p.t=dd OR i.p.t=tt) AND 
     NumRelatives[i.z]=3 AND
     NumRelatives[(k_DescU[j_DescU[i]]).z]=2 AND
     NumRelatives[(m_DescL[l_DescL[k]]).z]=2 AND
     NumRelatives[(rb_DescD[n_DescD[m]]).z]=2 AND
     NumRelatives[(bg_DescT[bf_DescT[rb]]).z]=3 AND
     DescR[DescR[bg]]=i THEN BEGIN
	Put[rb.z,0,-12,0,0]; Put[bf.z,0,-6,0,0];
	Attach[n.z,down,rb.z]; Attach[n.z,up,m.z];
	Attach[j.z,down,i.z]; Attach[j.z,up,k.z];
        TryTo[Move[bead,rb.z,0,0] AND Move[bead,bf.z,0,0]];
	END;
  END; 
    
Transformation5:PROCEDURE[i:Desc]=BEGIN
  IF i.p.t#ddV OR ~NoBeadR[i] THEN RETURN ELSE BEGIN
  dw:Desc_DescD[i];
  j:Desc_DescD[dw];
  IF NoBead[dw] OR ~dw.p.wire OR NoBead[j] THEN Error;
  IF ~Junction[j] OR ~NoBeadR[j] OR ~NoBeadD[j] THEN RETURN ELSE BEGIN
  iw:Desc_DescL[i];
  uw:Desc_DescU[i];
  lw:Desc_DescL[j];
  Save[i.z]; Save[j.z]; Save[dw.z]; Save[uw.z]; Save[lw.z];
  HookLR[lw,i]; HookUD[j,uw]; HookLR[i,dw]; HookLR[dw,j];
  i.p.t_dd; {t:INTEGER_i.p.w; i.p.w_i.p.h; i.p.h_t};
  IF ~NoBead[iw] THEN BEGIN
    m:Desc_i;--MakeBead[iw];
    n:Desc_i;--MakeBead[iw];
    IF TRUE THEN {Restore[]; RETURN};
    Save[iw.z]; HookLR[iw,m]; HookUD[i,m];
    m.p.t_jctnR; m.p.h_m.p.w_4;
    n.p.t_wireR; n.p.w_4;
    END;
  TryTo[Move[bead,i.z,-12,-2]];
  END; END; END;

Save:PROCEDURE[i:CARDINAL]=BEGIN Error; END;

Local1:PROCEDURE[i:Desc]=BEGIN
  IF i.p.wire OR NoBeadD[i] THEN RETURN ELSE BEGIN
  k:Desc_DescD[i];
  j:Desc_DescD[k];
  IF NoBead[k] OR ~k.p.wire OR NoBead[j] THEN Error; 
  IF Bot[j]-Bot[i] IN [0..i.p.h-j.p.h) AND Junction[j] THEN RETURN ELSE BEGIN
  IF ~NoBeadT[j] THEN Error;
  IF ~NoBeadR[j] THEN
      IF ~NoBeadR[i] THEN RETURN ELSE Attach[j.p.beadR,right,i.z];
  IF ~NoBeadL[j] THEN
      IF ~NoBeadL[i] THEN RETURN ELSE Attach[j.p.beadL,left,i.z];
  i.p.beadD_noBead;
  IF ~NoBeadD[i] THEN Attach[j.p.beadD,down,i.z];
  ReleaseBead[j];
  ReleaseBead[k];
  END; END; END;

Local2:PROCEDURE[i:Desc]= BEGIN
  -- 
  --none j(jctn) - k(wire) - i(jctn) none
  --     l                   m
  --     n                   p
  NoName:PROCEDURE[s,t:Desc]RETURNS[a:INTEGER]=INLINE BEGIN
    a_Delta[s,t].y; IF a<0 AND ~NoBeadT[t] THEN a_a+2; END;
  IF Junction[i] AND NoBeadR[i] THEN BEGIN
  k:Desc_DescL[i];
  j:Desc_DescL[k];
  IF k.z#noBead AND NoBeadL[j] AND Junction[j] THEN BEGIN
  m:Desc_DescD[i];
  l:Desc_DescD[j];
  IF m.z#noBead AND l.z#noBead THEN BEGIN
  n:Desc_DescD[l];
  p:Desc_DescD[m];
  hm:INTEGER_MIN[Bot[j]-(Top[n]+NoName[j,n]),
                 Bot[i]-(Top[p]+NoName[i,p])];
  IF hm<=0 THEN RETURN;
  FallTwo[j,hm];
  IF ~NoBeadU[i] THEN FixWire[DescU[i]];
  FixWire[m];
  FixWire[l];
  END; END; END; END;

Local3:PROCEDURE[i:Desc]= BEGIN
  --    none
  --none j - k(wire) - i
  --     l
  --     m
  IF ~NoBeadL[i] THEN BEGIN
  k:Desc_DescL[i];
  IF k.p.wire AND Bot[k]>Bot[i] THEN BEGIN
  j:Desc_DescL[k];
  IF NoBeadU[j] AND NoBeadL[j] AND ~NoBeadD[j] THEN BEGIN 
  l:Desc_DescD[k];
  m:Desc_DescD[l];
  hm:INTEGER_ MIN[Bot[k]-Bot[i],Bot[j]- (Top[m]+ Delta[j,m].y)];
  IF hm<=0 THEN RETURN;
  FallTwo[j,hm];
  FixWire[k];
  FixWire[l];
  END; END; END; END;

Local3a:PROCEDURE[i:Desc]= BEGIN
  IF ~NoBeadR[i] THEN BEGIN
  k:Desc_DescR[i];
  IF k.p.wire AND Bot[k]>Bot[i] THEN BEGIN
  j:Desc_DescR[k];
  IF NoBeadU[j] AND NoBeadR[j] AND ~NoBeadD[j] THEN BEGIN 
  l:Desc_DescD[k];
  m:Desc_DescD[l];
  hm:INTEGER_ MIN[Bot[k]-Bot[i],Bot[j]- (Top[m]+ Delta[j,m].y)];
  IF hm<=0 THEN RETURN;
  FallTwo[j,hm];
  FixWire[k];
  FixWire[l];
  END; END; END; END;

--************************************************************************
END..

(1792)\47i10I431b2Bi19bI7B148b5B156b10B385i40I323b10B25b8B40b2B24b2B46b2B43i19I3b2B23b2B31b2B31b2B27b2B23b2B150b2B24b6B69b2B60b15B289b15B27i16I435i1I48i3I48i3I49i3I48i1I50i3I49i3I75i3I233b15B533i16I24i17I28i37I621b15B558b15B805b6B576b6B739b6B449b7B