! NETVET: Interactively process net lists in .NET and .PAG files, using
! position information from the .CPL file, and vet the order in which the
! pins within each net are visitied.  For power nets (especially when the
! design is to wire-wrapped) there is the option of splitting large nets
! up into smaller nets.
! RWT March 1990

%include "inc:util.imp"
%include "inc:level1.imp"
%begin

! String processing

%externalintegerfnspec heapget(%integer n)
%externalstring(255)%fnspec itos(%integer n,p)

%integerfn encode(%string(255)s)

! The string S is converted into a 32-bit number, which is
! used in subsequent processing instead of the string itself.
! The string is stored on the heap and accessed via a linear
! list hung off a hash table.  The value returned is the
! address of the string (this is assumed to be positive).
! Special cases:  The null string is encoded as the value 0;
! strings which are decimal representations of non-negative
! numbers are encoded as -N-1.

%constinteger hashmax=32
%recordformat hr(%record(hr)%name next,%string(*)%name s)
%ownrecord(hr)%namearray hashtable(0:hashmax-1)
%owninteger initialised=0
%integer h,n,i,num
%bytename k
%record(hr)%name rec

  %string(*)%map newstring(%string(255)s)
! Allocate just enough heap space to hold S, and copy it in.
  %string(*)%name n
  %ownstring(1)nil = ""
    %result == nil %if s=""
    n == string(heapget(length(s)+1))
    n = s
    %result == n
  %end

  %result = 0 %if s=""
  h = 0; n = 0; i = 1; num = 1
  %cycle
    k == charno(s,i)
    k = k-32 %if k>='a'
    h = h+h+k
    %if num#0 %start
      num = 0 %unless 0<=k-'0'<=9
      %if num#0 %start
        num = 0 %if n<=-3276 %or (n=-3276 %and k>'7')
        n = n*10-k+'0' %if num#0
      %finish
    %finish
    i = i+1
  %repeatuntil i>length(s)
  %result = n-1 %unless num=0
  %if initialised=0 %start
    initialised = 1
    hashtable(i) == nil %for i = 0,1,hashmax-1
  %finish
  h = h&(hashmax-1); n = 0; rec == hashtable(h)
  %while rec##nil %cycle
    %result = addr(rec_s) %if rec_s=s
    rec == rec_next
  %repeat
  rec == new(rec)
  rec_s == newstring(s)
  rec_next == hashtable(h); hashtable(h) == rec
  %result = addr(rec_s)
%end

%string(255)%fn decode(%integer n)

! Reconstitute a string from its encoded value.

%string(255)s
  s = ""
  %if n<0 %start
    s = itos(-1-n,0)
  %elseif n>0
    s = string(n)
  %finish
  %result = s
%end

%recordformat pinfm -
  (%record(pinfm)%name next,%integer name,%integer x,y)
%recordformat compfm -
  (%record(compfm)%name next,%integer name,%record(pinfm)%name pins)

%record(compfm)%name comps == nil
%integer minx=256,miny=256,maxx=0,maxy=0

%on 3 %start
  selectoutput(0)
  printstring(event_message); newline
  %return
%finish

%begin {set up hole matrix as blank, read CPL file}
%integer n=0
%integer x,y,prev,this,pin
%record(compfm)%name c==nil
%record(pinfm)%name p
%string(255)s
  %on 9 %start
    printstring(" components"); newline
    %return
  %finish
  prev = 0
  openinput(1,cliparam.".cpl")
  %cycle
    read(s); this = encode(s)   {component name}
    %unless this=prev %start
      prev = this; c == new(c)
      c_name = this; c_pins == nil; c_next == comps; comps == c
      n = n+1; printsymbol(13); write(n,0)
    %finish
    read(s); this = encode(s)   {pin name}
    read(x); read(y)            {pin coords}
    x = x//100; y = y//100
    minx = x %if x<minx; maxx = x %if x>maxx
    miny = y %if y<miny; maxy = y %if y>maxy
    p == new(p); p_name = this; p_x = x; p_y = y
    p_next == c_pins; c_pins == p
  %repeat
%end

%routine box(%integer x0,y0,x1,y1)
  hline(x0,x1,y0); hline(x0,x1,y1)
  vline(x0,y0,y1); vline(x1,y0,y1)
