{ Note the whole basic problem is that we use separate colour names for 
{ the grid array and the framestore. always keep this in mind...}

%externalroutine extract(%string(31) file,
                         %record(conf) con fm,
                         %record(array fm)%array %name grid (-frames:xrlim+frames),
                                  oldgrid(-frames:xrlim+frames),
                         %record(conf)%arrayname con (1:200))

%constinteger draw BLACK=0,draw RED=1,draw GREEN=2,draw BLUE=4
%constinteger draw YELLOW=draw red+draw green,
              draw MAGENTA=draw red+draw blue,
              draw CYAN=draw blue+draw green
%constinteger draw WHITE=draw red+draw green+draw blue

! The numbering in grid seems to be thus
!  1 = red/poly  2 = green/diff  4= blue/metal 8 = implant
!  64   " " " mkd 128 " " " mkd I may thus use (at risk) 32 and 16

%integer xlim,ylim,ncon,ox,oy,faulty=0
%integer i,col,mask,wid,sx,sy,curcol,curwid,cx,cy,ndxy
%integer path,pathlim,otherlim,tcount
%string(255) str
%string(1) but,tran
%constinteger red=0,green=1,blue=2,yellow=3,pm=0,bu=12
%constinteger full=1,notfull=0,end=1,notend=0
%constinteger N=1,E=2,S=3,W=4
%constintegerarray maxwid(red:blue)=2,2,4
%constbyteintegerarray rym(red:yellow)=1,2,4,8
%constbyteinteger rmark=64,gmark=128
%constbyteinteger rm=1,gm=2,rgm=3,rgym=11,rgmm=195,notrgmm=60
%conststring(9)%array layername(red:blue)= %c
  "poly","diffusion","metal"
%conststring(1)%array pathname(red:green)="p","d"
%conststring(5)%array conname(pm:bu-1)= %c
  "pm","dm","pdbn","pdbe","pdbs","pdbw","pdbns","pdbew",
  "pdcn","pdce","pdcs","pdcw"
%conststring(2) snl=";
"
%routinespec search
%integerfnspec square(%integer x,y)
%integerfnspec north(%integer x,y)
%integerfnspec east(%integer x,y)
%integerfnspec south(%integer x,y)
%integerfnspec west(%integer x,y)
%routinespec findend(%integer x,y,d,%integername nx,ny,nd)
%integerfnspec findseg(%integer x,y,d,%integername nx,ny,nd)
%routinespec generate(%integer x,y,d)
%routinespec genwire(%integer x,y,d)
%routinespec gentran(%integer x,y,d)
%routinespec gensubst(%integer x,y,d)
%routinespec gensubs(%integer x,y,d)
%routinespec transistor(%string(1) xy,%integer x,y,l)
%routinespec wire(%string(1) xy,%integer x,y,l)
%routinespec dxy(%string(1) xy,%integer l)
%routinespec mark(%integer xl,xr,yb,yt,col)
%routinespec clearmarks(%integer mask,mark)
%routinespec clear(%integer xl,xr,yb,yt)
%routinespec fault(%integer x,y)

%byte language

  error ptr = 0 {@@@}
  toupper(file)
  %if file -> str.(".PAS") %start
    language = pascal
  %else
    language = imp
  %finish
  select output(0) 
  print symbol (13)
  printstring("Writing ".lap(language)." to ".file)
  newline
  ncon = confm_t
  ox= confm_x
  oy = confm_y
  open output(2,file)
  select output(2)
  newline
  print string ("  symbol (".encstring(language))
! %if symbol name = "" %start
      print string(str)
! %else
!     print string (symbol name)
! %finish
  print string (encstring(language).")")
  curcol=-1
  tcount=1
  {find transistors - "dtb"-type first}
  but="b" ; wid=2
  %for i=1,1,ncon %cycle
    %if con(i)_t#bu %then %continue
    cx=con(i)_x ; cy=con(i)_y
    mask=rgym
    %if square(cx-1,cy)=full %then %start
      mask=gm
      %if south(cx-1,cy)=full %then mask=rgym %and %c
        generate(cx-1,cy,N) %and %continue
    %finish %else %c
    %if square(cx,cy-1)=full %then %start
      mask=gm
      %if west(cx,cy-1)=full %then mask=rgym %and %c
        generate(cx,cy-1,E) %and %continue
    %finish %else %c
    %if square(cx-1,cy-2)=full %then %start
      mask=gm
      %if north(cx-1,cy-2)=full %then mask=rgym %and %c
        generate(cx-1,cy-2,S) %and %continue
    %finish %else %c
    %if square(cx-2,cy-1)=full %then %start
      mask=gm
      %if east(cx-2,cy-1)=full %then mask=rgym %and %c
        generate(cx-2,cy-1,W) %and %continue
    %finish
    fault(cx,cy) ; fault(cx,cy-1)
    fault(cx-1,cy-1) ; fault(cx-1,cy)
  %repeat
  but="" ; mask=rgym    {wid=2}
  search    {for rest of depletion mode transistors}
  clearmarks(rm,rmark)
  clearmarks(gm,gmark)
  mask=rgm
  search    {for enhancement mode transistors}
  clearmarks(rm,rmark)
  clearmarks(gm,gmark)
  %for col=red,1,blue %cycle
    %for wid=maxwid(col),-1,1 %cycle
      mask=rym(col)
      search
    %repeat
  %repeat
  {output list of contacts}
  select output(2)
  %for i=1,1,ncon %cycle
    %if con(i)_t=bu %then %continue    {already dealt with}
    printsymbol(';')
    newline
    print string("    ".conname(con(i)_t)."(")
    write(con(i)_x-ox,0)
    print symbol(',')
    write(con(i)_y-oy,0)
    print symbol(')')
  %repeat
  printsymbol(';')
  newline
  print string("  endsymbol")
  printsymbol(';')
  newline
  close output
  select output(0)
  %if faulty=0 %then printstring("OK") %else printstring("Errors!")
  newline
  %return
!------------------------------------------------------------------------
%routine search
%integer x,y,nx,ny,nd
  %for x=minimumx,1,maximumx %cycle             {
    %for y=minimum y,1,maximum y %cycle           { but to speed up with virtual grid...
      %cycle
        %if square(x,y)=notfull %then %exit
        %if north(x,y)=notfull %then generate(x,y,E) %and %continue
        %if east(x,y)=notfull %then generate(x,y,N) %and %continue
        sx=x ; sy=y    {for loop checking}
        findend(x,y,N,nx,ny,nd)
        generate(nx,ny,nd)
      %repeat
    %repeat
  %repeat
%end
!----------------------------------------------------------------------
%integerfn square(%integer x,y)
%integer xx,yy
  %for xx=x,1,x+wid-1 %cycle
    %for yy=y,1,y+wid-1 %cycle
      %if grid(xx)_y(yy)&mask#mask %then %result=notfull
    %repeat
  %repeat
  %result=full
%end
!------------------------------------------------------------------------
%integerfn north(%integer x,y)
%integer xx,yy
  yy=y+wid
  %for xx=x,1,x+wid-1 %cycle
    %if grid(xx)_y(yy)&mask#mask %then %result=notfull
  %repeat
  %result=full
%end
!------------------------------------------------------------------------
%integerfn east(%integer x,y)
%integer xx,yy
  xx=x+wid
  %for yy=y,1,y+wid-1 %cycle
    %if grid(xx)_y(yy)&mask#mask %then %result=notfull
  %repeat
  %result=full
%end
!------------------------------------------------------------------------
%integerfn south(%integer x,y)
%integer xx,yy
  yy=y-1
  %for xx=x,1,x+wid-1 %cycle
    %if grid(xx)_y(yy)&mask#mask %then %result=notfull
  %repeat
  %result=full
%end
!------------------------------------------------------------------------
%integerfn west(%integer x,y)
%integer xx,yy
  xx=x-1
  %for yy=y,1,y+wid-1 %cycle
    %if grid(xx)_y(yy)&mask#mask %then %result=notfull
  %repeat
  %result=full
%end
!------------------------------------------------------------------------
%routine findend(%integer x,y,d,%integername nx,ny,nd)
  { since a T junction terminates the search, any loop must
  { eventually pass through the starting point again!
  %if findseg(x,y,d,nx,ny,nd)#end %and (nx#sx %or ny#sy) %then findend(nx,ny,nd,nx,ny,nd)
%end
!--------------------------------------------------------------------------
%integerfn findseg(%integer x,y,d,%integername nx,ny,nd)
%switch scan(N:W)
%integer nn,ee,ss,ww
  nx=x ; ny=y
  ->scan(d)

scan(N):{scan to north for end of segment}
  %cycle
    %if north(nx,ny)=full %then ny=ny+1 %else %exit
  %repeat
  ee=east(nx,ny) ; ww=west(nx,ny)
  %if ee=notfull %and ww=notfull %then nd=S %and %result=end
  %if ee=full %and ww=full %then %start    {T junction}
    %if y<=ny-wid %then ny=ny-wid  {allow T to be crossed}
    nd=S ; %result=end
  %finish
  %if ee=full %then nd=E %else nd=W
  %result=notend

scan(E):{move east as far as possible}
  %cycle
    %if east(nx,ny)=full %then nx=nx+1 %else %exit
  %repeat
  nn=north(nx,ny) ; ss=south(nx,ny)
  %if nn=notfull %and ss=notfull %then nd=W %and %result=end
  %if nn=full %and ss=full %then %start    {T junction}
    %if x<=nx-wid  %then nx=nx-wid    {allow T to be crossed}
    nd=W ; %result=end
  %finish
  %if nn=full %then nd=N %else nd=S
  %result=notend

scan(S):{scan south to end of segment}
  %cycle
    %if south(nx,ny)=full %then ny=ny-1 %else %exit
  %repeat
  ee=east(nx,ny) ; ww=west(nx,ny)
  %if ee=notfull %and ww=notfull %then nd=N %and %result=end
  %if ee=full %and ww=full %then %start    {T junction}
    %if y>=ny+wid  %then ny=ny+wid    {allow T to be crossed}
    nd=N ; %result=end
  %finish
  %if ee=full %then nd=E %else nd=W
  %result=notend

scan(W):{scan west to end of segment}
  %cycle
    %if west(nx,ny)=full %then nx=nx-1 %else %exit
  %repeat
  nn=north(nx,ny) ; ss=south(nx,ny)
  %if nn=notfull %and ss=notfull %then nd=E %and %result=end
  %if nn=full %and ss=full %then %start    {T junction}
    %if x>=nx+wid  %then nx=nx+wid    {allow T to be crossed}
    nd=E ; %result=end
  %finish
  %if nn=full %then nd=N %else nd=S
  %result=notend

%end
!------------------------------------------------------------------------
%routine generate(%integer x,y,d)
  %if mask&rgm=rgm %then gentran(x,y,d) %else genwire(x,y,d)
%end
!--------------------------------------------------------------------------
%routine genwire(%integer x,y,d)
%integer nx,ny,nd,seg
%switch gen(N:W)
  seg=findseg(x,y,d,nx,ny,nd)
  ->gen(d)

gen(N):wire("y",x,y,ny-y+wid)
  clear(x,x+wid-1,y,ny+wid-1)
  ->subs

gen(E):wire("x",x,y,nx-x+wid)
  clear(x,nx+wid-1,y,y+wid-1)
  ->subs

gen(S):wire("y",x,y+wid,ny-y-wid)
  clear(x,x+wid-1,ny,y+wid-1)
  ->subs

gen(W):wire("x",x+wid,y,nx-x-wid)
  clear(nx,x+wid-1,y,y+wid-1)

subs:%if seg#end %then gensubs(nx,ny,nd)
%end
!-----------------------------------------------------------------------
%routine gentran(%integer x,y,d)
%integer nx,ny,nd,seg,oldmask
%switch gen(N:W)
  seg=findseg(x,y,d,nx,ny,nd)
  {assumes wid=2 and diff & poly extensions of 2}
  %if mask=rgm %then tran="e" %else tran="d"
  oldmask=mask ; mask=rym(red)
  ->gen(d)

gen(N):%if south(x,y)=full %then path=red %else path=green
  transistor("y",x,y,ny-y+2)
  pathlim=ny+1
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim+2 %else otherlim=otherlim+2
  mark(x,x+1,y-2,pathlim,path)
  mark(x-2,x+3,y,otherlim,path!!1)    {swops red & green !!}
  ->subst

gen(E):%if west(x,y)=full %then path=red %else path=green
  transistor("x",x,y,nx-x+2)
  pathlim=nx+1
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim+2 %else otherlim=otherlim+2
  mark(x-2,pathlim,y,y+1,path)
  mark(x,otherlim,y-2,y+3,path!!1)
  ->subst

gen(S):%if north(x,y)=full %then path=red %else path=green
  transistor("y",x,y+2,ny-y-2)
  pathlim=ny
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim-2 %else otherlim=otherlim-2
  mark(x,x+1,pathlim,y+3,path)
  mark(x-2,x+3,otherlim,y+1,path!!1)
  ->subst

gen(W):%if east(x,y)=full %then path=red %else path=green
  transistor("x",x+2,y,nx-x-2)
  pathlim=nx
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim-2 %else otherlim=otherlim-2
  mark(pathlim,x+3,y,y+1,path)
  mark(otherlim,x+1,y,y+1,path!!1)
subst:mask=oldmask
  %if seg#end %then gensubst(nx,ny,nd)
%end
!---------------------------------------------------------------------
%routine gensubst(%integer x,y,d)
%integer seg,nx,ny,nd
%switch leg(N:W)
  seg=findseg(x,y,d,nx,ny,nd)
  ->leg(d)

leg(N):dxy("y",ny-y)
  pathlim=ny+1
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim+2 %else otherlim=otherlim+2
  mark(x,x+1,y+2,pathlim,path)
  mark(x-2,x+3,y+4,otherlim,path!!1)
  ->rest

leg(E):dxy("x",nx-x)
  pathlim=nx+1
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim+2 %else otherlim=otherlim+2
  mark(x+2,pathlim,y,y+1,path)
  mark(x+4,otherlim,y-2,y+3,path!!1)
  ->rest

leg(S):dxy("y",ny-y)
  pathlim=ny
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim-2 %else otherlim=otherlim-2
  mark(x,x+1,pathlim,y-1,path)
  mark(x-2,x+3,otherlim,y-3,path!!1)
  ->rest

leg(W):dxy("x",nx-x)
  pathlim=nx
  otherlim=pathlim
  %if seg=end %then pathlim=pathlim-2 %else otherlim=otherlim-2
  mark(pathlim,x-1,y,y+1,path)
  mark(otherlim,x-3,y-2,y+3,path!!1)

rest:%if seg#end %then gensubst(nx,ny,nd)
%end
!-----------------------------------------------------------------------
%routine gensubs(%integer x,y,d)
%integer seg,nx,ny,nd
%switch leg(N:W)
  seg=findseg(x,y,d,nx,ny,nd)
  ->leg(d)

leg(N):dxy("y",ny-y)
  clear(x,x+wid-1,y+wid,ny+wid-1)
  ->rest

leg(E):dxy("x",nx-x)
  clear(x+wid,nx+wid-1,y,y+wid-1)
  ->rest

leg(S):dxy("y",ny-y)
  clear(x,x+wid-1,ny,y-1)
  ->rest

leg(W):dxy("x",nx-x)
  clear(nx,x-1,y,y+wid-1)

rest:%if seg#end %then gensubs(nx,ny,nd)
%end
!------------------------------------------------------------------------
%routine transistor(%string(1) xy,%integer x,y,l)
  select output(2)
  printsymbol(';')
  newline
  print string("    ".tran."t".pathname(path).but.xy."(".encstring(language)."t")
  write(tcount,0)
  print string(encstring(language).",")
  write(x-ox,0)
  print symbol(',')
  write(y-oy,0)
  print symbol(',')
  write(l,0)
  print symbol(')')
  tcount=tcount+1
  ndxy=0
%end
!-----------------------------------------------------------------------
%routine wire(%string(1) xy,%integer x,y,l)
%constintegerarray standwid(red:blue)=2,2,3
  select output(2)
  %if col#curcol %then %start    {everything on one layer together}
    printsymbol(';')
    newline
    print string("  layer(".layername(col).")")
    curcol=col
    curwid=standwid(col)
  %finish
  %if wid#curwid %then %start
    printsymbol(';')
    newline
    print string("    width(")
    write(wid,0)
    print symbol(')')
    curwid=wid
  %finish
  printsymbol(';')
  newline
  print string("    wire".xy."(")
  write(x-ox,0)
  print symbol(',')
  write(y-oy,0)
  print symbol(',')
  write(l,0)
  print symbol(')')
  ndxy=0
%end
!------------------------------------------------------------------------
%routine dxy(%string(1) xy,%integer l)
  select output(2)
  %if ndxy=5 %then print string(snl."      ") %and ndxy=0 %c
     %else print string(" ; ")
  print string("d".xy."(")
  write(l,0)
  print symbol(')')
  ndxy=ndxy+1
%end
!------------------------------------------------------------------------
%routine mark(%integer xl,xr,yb,yt,col)
%integer cx,cy,flag
  %if xl>xr %or yb>yt %then %return
  %if col=red %then flag=rmark %else flag=gmark
  %for cx=xl,1,xr %cycle
    %for cy=yb,1,yt %cycle
      grid(cx)_y(cy)=grid(cx)_y(cy)!flag
      %if grid(cx)_y(cy)&rgmm=rgmm %then %start
        grid(cx)_y(cy)=grid(cx)_y(cy)&notrgmm
      %finish
    %repeat
  %repeat
%end
!----------------------------------------------------------------------
%routine clearmarks(%integer mask,mark)
%integer cx,cy,cmask
  cmask=\(mask!mark)
  %for cx=minimum x-frames,1,maximum x+frames %cycle           { similar comment to search
    %for cy=minimum y-frames,1,maximum y+frames %cycle         { 
      %if grid(cx)_y(cy)&mark=0 %then %continue
      %if grid(cx)_y(cy)&mask=0 %then fault(cx,cy)
      grid(cx)_y(cy)=grid(cx)_y(cy)&cmask
    %repeat
  %repeat
%end
!-----------------------------------------------------------------------
%routine clear(%integer xl,xr,yb,yt)
%integer cx,cy
  %for cx=xl,1,xr %cycle
    %for cy=yb,1,yt %cycle
      grid(cx)_y(cy)=grid(cx)_y(cy)!!mask
    %repeat
  %repeat
%end
!------------------------------------------------------------------------
%routine fault(%integer x,y)
  { marks the lambda array as being empty and puts in an error mark }
  { of size one lambda }
  %integer i,j,k,l

{@@@}  error x(error ptr) = x
{@@@}  error y(error ptr) = y    ;! deletion HERE !
{@@@}  error ptr = error ptr + 1
  %return %if x < scxl %or x > scxr %or y < scyb %or y > scyt
  x = toscreenx(x)
  y = toscreeny(y)
  faulty=1
  enable (15)
  colour(draw white)
  k = toxpixel(1)
  l = toypixel(1)
  fill(x,y,k+x,l+y)
  i = k>>1 ; j= l>>1
  colour(draw red)
  fill(x,y,i+x,j+y)
  fill(x+i,y+j,x+k,y+l)
%end
!------------------------------------------------------------------------
%end
!-----------------------------------------------------------------------
%endoffile