-- wiresPlace6.mesa
-- reject wires
-- ties to middles and to ends
-- alternate paths
-- follow around nil ends

DIRECTORY SystemDefs:FROM"SystemDefs",
          WiresDefs:FROM"WiresDefs",
          IODefs:FROM"IODefs";
WiresPlace:PROGRAM IMPORTS SystemDefs, IODefs, WiresDefs=BEGIN OPEN WiresDefs;

Error:SIGNAL=CODE;
debugLevel: INTEGER _ 2;

--//////////////CONTROL///////////////

Main:PROCEDURE=BEGIN
  AllocateStuffForCreate[PrintStks];
  AllocateStuffForSeg[];
  AllocateStuffForPlace[];
  Go[];
  END;

Go:PROCEDURE=BEGIN
  i,j: INTEGER;
  GetInput[TRUE];
  MakeWireList[TRUE];
  InitRejectWires[];
  PlaceSimpleWires[TRUE];
  IF topRejectWire>0 THEN Error;
  [i,j]_TurnToStks[TRUE];
  DoOutputs["wires3",i,j];
  END;
AllocateStuffForPlace:PROCEDURE=BEGIN OPEN SystemDefs;
  rejectWireList_AllocateSegment[SIZE[rejectWireListArray]];
  hopperList_AllocateSegment[SIZE[hopperListArray]];
  END;

Dump: PROCEDURE= BEGIN  EnumerateGridPlusOne[PrintStubs]; END;

Dstk: PROCEDURE= BEGIN debugPrint_TRUE;
			PrintStks[];
			debugPrint_FALSE;
			END;

--/////////////REJECT WIRES ///////////////

rejectWireListArray:TYPE=ARRAY [0..maxRejectWire] OF WirePtr;
rejectWireList:POINTER TO rejectWireListArray_NIL;
topRejectWire:INTEGER;
maxRejectWire:INTEGER=40;

InitRejectWires:PROCEDURE=BEGIN topRejectWire_0; END;

AddRejectWire:PROCEDURE[w:WirePtr]=BEGIN
  ShowHopper[];
  rejectWireList[topRejectWire]_w;
  topRejectWire_topRejectWire+1;
  IF topRejectWire>maxRejectWire THEN Error;
  END;

--////// PLACE SIMPLE WIRES///////////////

PlaceSimpleWires:PROCEDURE[print:BOOLEAN]=
  BEGIN InitSegs[];
  EnumerateWires[PlaceOneWire];
  END;

activeCircuit: INTEGER;

PlaceOneWire:PROCEDURE[i: INTEGER, wire:WirePtr]= BEGIN
    IODefs.WriteChar[CR];
    IODefs.WriteNumber[i,[10,FALSE,TRUE,4]];
    activeCircuit _ wire.circuit;
    BackwardRun[wire,ForwardRun[wire]];
    END;

