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

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
  i,j:CARDINAL_0;
  EnumerateBeads[InitBeadWork];
  Initialize[];
 -- EnumerateBeads[PartWiggle];
  EnumerateBeads[Transformation1];
  EnumerateBeads[Transformation2];
  EnumerateBeads[Transformation3];
  EnumerateBeads[Transformation4];
  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[i:CARDINAL,bpi:BeadPtr]=BEGIN
  j:CARDINAL;
  FOR j IN [0..topBead] DO IF Get[j].t#none THEN Wiggle[i,j]; ENDLOOP;
  END;

  Wiggle:PROCEDURE[i,j:CARDINAL]= BEGIN-- j is below i
  bi:Bead_Get[i]^;
  bj:Bead_Get[j]^;
  minX,minY:INTEGER;
  [minX,minY]_Deltas[i,j];
  IF bi.wire OR bj.wire THEN RETURN;-- why?
  IF bj.y> bi.y THEN
     BEGIN t:CARDINAL_i; i_j; j_t; bi_ bj; bj_Get[j]^; END;
  IF minY#bi.y-bj.y- bj.h
     OR bj.x>= bi.x+ bi.w+ minX
     OR bj.x+ bj.w<= bi.x- minX
     OR Related[i,j]
     OR Tied[i,j]
     OR Get[bj.beadU].beadU= i THEN RETURN;
  IF Move[bead,j,bi.x+ bi.w+ minX- bj.x,2]
     THEN BEGIN Commit[]; RETURN; END ELSE Abort[];
  IF Move[bead,j,bi.x- (bj.x+ bj.w+ minX),2]
     THEN BEGIN Commit[]; RETURN; END ELSE Abort[];
  Restore[];
  END;

  
Transformation1:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  k,m,n:CARDINAL;
  IF bpi.t= ttV AND
     bpi.beadR= noBead AND
     Get[m_ Get[k_ bpi.beadL].beadL].t= rb AND
     Get[n_ Get[m].beadT].t= bf --AND
     --Get[n].beadR#noBead-- THEN
	BEGIN
	OPEN IODefs;
	WriteString["flip transistor#1- "];
	Attach[k,right,i];
	Attach[k,left,m];
	IF ~Move[bead,m,2- Get[k].w,0] THEN BEGIN WriteLine["couldn't move"]; 					     Restore[]; END
				   ELSE BEGIN WriteLine["flipped"];
 					      Commit[]; END;
	END;
  END;

Transformation2:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN--rotate a contact
  j,k:CARDINAL; bpj,bpk:BeadPtr;
  IF bpi.t# bf THEN RETURN;
  k_bpi.beadT; bpk_Get[k]; j_bpk.beadT; bpj_Get[j];
  IF bpk.t =bg AND bpj.t= rb AND bpi.h>bpi.w AND  bpj.y< bpk.y THEN BEGIN
     RotateRight:BOOLEAN;
     IF bpi.h< bpi.w THEN RETURN;
     IF bpj.x> bpk.x THEN RETURN;
     SELECT TRUE FROM
	bpj.beadL#noBead AND bpj.beadR#noBead => RETURN;
	bpk.beadL#noBead AND bpk.beadR#noBead => RETURN;
	bpj.beadR#noBead AND bpk.beadR#noBead => RETURN;
	bpj.beadL#noBead AND bpk.beadL#noBead => RETURN;
	bpj.beadL#noBead AND bpk.beadU#noBead => RotateRight_ TRUE;
	bpj.beadD#noBead AND bpk.beadL#noBead => RotateRight_ FALSE;
	bpj.beadR#noBead AND bpk.beadU#noBead => RotateRight_ FALSE;
	bpj.beadD#noBead AND bpk.beadR#noBead => RotateRight_ TRUE;
	bpj.beadL#noBead AND bpk.beadR#noBead => RotateRight_ TRUE;
	bpj.beadR#noBead AND bpk.beadL#noBead => RotateRight_ FALSE;
	bpj.beadU#noBead AND bpk.beadD#noBead =>
		IF Get[bpj.beadD].y< Get[bpk.beadU].y THEN RotateRight_ TRUE
						      ELSE RotateRight_ FALSE;
	ENDCASE => RETURN;
     IODefs.WriteString["rotate contact- "]; 
     ClearShift[]; Put[i,-2,2,8,12]; 
     IF RotateRight THEN BEGIN Put[j,-2,2,8,6]; Put[k, 4,-4,8,6]; END
		    ELSE BEGIN Put[j, 4,2,8,6]; Put[k,-2,-4,8,6]; END;
     Process[];
     END;
  END;