%end

%routine swap(%integername a,b)
%integer c; c = a; a = b; b = c
%end

%constinteger bot=0,top=511,left=0,right=687

%begin {flip board if appropriate, draw it}
%record(compfm)%name c
%record(pinfm)%name p
%integer width=maxx-minx+1,height=maxy-miny+1,n,s,e,w,scale
%integer avw=right-left+1,avh=top-bot+1,swapflag=0
  %if height>width %start
    printstring("Converting portrait to landscape."); newline
    swap(height,width); swap(minx,miny); swap(maxx,maxy)
    swapflag = 1
  %finish
  %if avw//width<avh//height %then scale = avw//width %else scale = avh//height
  clear; colour(blue)
  c == comps
  %while c##nil %cycle
    n = bot; s = top; e=left; w=right
    p == c_pins
    %while p##nil %cycle
      swap(p_x,p_y) %unless swapflag=0
      p_x = (p_x-minx)*scale+4
      p_y = (p_y-miny)*scale+4
      n = p_y %if p_y>n
      s = p_y %if p_y<s
      e = p_x %if p_x>e
      w = p_x %if p_x<w
      plot(p_x,p_y)
      p == p_next
    %repeat
    box(w-3,s-3,e+3,n+3)
    c == c_next
  %repeat
%end

%begin {process net lists}

%routine process(%string(5)ext,%integer limit)
%record(compfm)%name c
%record(pinfm)%name p
%recordformat netpinfm(%record(netpinfm)%name next,
  %record(compfm)%name c,%record(pinfm)%name p,%integer x,y)
%record(netpinfm)%name set==nil,beg,end,np
%integer mouseb,mousex=256,mousey=256
%string(255)netname="",net="",comp,pin
%integer subnetno=0,this,prev=0,cn,pn,n=1,mx,my

%routine output pin(%record(netpinfm)%name p)
  printstring(netname)
  printsymbol('_') %and write(subnetno,0) %unless subnetno=0
  space; printstring(decode(p_c_name))
  printsymbol('-'); printstring(decode(p_p_name)); newline
%end

%routine join(%record(netpinfm)%name p,q)
  %returnif p==nil %or q==nil
  line(p_x,p_y,q_x,q_y)
%end

%routine square(%record(netpinfm)%name p,%integer d)
  %returnif p==nil
  hline(p_x-d,p_x+d,p_y-d); hline(p_x-d,p_x+d,p_y+d)
  vline(p_x-d,p_y-d,p_y+d); vline(p_x+d,p_y-d,p_y+d)
%end

%integerfn sq(%integer z)
  %result = z*z
%end

%record(netpinfm)%map nearest(%record(netpinfm)%name set,%integer x,y)
%record(netpinfm)%name this,best
%integer dist,min=-1
  %signal 15,,,"No nearest" %if set==nil
  best == nil; this == set
  %cycle
    dist = sq(this_x-x)+sq(this_y-y)
    %if min<0 %or dist<min %start
      min = dist; best == this
    %finish
    this == this_next
  %repeatuntil this==nil
  %result == best
%end

%record(netpinfm)%map furthest(%record(netpinfm)%name set,%integer x,y)
%record(netpinfm)%name this,best
%integer dist,max=-1
  %signal 15,,,"No furthest" %if set==nil
  best == nil; this == set
  %cycle
    dist = sq(this_x-x)+sq(this_y-y)
    %if dist>max %start
      max = dist; best == this
    %finish
    this == this_next
  %repeatuntil this==nil
  %result == best
%end

%record(netpinfm)%map addto(%record(netpinfm)%name set,item)
  %result == set %if item==nil
  item_next == set; %result == item
%end

%record(netpinfm)%map removefrom(%record(netpinfm)%name set,item)
%record(netpinfm)%name pred == set
  %signal 15,,,"Cannot remove null item from a set" %if item==nil
  %if item==set %start
    set == item_next; item_next == nil; %result == set
  %finish
  %cycle
    %signal 15,,,"Item to be removed not found in set" %if pred==nil
    %if pred_next==item %start
      pred_next == item_next; item_next == nil; %result == set
    %finish
    pred == pred_next
  %repeat
%end
  