ForwardRun:PROCEDURE[w:WirePtr]RETURNS[done:NodePtr]=BEGIN

    OneNode:PROCEDURE[n:NodePtr]RETURNS[BOOLEAN]=
     BEGIN RETURN[EnumerateFollow[n,OnePlace]]; END;
    OnePlace:PROCEDURE[n:NodePtr,s:SegPtr,level:BOOLEAN] RETURNS[BOOLEAN]=
       BEGIN
       [done,]_AddHopper[s,n.hop+1,n,TRUE,level,none];
       IF IllegalNode[done] THEN Error;
       RETURN[done#NIL];
       END;
    SetEnd:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
       BEGIN
       done_AlsoAdd[s,none,terminalHop,c];
       IF IllegalNode[done] THEN Error;
       RETURN[done#NIL];
       END;
    SetStart:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
       BEGIN
       done_AlsoAdd[s,none,0,c];
       IF IllegalNode[done] THEN Error;
       RETURN[done#NIL];
       END;

--  BEGIN Body of ForwardRun
  maxLength:INTEGER_WireLength[w.a,w.b]+7;
  done_NIL;
  ClearHopper[];
  IF w.a.i=w.b.i AND w.a.j=w.b.j THEN RETURN; -- do nothing for pullups
  IF ~EnumerateOrient[w.b,SetEnd] AND ~EnumerateOrient[w.a,SetStart]
      THEN EnumerateHopper[OneNode];
  END;

AlsoAdd:PROCEDURE[s:SegPtr,t:Twist,h:INTEGER, c: Slot] 
	RETURNS[done:NodePtr]=BEGIN
  duplicateA, duplicateB: BOOLEAN;
  level:BOOLEAN_s.xy.l;
  IF s=NIL OR (s.circuit#activeCircuit AND s.circuit#nullCircuit AND t#none)
           OR (s.dummy AND t=n) THEN RETURN[NIL];
  [done,duplicateA]_AddHopper[s,h,NIL,TRUE,level,c];
  IF (t=none AND ~s.dummy AND ~s.nc) THEN RETURN;
  IF done=NIL AND ~s.bc AND ~s.dummy AND (t=s OR t=f OR t=a)
    THEN [done,duplicateB]_AddHopper[s.back,h,NIL,FALSE,level,none]
    ELSE duplicateB_FALSE;
  IF duplicateA OR duplicateB THEN RETURN;
--  the remainder is a 5-ary tree traversal
  IF done=NIL AND t#n AND  s.bc THEN done_AlsoAdd[s.back,b,h,none];
  IF done=NIL AND t#b AND  s.nc THEN done_AlsoAdd[s.next,n,h,none];
  IF done=NIL AND t#s AND ~s.dummy THEN done_AlsoAdd[s.first,f,h,none];
  IF done=NIL AND t#f AND ~s.dummy THEN done_AlsoAdd[s.second,s,h,none];
  IF done=NIL AND t#a AND ~s.dummy THEN done_AlsoAdd[s.across,a,h,none];
  END;

BackwardRun:PROCEDURE[w:WirePtr,n:NodePtr]=BEGIN
  where:SegPtr_NIL; down,free:BOOLEAN;
  color:Color_IF w.a.contact=gate OR w.b.contact=gate THEN r ELSE g;
  IF IllegalNode[n] THEN Error;
  IF debugLevel>10 THEN ShowHopper[];
    IF n=NIL THEN BEGIN
      IF w.a.i=w.b.i AND w.a.j=w.b.j THEN SetPullup[w.a]
	 ELSE AddRejectWire[w];
      RETURN;
    END;
  [down,free]_SetInitialSegment[w.b,n,w.circuit];
  IF PreviousHopper[n]=NIL THEN where_(IF down THEN n.s ELSE n.s.next)
     ELSE FOR n_n,PreviousHopper[n] DO
            where_SetSeg[from:n,col:color,circuit:w.circuit,old:where,
            tieN:~free AND ~down, tieB:~free AND  down];
	    PrintOneSeg[where];
            free _ TRUE;
	    IF PreviousHopper[n]=NIL THEN EXIT;
          ENDLOOP;
  SetFinalSegment[l:w.a,s:where, n:n, circuit: w.circuit]; 
  IF debugLevel>10 THEN BEGIN
    debugPrint_TRUE;
    EnumerateGrid[PrintOrientations];
    debugPrint_FALSE;
    END;
  END;

--/////// START HOPPER ///////

--The hopper is a fifo into which one can insert nodes. Duplicate entries
--will be suppressed (thereby suppressing longer passes to the same place
--one can also backtrack through the hopper chain

hopperListArray:TYPE=ARRAY [0..maxHopper] OF Node;
maxHopper:INTEGER=400;
hopperList:POINTER TO hopperListArray_NIL;
hopperInsert,hopperRemove:INTEGER;

IllegalNode:PROCEDURE[n:NodePtr] RETURNS[BOOLEAN]=BEGIN
   foo1:CARDINAL_LOOPHOLE[n];
   foo2:CARDINAL_LOOPHOLE[@hopperList[0]];
   foo3:CARDINAL_LOOPHOLE[@hopperList[maxHopper]];
   RETURN[n#NIL AND foo1 NOT IN [foo2..foo3]]; END;

ClearHopper:PROCEDURE=BEGIN hopperInsert_hopperRemove_0; END;

AddHopper:PROCEDURE[s:SegPtr,h:Hop,bk:NodePtr,nor,l:BOOLEAN, c: Slot]
  RETURNS[NodePtr, BOOLEAN]=BEGIN
  i:INTEGER; t:NodePtr;
  IF s.w=l OR s.w=d THEN RETURN[NIL, FALSE];
  IF ~s.dummy AND s.xy.l#l THEN BEGIN Error; RETURN[NIL, FALSE]; END;
  FOR i IN [0..hopperInsert) DO
    t_@hopperList[i];
    IF s=t.s AND l=t.l THEN -- this segment is already in the hopper
	 BEGIN IF t.hop=terminalHop AND h#terminalHop -- i.e. we're done
                 THEN t.back_bk ELSE t_NIL;
		 RETURN[t, TRUE];
	 END;
   ENDLOOP;
  t_AddToHopper[];
  t^_[s:s,hop:h,back:bk,normal:nor,movingLD:LD[bk.s,s],l:l, contact: c];
  RETURN[NIL, FALSE];
  END;

AddToHopper:PROCEDURE RETURNS[f:NodePtr]=BEGIN
  f_@hopperList[hopperInsert];
  IF (hopperInsert_ hopperInsert+1) >= maxHopper THEN Error;
  END;

EnumerateHopper:PROCEDURE[call:PROCEDURE[NodePtr]RETURNS[BOOLEAN]]=BEGIN
  node:NodePtr;
  FOR hopperRemove_hopperRemove,hopperRemove+1
		 WHILE hopperRemove<hopperInsert DO
    node_@hopperList[hopperRemove];
    IF node.hop#terminalHop THEN 
      IF call[@hopperList[hopperRemove]] THEN RETURN;
    ENDLOOP;
  END;

PreviousHopper:PROCEDURE[p:NodePtr]RETURNS[NodePtr]=BEGIN RETURN[p.back]; END;

ShowHopper:PROCEDURE=BEGIN OPEN IODefs;
  node:NodePtr;
  deb:INTEGER;
  WriteChar[CR];
  FOR deb IN [0..hopperInsert) DO
    node_@hopperList[deb];
    WriteChar['[];
    WriteNumber[deb,[10,FALSE,TRUE,3]];
    PrintOneSeg[node.s];
    WriteChar[IF node.l THEN 'B ELSE ' ];
    WriteChar['[];
    WriteNumber[ShowSeg[node.s],[10,FALSE,TRUE,3]];
    WriteNumber[IF node.hop=terminalHop THEN 99 ELSE node.hop,[10,FALSE,TRUE,3]];
    WriteNumber[IF node.back=NIL THEN 99 ELSE (node.back-@hopperList[0])/SIZE[Node],[10,FALSE,TRUE,3]];
    WriteChar[CR];
    ENDLOOP;
  END;

--/////// END HOPPER   //////
--/////// START FOLLOW ///////

maxAns: INTEGER=40;
topAns:INTEGER;
followAns:ARRAY[0..maxAns) OF SegPtr;

EnumerateFollow:PROCEDURE[n:NodePtr,
                    call:PROCEDURE[NodePtr,SegPtr,BOOLEAN]RETURNS[BOOLEAN]]
                RETURNS[BOOLEAN]= BEGIN i:INTEGER; v:SegPtr;
  StartFollow[n];
  FOR i IN [0..topAns) DO
    IF followAns[i].dummy AND followAns[i].back#NIL THEN Error;
    IF call[n,followAns[i],n.l] THEN RETURN[TRUE]; ENDLOOP;
  FOR v_n.s,v.back DO -- Find the constraining seg. on other level.
    IF v.dummy THEN EXIT;
    IF v.across#NIL AND ~v.across.dummy THEN BEGIN
      v_v.across;
      EXIT;
      END;
    ENDLOOP;
  -- The constraining seg has been found. Now add all possible segs across.
  IF v.nc THEN RETURN[FALSE];
  IF call[n,v,~n.l] THEN RETURN[TRUE];
  FOR v_ IF v.dummy AND ~n.l THEN v.across ELSE v.next, v.next
	UNTIL v.across#NIL DO
	 IF ~v.nc THEN IF call[n,v,~n.l] THEN RETURN[TRUE];
	ENDLOOP; 
  RETURN[FALSE];
  END;

home:Where;
homeL:BOOLEAN;

StartFollow:PROCEDURE[n:NodePtr]=BEGIN
-- Determines whether we can continue the search from n and if so
-- exactly where.  Calls F1B to add possible continuations.
    GoOn: PROCEDURE[s: SegPtr, choice: BOOLEAN]= BEGIN
      w,t:SegPtr_NIL;
        FOR t_s, t.back DO -- find our way around the corner.
          IF t=NIL THEN BEGIN Error; RETURN; END;
          w_t.first;  IF w#NIL AND choice=LDOk[t,w] THEN EXIT;
          w_t.second; IF w#NIL AND choice=LDOk[t,w] THEN EXIT;
          ENDLOOP;
      F1B[w]; -- w goes the way we want so follow it.
    END;

  s:SegPtr_n.s;
  ld:BOOLEAN_n.movingLD;
  IF s=NIL THEN BEGIN Error; RETURN; END;
  home_s.xy;
  homeL_n.l;
  topAns_0;
-- First, handle the " source" wire. 
  IF n.back=NIL -- This will be true only for source segs, i.e. hop=0
     OR n.back.l#homeL -- i.e. we just jumped levels
   THEN BEGIN GoOn[s,TRUE]; GoOn[s,FALSE]; RETURN; END;
  IF s.nc OR (homeL AND s.dummy AND s.ac) THEN RETURN; -- nowhere to go.
  GoOn[s,ld]; -- normal case: continue in current direction
  END;

F1B:PROCEDURE[m:SegPtr]=BEGIN
 -- adds all accessable segs at this end and level.
  t:BOOLEAN; nextM,k: SegPtr; c:INTEGER;
  IF m=NIL THEN RETURN;
  FOR c_0,c+1 DO
    IF m=NIL THEN Error;
    IF m.xy.x=home.x AND m.xy.y=home.y AND m.xy.h=home.h THEN RETURN;
            -- We're home again. Hairpins aren't useful.
    t_Right[m]; -- if t then we want to traverse next's, otherwise back's
    IF t THEN BEGIN --Add everything between here and next seg toward home.
      AddFollow[m];
      FOR k_IF m.dummy AND homeL THEN m.across ELSE m.next, k.next 
	  UNTIL (TowardHome[nextM_k.first] OR TowardHome[nextM_k.second])
	DO
	 AddFollow[k];
        ENDLOOP
      END
     ELSE
      FOR k_IF m.dummy AND homeL THEN m.across ELSE m.back, k.back DO
	AddFollow[k];
	IF TowardHome[nextM_k.first] OR TowardHome[nextM_k.second]
	   THEN EXIT;
        ENDLOOP;

    IF c=2 THEN EXIT;
    m_nextM;
   ENDLOOP;
 END;

LD:PROCEDURE[a,b:SegPtr] RETURNS[BOOLEAN]=
-- Predicate:  Not going up or right.
 BEGIN RETURN[b.xy.x-a.xy.x#1 AND b.xy.y-a.xy.y#1]; END;

LDOk:PROCEDURE[a,b:SegPtr] RETURNS[BOOLEAN]=
-- Predicate: true if b is connected to the LD side of  a.
 BEGIN RETURN[IF a.xy.h THEN b.xy.x-a.xy.x=-1 ELSE b.xy.y-a.xy.y=-1]; END;

TowardHome:PROCEDURE[s:SegPtr] RETURNS[BOOLEAN]=BEGIN
-- Predicate: s is "connected" to home on at least one end.
  dy:INTEGER_s.xy.y-home.y;
  dx:INTEGER_s.xy.x-home.x;
  IF s=NIL THEN RETURN[FALSE];
  IF ~home.h THEN BEGIN t:INTEGER_dx; dx_dy; dy_t; END;
  RETURN[IF s.xy.h=home.h THEN dy=0 AND dx IN [-1..1]
                             ELSE dy IN [0..1] AND dx IN [-1..0]];
  END;

Right:PROCEDURE[a:SegPtr] RETURNS[BOOLEAN]=BEGIN
-- Predicate: home is on the "next" side of constraining wire a
  RETURN[a.xy.h=home.h OR ABS[(a.xy.x-home.x)-(a.xy.y-home.y)]#1];
  END;

AddFollow:PROCEDURE[this:SegPtr]=  BEGIN i:INTEGER;
  FOR i IN [0..topAns) DO IF followAns[i]=this THEN RETURN; ENDLOOP;
  IF topAns=15 THEN BEGIN Error; RETURN; END;
  IF this.xy.x=home.x AND this.xy.y=home.y AND this.xy.h=home.h THEN
	 BEGIN Error; RETURN; END;
  followAns[topAns]_this;
  IF (topAns_topAns+1) > maxAns THEN Error;
  END;

--/////// END FOLLOW ///////

Main[];
END..

The desired algorithm is simple: 
  1) break each circuit into individual point to point wires
  2) sort the wires
  3) place each wire in its shortest length configuration, counting level changes as equivalent to one unit wire on the grid.

The break up tries for short wires, and the sort puts green wirs first, power and ground last, and short wires ahead of long within these catagories.

The processing starts with the grid, which specifies what circuit each lead of each transistor connects to.
  grid[x,y]=[a,b,c:CircuitNo]

The first two steps of the processing create auxilliary structures which permit access to the grid:
  the Track, which links the transistors into lists by circuit
  the wire list, which enumerates, by size and color, the individual wires necessary to implement all of the circuits (excluding power and ground)

The next step creates Segs, which are unit length pieces of wire running in channels between the transistors. A seg is defined by the segs it connects to on each end, plus the segs adjacent but parallel to it on both sides, plus two booleans to say whether it is electrically connected on the sides, plus a connection across to the other level. Each transistor comes with four built-in dummy segs forming a box around the transistor. The whole figure is surrounded by dummy transistors  arranged so that their dummy segs connect to form a box around the whole figure (to eliminate bounds checking all the time). 

The processing inserts one wire at a time ito the seg diagram. This is done using an auxialliary structure called a node array. Points adjacent to one end of the wire are inserted into the node array as destinations. Points adjacent to the other end are inserted with zero length. The node array is then processed in order of increasing length, each time adding any new nodes which can be reached by adding one seg from the current one. Eventually a destination will be found, and thereby the shortest path. This all gets a little hairy since a point is not simply an xy between transistors, but also an indication of which of the many wires that may already be at this intersection the point is between. Another magic - it is sufficient to store only the seg to the points immediate left to completely identify it.

Once the segs are determined, on has in principle the final stick diagram. However there is still the little matter of assigning coordinates to all of the ends implied by the seg structure. This is achieved with some little difficulty, by creating another structure called stks (I was making a massive edit removing a similar structure called sticks - hense the funny name). stks contain only the information necessary to draw the implied line: color, direction(h or v), major coordinate (the y for a horizontal stick, etc), and the two minor coordinates(start and end x for a horizontal stick). Sticks do not butt up to other sticks running in the same direction, so that one stick corresponds to several adjacent segs.

Finally, the sticks may be printed by calling a routine which enumerates through all the data structures calling "put box" with a colored rectangle to mark on the stick diagram. This includes not only the information in the stk structure, but also the little stubs leading out from each of the transistors to connect to that structure.
   
e6(1792)\i3I11i98I1149b15B40b13B209b16B3910b11B52b9B775b15B304b14B66b10B