Transformation3:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  bi:Bead_ bpi^; bpj:BeadPtr;
  j,k:CARDINAL_ noBead;
  IF bi.t=rb THEN FOR j IN (i..topBead] DO
        bpj_Get[j]; 
	IF bpj.t=rb AND bi.circuit=bpj.circuit
			AND Overlap[i,j] THEN k_j; ENDLOOP;
  IF bi.t=bg THEN FOR j IN (i..topBead] DO
        bpj_Get[j]; 
	IF bpj.t=bg AND bi.circuit=bpj.circuit
			AND Overlap[i,j] THEN k_j; ENDLOOP;
  IF k=noBead THEN RETURN ELSE BEGIN
	bt,bk:Bead_ Get[k]^;
	t:CARDINAL;
	l:CARDINAL_Find[bf,i]; loopL:BOOLEAN_Get[l].beadT#i;
	m:CARDINAL_Find[bf,k]; loopM:BOOLEAN_Get[m].beadT#k;
	horizontal,vertical:Variant;
	IF loopM AND loopL THEN RETURN; --budding contacts
	IODefs.WriteString["double contact- "];
	IF loopM THEN BEGIN --a budding contact
		t_i; i_k; k_t;  --we don't want k to be a 3-way contact
		t_m; m_l; l_t;
		bk_bi; bi_bt; END;
	t_ IF bi.t= bg THEN Find[rb,i] ELSE Find[bg,i];
	RemovePaths[m,l,tied];  RemovePaths[k,i,tied];
	Attach[noBead,tied,k];
	horizontal_ IF bk.x< bi.x THEN down ELSE up;
	vertical_ IF bk.y< bi.y  THEN left ELSE right;
	IF (NumRelatives[k]+ NumRelatives[m])*4>= noBead- topBead 
	   THEN BEGIN Restore[]; IODefs.WriteLine[">noBead"]; RETURN; END;
	InsertJogs[k,horizontal,vertical];
	InsertJogs[m,horizontal,vertical];
	AttachAll[k,i]; AttachAll[m,l];
	Remove[k]; Remove[m];
	IF Move[bead,i,0,0] THEN Commit[] ELSE Restore[];
	j_j; --a hack to get around a bug in the debugger;
	END;
    END;

Transformation4:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  bi:Bead_ bpi^;
  j,k,l,m,n,rb,bg,bf:CARDINAL;
  IF (bi.t=dd OR bi.t=tt) AND 
     NumRelatives[i]=3 AND
     NumRelatives[k_Get[j_bi.beadU].beadU]=2 AND
     NumRelatives[m_Get[l_Get[k].beadL].beadL]=2 AND
     NumRelatives[rb_Get[n_Get[m].beadD].beadD]=2 AND
     NumRelatives[bg_Get[bf_Get[rb].beadT].beadT]=3 AND
     Get[Get[bg].beadR].beadR=i THEN BEGIN
	IODefs.WriteString["flip transistor#2- "];
	Put[rb,0,-12,0,0]; Put[bf,0,-6,0,0];
	Attach[n,down,rb]; Attach[n,up,m];
	Attach[j,down,i]; Attach[j,up,k];
	IF ~Move[bead,rb,0,0] THEN GOTO Abort;
	IF ~Move[bead,bf,0,0] THEN GOTO Abort;
	Commit[];
	END;
  EXITS
    Abort => Restore[];
  END; 
    

Local1:PROCEDURE[i:CARDINAL,bpi:BeadPtr]=BEGIN
    k:CARDINAL_bpi.beadD;
    bpk:BeadPtr_Get[k];
    j:CARDINAL_bpk.beadD;
    bpj:BeadPtr_Get[j];
    delta:INTEGER_bpj.y-bpi.y;
    IF k#noBead AND bpk.wire AND j#noBead 
      AND delta IN [0..bpi.h-bpj.h)
      AND (SELECT bpj.t FROM jctnG,jctnR,jctnB=>TRUE, ENDCASE=>FALSE)
    THEN BEGIN
        bj:Bead_bpj^;
        IF bj.beadT#noBead THEN Error;
        IF bj.beadR#noBead THEN BEGIN
          IF bpi.beadR#noBead THEN RETURN;
	  bpi.beadD_noBead;
          Attach[bj.beadR,right,i];
          END;
        IF bj.beadL#noBead THEN BEGIN
          IF bpi.beadL#noBead THEN RETURN;
	  bpi.beadD_noBead;
          Attach[bj.beadL,left,i];
          END;
        IF bj.beadD#noBead THEN BEGIN
          Attach[bj.beadD,down,i];
          END;
	IODefs.WriteLine["deleted junction"];
        DeleteBead[j];
        DeleteBead[k];
        END;
  END;