%record(netpinfm)%map reverse(%record(netpinfm)%name head)
%record(netpinfm)%name item,tail==nil
  %cycle
    %result == tail %if head==nil
    item == head; head == item_next
    item_next == tail; tail == item
  %repeat
%end

%record(netpinfm)%map new pin
%record(netpinfm)%name np
  np == new(np)
  np_c == c; np_p == p
  np_x = p_x; np_y = p_y
  np_next == nil
  %result == np
%end

%routine show wires(%record(netpinfm)%name q)
%record(netpinfm)%name p==nil
  %while q##nil %cycle
    join(p,q); p == q; q == q_next
  %repeat
%end

%routine erase
  colour(black); fill(left,bot,right,top)
%end

%routine cursor
! Use global variables MOUSEX, MOUSEY, MOUSEB.
! Put up cursor, wait until all buttons released,
! Then move cursor around until (a) button(s) is/are pressed.
! Remove cursor.
%integer dx,dy,x,y,b
  %routine draw
  %integer l,r,b,t
    x = left %if x<left; x = right %if x>right
    y = bot %if y<bot; y = top %if y>top
    l = x-7; l = left %if l<left
    r = x+7; r = right %if r>right
    b = y-7; b = bot %if b<bot
    t = y+7; t = top %if t>top
    hline(l,r,y); vline(x,b,t)
  %end
  x = mousex; y = mousey
  enable(8); colour(8); draw
  b = mousebuttons&7 %until b=0
  %cycle
    dx = relmousex; dy = relmousey; b = mousebuttons&7
    %if dx=0 %and dy=0 %start
      %exitif b#0
    %else
      colour(0); draw
      x = x+dx; y = y+dy
      colour(8); draw
    %finish
  %repeat
  mousex = x; mousey = y; mouseb = b
  colour(0); draw; enable(255)
%end

%integerfn mousedistanceto(%record(netpinfm)%name p)
  %result = int(sqrt(sq(p_x-mousex)+sq(p_y-mousey)))
%end

%routine autosort(%record(netpinfm)%name beg,end)

! Order SET such that the route beginning at BEG, calling at
! every point in SET, and ending at END, is "optimal".  In fact
! the optimal solution (involving all permutations) is attempted
! only when SET contains no more than 5 points.  Otherwise a simpler
! algorithm (potentially liable to poor behaviour) is used:
! Points in the set are removed and connected to BEG and END alternately
! until the size of the set is reduced to at most 5.  The optimal
! solution is applied to what remains.

! If BEG is NIL (in which case END is also NIL), SET contains N points.
! If BEG is not NIL, SET contains N-1 points if END is NIL, otherwise
! SET contains N-2 points.

