-- 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];
  [i,j]_TurnToStks[TRUE];
  DoOutputs["wires3",i,j];
  END;
AllocateStuffForPlace:PROCEDURE=BEGIN OPEN SystemDefs;
  rejectWireList_AllocateSegment[SIZE[rejectWireListArray]];
  hopperList_AllocateSegment[SIZE[hopperListArray]];
  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
  rejectWireList[topRejectWire]_w;
  topRejectWire_topRejectWire+1;
  IF topRejectWire>maxRejectWire THEN Error;
  END;

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

PlaceSimpleWires:PROCEDURE[print:BOOLEAN]=
  BEGIN InitSegs[];
  EnumerateWires[PlaceOneWire];
  IF print THEN BEGIN
    PrintSegs[];
    debugPrint_TRUE;
    EnumerateGrid[PrintOrientations];
    debugPrint_FALSE
    END;
  END;

PlaceOneWire:PROCEDURE[wire:WirePtr]=
 BEGIN BackwardRun[wire,ForwardRun[wire]]; END;

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

    OneNode:PROCEDURE[n:NodePtr]RETURNS[BOOLEAN]=
     BEGIN RETURN[n.hop>maxLength OR EnumerateFollow[n,OnePlace]]; END;
    OnePlace:PROCEDURE[n:NodePtr,s:SegPtr,level:BOOLEAN]RETURNS[BOOLEAN]=
       BEGIN
       done_AddHopper[s,n.hop+1,n,TRUE,level];
       IF IllegalNode[done] THEN Error;
       RETURN[done#NIL];
       END;
    SetEnd:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
       BEGIN
       done_AlsoAdd[s,none,terminalHop];
       done.contact_c;
       IF IllegalNode[done] THEN Error;
       RETURN[done#NIL];
       END;
    SetStart:PROCEDURE[s:SegPtr, c: Contact]RETURNS[BOOLEAN]=
       BEGIN
       done_AlsoAdd[s,none,0];
       done.contact_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]RETURNS[done:NodePtr]=BEGIN
  level:BOOLEAN_s.xy.l;
  IF s=NIL OR s.dummy AND t=n THEN RETURN[NIL];
  done_AddHopper[s,h,NIL,TRUE,level];
  IF t=none AND ~s.dummy AND ~s.nc THEN RETURN;
  IF done=NIL AND (t=s OR t=f) AND ~s.bc AND ~s.dummy
         THEN done_AddHopper[s.back,h,NIL,FALSE,level];
  IF done=NIL AND t#n AND  s.bc THEN done_AlsoAdd[s.back,b,h];
  IF done=NIL AND t#b AND  s.nc THEN done_AlsoAdd[s.next,n,h];
  IF done=NIL AND t#s AND ~s.dummy THEN done_AlsoAdd[s.first,f,h];
  IF done=NIL AND t#f AND ~s.dummy THEN done_AlsoAdd[s.second,s,h];
  IF done=NIL AND t#a AND ~s.dummy THEN done_AlsoAdd[s.across,a,h];
  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] UNTIL n=NIL DO
            where_SetSeg[from:n,col:color,circuit:w.circuit,old:where,
            tieN:~free AND ~down, tieB:~free AND  down];
            free _ TRUE
          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]
  RETURNS[NodePtr]=BEGIN
  i:INTEGER; t:NodePtr;
  IF s.w=l OR s.w=d THEN RETURN[NIL];
  IF ~s.dummy AND s.xy.l#l THEN BEGIN Error; RETURN[NIL]; END;
  FOR i IN [0..hopperInsert) DO
    t_@hopperList[i];
    IF s=t.s AND l=t.l
    THEN BEGIN IF t.hop=terminalHop AND h#terminalHop
                 THEN t.back_bk ELSE t_NIL; RETURN[t]; END;
    ENDLOOP;
  t_AddToHopper[];
  t^_[s:s,hop:h,back:bk,normal:nor,movingLD:LD[bk.s,s],l:l, contact: none];
  RETURN[NIL];
  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 ///////

followAns:ARRAY[0..20) OF SegPtr;
topAns:INTEGER;

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
    IF v.across#NIL THEN BEGIN
      IF ~(v.dummy AND (n.l OR v.across.dummy)) THEN v_v.across;
      EXIT;
      END;
    IF v.dummy THEN Error;
    ENDLOOP;
  RETURN[call[n,v,~n.l]];
  END;

home:Where;
homeL:BOOLEAN;

StartFollow:PROCEDURE[n:NodePtr]=BEGIN
  w,t:SegPtr_NIL;
  s:SegPtr_n.s;
  ld:BOOLEAN_n.movingLD;
  IF s=NIL THEN BEGIN Error; RETURN; END;
  home_s.xy;
  homeL_n.l;
  topAns_0;
  IF n.hop=0 THEN BEGIN F1B[s.first]; F1B[s.second]; RETURN; END;
  IF homeL AND s.dummy AND s.ac THEN FOR t_s.across,t.next DO
          IF t.first#NIL
          THEN IF t.second#NIL THEN RETURN ELSE w_t.first
          ELSE IF t.second#NIL THEN w_t.second ELSE IF t.nc THEN LOOP;
          IF w=NIL AND ~t.nc THEN EXIT;
          IF w#NIL AND ld#LDOk[t,w] THEN RETURN;
          IF ~t.nc THEN BEGIN F1B[w]; RETURN; END;
          ENDLOOP;
  IF s.nc AND ~(homeL AND s.dummy) THEN FOR t_s.next,t.next DO
          IF t.first#NIL
          THEN IF t.second#NIL THEN RETURN ELSE w_t.first
          ELSE IF t.second#NIL THEN w_t.second ELSE IF t.nc THEN LOOP;
          IF w=NIL AND ~t.nc THEN EXIT;
          IF w#NIL AND ld#LDOk[t,w] THEN RETURN;
          IF ~t.nc THEN BEGIN F1B[w]; RETURN; END;
          ENDLOOP;
  IF s.first#NIL AND s.second#NIL OR ~s.bc THEN BEGIN
        F1B[IF ld=LDOk[s,s.first] THEN s.first ELSE s.second]; RETURN; END;
  FOR t_s,IF homeL AND t.dummy THEN t.across ELSE t.back DO
          w_t.first;  IF w#NIL AND ld=LDOk[t,w] THEN EXIT;
          w_t.second; IF w#NIL AND ld=LDOk[t,w] THEN EXIT;
          IF t=NIL THEN BEGIN Error; RETURN; END;
          ENDLOOP;
  F1B[w];
  END;

F1B:PROCEDURE[m:SegPtr]=BEGIN
  t:BOOLEAN; s,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;
    t_Right[m];
    AddFollow[IF t THEN m ELSE IF m.dummy AND homeL THEN m.across ELSE m.back];
    IF c=2 THEN EXIT;
    k_IF m.dummy AND homeL THEN m.across ELSE IF t THEN m.next ELSE m.back;
    FOR s_k,IF t THEN s.next ELSE s.back
      UNTIL TowardHome[m_s.first] OR TowardHome[m_s.second] DO ENDLOOP;
    ENDLOOP;
  END;

LD:PROCEDURE[a,b:SegPtr] RETURNS[BOOLEAN]=
 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]=
 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
  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
  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;
  topAns_topAns+1;
  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)\i3I11i98I967b15B40b13B193b16B3585b11B52b9B671b15B304b14B66b10B