Local2:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  -- 
  --none j(jctn) - k(wire) - i(jctn) none
  --     l                   m
  --     n                   p
  hm,delta1,delta2:INTEGER;
  k:CARDINAL_bpi.beadL;
  bpk:BeadPtr_Get[k];
  j:CARDINAL_bpk.beadL;
  bpj:BeadPtr_Get[j];
  l,m,n,p:CARDINAL;
  bpn,bpp:BeadPtr;
  IF   k=noBead
    OR ~bpk.wire
    OR (m_bpi.beadD)=noBead
    OR j=noBead
    OR bpi.beadR#noBead
    OR (SELECT bpi.t FROM jctnG,jctnR,jctnB=>FALSE, ENDCASE=>TRUE)
    OR (l_bpj.beadD)=noBead
    OR bpj.beadL#noBead
    OR (SELECT bpj.t FROM jctnG,jctnR,jctnB=>FALSE, ENDCASE=>TRUE)
    THEN RETURN;
  n_ Get[l].beadD; bpn_Get[n]; p_ Get[m].beadD; bpp_Get[p];
  delta1_MinSepInY[j,n];
  delta2_MinSepInY[i,p];
  IF delta1<0 AND bpn.beadT#noBead THEN delta1_delta1+2;
  IF delta2<0 AND bpp.beadT#noBead THEN delta2_delta2+2;
  hm_ MIN[bpj.y- (bpn.y+ bpn.h+ delta1),
	  bpi.y- (bpp.y+ bpp.h+ delta2)];
  IF hm<=0 THEN RETURN;
  IF BeadFall[j,hm] THEN UNTIL ~WireFall[k] DO ENDLOOP;
  IF bpi.beadU#noBead THEN FixWire[bpi.beadU,Get[bpi.beadU]];
  FixWire[m,Get[m]];
  FixWire[l,Get[l]];
  END;

Local3:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  --    none
  --none j - k(wire) - i
  --     l
  --     m
  hm:INTEGER;
  k,j,l,m:CARDINAL;
  bpk,bpj,bpm:BeadPtr;
  k_bpi.beadL;  IF k=noBead THEN RETURN;  bpk_Get[k];
  IF ~bpk.wire OR bpk.y<= bpi.y THEN RETURN; 
  j_bpk.beadL;  bpj_Get[j];
  IF  bpj.beadU#noBead OR  bpj.beadL#noBead THEN RETURN; 
  l_bpj.beadD;  IF  l=noBead THEN RETURN;
  m_ Get[l].beadD;  bpm_Get[m];
  hm_ MIN[bpk.y- bpi.y, bpj.y- (bpm.y+ bpm.h+ MinSepInY[j,m])];
  IF hm<=0 THEN RETURN;
  IF BeadFall[j,hm] THEN UNTIL ~WireFall[k] DO ENDLOOP;
  FixWire[k,bpk];
  FixWire[l,Get[l]];
  END;

Local3a:PROCEDURE[i:CARDINAL,bpi:BeadPtr]= BEGIN
  hm:INTEGER;
  k,j,l,m:CARDINAL;
  bpk,bpj,bpm:BeadPtr;
  k_bpi.beadR;  IF k=noBead THEN RETURN;  bpk_Get[k];
  IF ~bpk.wire OR bpk.y<= bpi.y THEN RETURN; 
  j_bpk.beadR;  bpj_Get[j];
  IF  bpj.beadU#noBead OR  bpj.beadR#noBead THEN RETURN; 
  l_bpj.beadD;  IF  l=noBead THEN RETURN;
  m_ Get[l].beadD;  bpm_Get[m];
  hm_ MIN[bpk.y-bpi.y, bpj.y- (bpm.y+ bpm.h+ MinSepInY[j,m])];
  IF hm<=0 THEN RETURN;
  UNTIL ~WireFall[k] DO ENDLOOP;--but this is silly.
  END;

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

(1792)\48i10I302b2Bi19bI7B148b5B156b10B368i40I323b10B134i2bI6B31i15I601b15B500b15B43i16I504i1I58i3I59i3I59i3I58i1I60i3I59i3I103i13I23i3I264b15B627i16I65i17I21i37I567i45I17b15B589i5I35i5I27i9I29b6B896b6B1107b6B610b7B