%constshortarray limit(1:5)=5,5,3*5,12*5,60*5  {limit(i) is 5*i!//2}

! For each K from 1 to 5!//2=60, PERMS(5*K:5*K+4) is the Kth permutation of
! {1,2,3,4,5}.  In all of these 1 occurs before 2.  They are ordered such
! that the first 12 groups all end in 5, the other 4 digits representing the
! permutations of {1,2,3,4}.  Similarly the first 3 groups all end in 4,5
! and represent the 3 permutations of {1,2,3}.

%constbytearray perms(5:60*5+4)=-
 1,2,3,4,5, 1,3,2,4,5, 3,1,2,4,5, 1,2,4,3,5,
 1,4,2,3,5, 4,1,2,3,5, 1,3,4,2,5, 3,1,4,2,5,
 1,4,3,2,5, 4,1,3,2,5, 3,4,1,2,5, 4,3,1,2,5,
 1,2,3,5,4, 1,3,2,5,4, 3,1,2,5,4, 1,2,5,3,4,
 1,5,2,3,4, 5,1,2,3,4, 1,3,5,2,4, 3,1,5,2,4,
 1,5,3,2,4, 5,1,3,2,4, 3,5,1,2,4, 5,3,1,2,4,
 1,2,4,5,3, 1,4,2,5,3, 4,1,2,5,3, 1,2,5,4,3,
 1,5,2,4,3, 5,1,2,4,3, 1,4,5,2,3, 4,1,5,2,3,
 1,5,4,2,3, 5,1,4,2,3, 4,5,1,2,3, 5,4,1,2,3,
 1,3,4,5,2, 3,1,4,5,2, 1,4,3,5,2, 4,1,3,5,2,
 3,4,1,5,2, 4,3,1,5,2, 1,3,5,4,2, 3,1,5,4,2,
 1,5,3,4,2, 5,1,3,4,2, 3,5,1,4,2, 5,3,1,4,2,
 1,4,5,3,2, 4,1,5,3,2, 1,5,4,3,2, 5,1,4,3,2,
 4,5,1,3,2, 5,4,1,3,2, 3,4,5,1,2, 4,3,5,1,2,
 3,5,4,1,2, 5,3,4,1,2, 4,5,3,1,2, 5,4,3,1,2

%integer dist,optdist=-1,a,b,c,d,e,oa,ob,oc,od,oe,i,j,x,y
%record(netpinfm)%namearray point(1:5)
%record(netpinfm)%name p

%integerfn distance(%record(netpinfm)%name p,q)
  %result = 0 %if p==nil %or q==nil
  %result = {int(sqrt(}   sq(p_x-q_x)+sq(p_y-q_y)   {))}
%end

  j = n-2
  j = j+1 %if beg==nil
  j = j+1 %if end==nil
  %cycle
  %if beg==nil %or end##nil %start
    %exitif j<=5; j = j-1
    %if beg==nil %start
      p == furthest(set,mx,my)
    %else
      p == nearest(set,beg_x,beg_y)
    %finish
    set == removefrom(set,p)
    beg == addto(beg,p)
  %finish
    %exitif j<=5; j = j-1
    %if end==nil %start
      p == furthest(set,beg_x,beg_y)
    %else
      p == nearest(set,end_x,end_y)
    %finish
    set == removefrom(set,p)
    end == addto(end,p)
  %repeat
  %for i = 1,1,5 %cycle
    point(i) == set
    set == removefrom(set,set) %unless set==nil
  %repeat
  %signal 15,,,"Set not razed" %unless set==nil
  %for i = 5,5,limit(j) %cycle
    a = perms(i)
    b = perms(i+1)
    c = perms(i+2)
    d = perms(i+3)
    e = perms(i+4)
    dist = distance(beg,point(a))
    dist = dist+distance(point(a),point(b))
    dist = dist+distance(point(b),point(c))
    dist = dist+distance(point(c),point(d))
    dist = dist+distance(point(d),point(e))
    dist = dist+distance(point(e),end)
    %if optdist<0 %or dist<optdist %start
      optdist = dist; oa = a; ob = b; oc = c; od = d; oe = e
    %finish
    %continueif beg==nil
    a = perms(i+4)
    b = perms(i+3)
    c = perms(i+2)
    d = perms(i+1)
    e = perms(i)
    dist = distance(beg,point(a))
    dist = dist+distance(point(a),point(b))
    dist = dist+distance(point(b),point(c))
    dist = dist+distance(point(c),point(d))
    dist = dist+distance(point(d),point(e))
    dist = dist+distance(point(e),end)
    %if optdist<0 %or dist<optdist %start
      optdist = dist; oa = a; ob = b; oc = c; od = d; oe = e
    %finish
  %repeat
  %unless beg==nil %start
    beg == reverse(beg)
    %cycle
      p == beg; beg == removefrom(beg,p)
      set == addto(set,p)
    %repeatuntil beg==nil
  %finish
  set == addto(set,point(oa))
  set == addto(set,point(ob))
  set == addto(set,point(oc))
  set == addto(set,point(od))
  set == addto(set,point(oe))
  %unless end==nil %start
    %cycle
      p == end; end == removefrom(end,p)
      set == addto(set,p)
    %repeatuntil end==nil
  %finish
%end

  %on 9 %start
    this = 0; ->process net
  %finish
  openinput(1,cliparam.ext); selectinput(1)
  openoutput(1,cliparam.ext."."); selectoutput(0)
  %cycle
    read(net); read(pin); pin -> comp.("-").pin
    this = encode(net); cn = encode(comp); pn = encode(pin)
    c == comps
    %cycle
      %if c==nil %start
        printstring("Unknown component "); ->junk
      %finish
      %exitif c_name=cn; c == c_next
    %repeat
    p == c_pins
    %cycle
      %if p==nil %start
        printstring("Unknown pin ")
junk:   printstring(comp); printsymbol('-')
        printstring(pin); printstring(" in net ")
        printstring(net); newline
        c == nil; %exit
      %finish
      %exitif p_name=pn; p == p_next
    %repeat
    %continueif c==nil
    %if this=prev %start
      np == newpin
      square(np,2)
      set == addto(set,np)
      n = n+1; mx = mx+p_x; my = my+p_y
    %else
process net: beg == nil; end == nil; ->accept %if set==nil
      spaces(length(netname)); printsymbol(13)
      netname = decode(prev); subnetno = 0
      printstring(netname); printsymbol(13)
      enable(green); colour(green)
      mx = mx//n; my = my//n
      %if n<=limit %start      {No choice for shorties}
        autosort(nil,nil); showwires(set); ->accept
      %finish
      showwires(set)
ask1: cursor; enable(green); erase; colour(green)
      beg == nil %and ->accept %if mouseb=mouseright
      %if mouseb=mouseleft %start  {autoroute from here}
        %if beg==nil %or end##nil %start
          beg == nearest(set,mousex,mousey)
          set == removefrom(set,beg)
          square(beg,3)
          end == nil
        %else
          set == removefrom(set,beg)
          end == nearest(set,mousex,mousey)
          set == removefrom(set,end)
          square(beg,3)
          square(end,3)
        %finish
        autosort(beg,end); showwires(set); ->ask1
      %finish  {manually from here}
      beg == nearest(set,mousex,mousey)
      set == removefrom(set,beg)
      square(beg,3)
ask2: cursor; enable(green); colour(green)
      %if mouseb=mousemiddle %start  {route to or erase from here}
        np == nil; end == nil
        np == nearest(set,mousex,mousey) %unless set==nil
        end == nearest(beg,mousex,mousey) %unless beg==nil
        ->ro %if end==nil
        ->er %if np==nil
        %if mousedistanceto(end)<mousedistanceto(np) %start {erase}
er:       erase; colour(green)
          %cycle
            np == beg; beg == np_next
            np_next == set; set == np
          %repeatuntil np==end
          showwires(beg); square(beg,3)
        %else  {route}
ro:       set == removefrom(set,np)
          join(beg,np)
          np_next == beg; beg == np
          ->ask2 %if set==nil
          %if set_next==nil %start {only one left}
            join(beg,set)
            set_next == beg; beg == set; set == nil
            square(beg,3)
          %finish
        %finish
        ->ask2
      %finish
      %if mouseb=mouseleft %start  {complete}
        %if set==nil %start
          set == beg; beg == nil; end == nil
          ->ask1
        %finish
        %cycle
          np == nearest(set,beg_x,beg_y)
          set == removefrom(set,np)
          join(beg,np)
          np_next == beg; beg == np
        %repeatuntil set==nil
        ->ask2
      %finish  {split net and accept}
      ->accept %if set==nil
      subnetno = 1 %if subnetno=0
      enable(red); colour(black)
      selectoutput(1)
      %while beg##nil %cycle
        np == beg; outputpin(np); square(np,2)
        beg == np_next; dispose(np)
      %repeat
      newline
      selectoutput(0)
      subnetno = subnetno+1
      beg == nearest(set,mousex,mousey)
      set == removefrom(set,beg)
      enable(green); erase; colour(green); square(beg,3)
      ->ask2
accept:
      selectoutput(1)
      beg == reverse(beg)
      %while beg##nil %cycle
        np == beg; outputpin(np); beg == beg_next; dispose(np)
      %repeat
      %while set##nil %cycle
        np == set; outputpin(np); set == np_next; dispose(np)
      %repeat
      newline %unless n=0
      selectoutput(0)
      enable(yellow); erase
      %exitif this=0
      prev = this
      set == newpin
      mx = p_x; my = p_y; n = 1
      colour(red); square(set,2)
    %finish
  %repeat
  selectoutput(1); closeoutput; selectoutput(0); newline
  erase
%end

  printstring("First:   L: Autoroute   M: Handroute   R: Accept"); newline
  printstring("Later:   L: Complete    M: Handroute   R: Split"); newline
  process(".net",5)
  process(".pag",2)
%end

%end