{ Note the whole basic problem is that we use separate colour names for 
{ the grid array and the framestore. always keep this in mind...}
{ slightly amended to not draw anything. should therefore always be followed}
{ by a call to refresh }

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

%external %routine  readilap(%string(31) file,
                             %record (point fm) start,
                             %record (array fm) %array %name grid(-frames:xrlim+frames),
                             %record (conf) %array %name con (1:200),
                             %integer %name con ptr)
%routinespec read line
%routinespec readsym(%integername n)
%routinespec fault(%string(63) s)
%integerfnspec getname(%integername name)
%integerfnspec checklit(%integer sym)
%integerfnspec checksep
%integerfnspec getsexpr(%string(*)%name s)
%integerfnspec getexpr(%integername e)
%routinespec startwort(%integer type,x,y,l)
%routinespec xleg(%integer l)
%routinespec yleg(%integer l)
%routinespec endwort
%routinespec subsw(%integer x,y,p)
%routinespec subst(%record(point fm) pt,%integer path,other,imp,p)
%routinespec box(%integer layer,xl,yb,xr,yt)
%routinespec contact(%integer type,x,y)
%constinteger namessize=100
%ownstring(31)%array names(1:namessize)= %c
  "symbol","endsymbol","etpx","etpy","etdx","etdy",
  "dtpx","dtpy","dtdx","dtdy","dtdbx","dtdby",
  "wirex","wirey","dx","dy","layer","width",
  "pm","dm","pdbn","pdbe","pdbs","pdbw",
  "pdbns","pdbew","pdcn","pdce","pdcs","pdcw",
  "box","vddwirex","vddwirey","gndwirex","gndwirey","poly",
  "diffusion","metal",""(*)

%constinteger ilapprocs=35,etpx=3,dtpx=7,dtdbx=11,dtdby=12,wirex=13, %c
  dy=16,pm=19,poly=36,diffusion=37,metal=38,implant=39,bu=12
%constinteger xdir=1,ydir=2,gndwirey=35
%constbytearray xydir(etpx:gndwirey)=xdir,ydir,xdir,ydir,
  xdir,ydir,xdir,ydir,xdir,ydir,xdir,ydir,xdir,ydir,
0(15),xdir,ydir,xdir,ydir
%constbytearray tranp(etpx:dtdby)=poly,poly,diffusion,diffusion,
  poly,poly,diffusion,diffusion,diffusion,diffusion
%switch ilapname(1:ilapprocs)
%owninteger namesend=39    {ilapproces+layer names}
%constbytearray defaultwidth(poly:metal)=2,2,3
%constinteger tsize=255
%bytearray t(0:tsize)
%constinteger legs=100
%integerarray legx,legy(1:legs)
%constinteger true=1,false=0
%integer tp,name,x,y,l,w,curlay,curwid,wort,wortx,worty,worttype, %c
  faulty,legp,lege,xx,yy,i
%string(255) s,lines,stri

%record(point fm) zero = 0

%conststring(1) snl="
"

%byte language

  %on %event 1,2,3,4,5,6,7,8,9 %start
    select output(2)
    clear line
    printstring(event_message);newline
    close output
    select output(0)
    print string ("** Event ");   write(event_event,-1);   print symbol (',')
    write (event_sub,1);   spaces(2);   printstring(event_message);   newline
    faulty=true 
    ->endfile %unless (event_event = 9 %and event_sub=3) %or event_event=3
    %return
  %finish
 
  open input(2,file)
  select input(2)

  print symbol (13)
  toupper(file)
  %if file -> s.(".PAS") %then language = pascal %else language = imp
  printstring("Reading ".lap(language)." from ".file.", Planting at ")
  write(start_x,3);write(start_y,3)
  newline
  wort=false
  faulty=false

  open output(2,"ted.lis")
  select output(2)
  print string("Input from file: ".file."
")

  curlay=0 ; curwid=0
  tp=0 ; t(tp)=nl    {to trigger first read line}

next:{read next line if necessary}
  %if t(tp)=nl %then read line

  %if getname(name)=false %then fault("unknown statement") %and ->next
  %if name<=ilapprocs %then ->ilapname(name)
  fault("unknown procedure")
  ->next

ilapname(1):{symbol}
  %if checklit('(')=false %then ->error
  %if getsexpr(s)=false %then ->error
  %if lines -> s.(encstring(language)).symbol name  %start;%finish
  %if symbol name -> symbol name .(encstring(language)).s %start;%finish
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  ->next

ilapname(2):{endsymbol}
  %if checksep=false %then ->error
  endwort
endfile:{from event trap}
  select input (2)
  close input
  select output(2)
  %if faulty=true %then printstring("File error") %else printstring("File OK")
  newline
  close output
  select output(0)
  %if faulty=true %then printstring("Data file corrupt") %else printstring("OK")
  newline
  %return

ilapname(3):{etpx}
ilapname(4):{etpy}
ilapname(5):{etdx}
ilapname(6):{etdy}
ilapname(7):{dtpx}
ilapname(8):{dtpy}
ilapname(9):{dtdx}
ilapname(10):{dtdy}
ilapname(11):{dtdbx}
ilapname(12):{dtdby}
  %if checklit('(')=false %then ->error
  %if getsexpr(s)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(x)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(y)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(l)=false %then ->error
  %if l=0 %then fault("zero length transistor") %and ->next
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  startwort(name,x,y,l)
  ->next

ilapname(32):{Vdd wire x}
ilapname(33):{Vdd wire y}
   name = name - 32 + 13
   -> ilapname(14)
ilapname(34):{Gnd wire x}
ilapname(35):{Gnd wire y}
   name = name - 34 + 13
ilapname(13):{wirex}
ilapname(14):{wirey}

  %if checklit('(')=false %then ->error
  %if getexpr(x)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(y)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(l)=false %then ->error
  %if l=0 %then fault("zero length wire") %and ->next
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  %if curlay=0 %then fault("no layer specified for wire") %and ->next
  startwort(name,x,y,l)
  ->next

ilapname(15):{dx}
ilapname(16):{dy}
  %if checklit('(')=false %then ->error
  %if getexpr(l)=false %then ->error
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  %if wort=false %then fault("dx/y out of context") %and ->next
  %if xydir(name)=xdir %then xleg(l) %else yleg(l)
  ->next

ilapname(17):{layer}
  %if checklit('(')=false %then ->error
  %if getname(name)=false %then ->error
  %unless poly<=name<=metal %then fault("unknown layer") %and ->next
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  endwort
  curlay=name
  curwid=defaultwidth(curlay)
  ->next

ilapname(18):{width}
  %if checklit('(')=false %then ->error
  %if getexpr(w)=false %then ->error
  %if w<=0 %then fault("invalid width") %and ->next
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  endwort
  curwid=w
  ->next

ilapname(19):{pm}
ilapname(20):{dm}
ilapname(21):{pdbn}
ilapname(22):{pdbe}
ilapname(23):{pdbs}
ilapname(24):{pdbw}
ilapname(25):{pdbns}
ilapname(26):{pdbew}
ilapname(27):{pdcn}
ilapname(28):{pdce}
ilapname(29):{pdcs}
ilapname(30):{pdcw}
  %if checklit('(')=false %then ->error
  %if getexpr(x)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(y)=false %then ->error
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  contact(name-pm,x,y)
  ->next

ilapname(31):{box}
  %if checklit('(')=false %then ->error
  %if getexpr(x)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(y)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(xx)=false %then ->error
  %if checklit(',')=false %then ->error
  %if getexpr(yy)=false %then ->error
  %if checklit(')')=false %then ->error
  %if checksep=false %then ->error
  %if x>=xx %or y>=yy %then fault("box inside out") %and ->next
  endwort
  box(curlay,x,y,xx,yy)
  ->next

error:fault("invalid statement")
  ->next

!---------------------------------------------------------------------------
%routine read line
%integer i,tpp
  tpp=0
  line s = ""
  %cycle
    readsym(i)
    %if i=' ' %then %continue
    %if i='{' %then %start
      readsym(i) %until i='}' %or i=nl
      %if i='}' %then readsym(i)
    %finish
    %if tpp>tsize %then fault("statement too long") %and %return
    t(tpp)=i ; tpp=tpp+1
    %if i=nl %then %start
      %if tpp=1 %or t(0)='!' %then tpp=0 %and %continue
      %if tpp>=2 %and t(tpp-1)='c' %and t(tpp-2)='%' %then  %c
        tpp=tpp-2 %and %continue
      %exit
    %finish
  %repeat
  tp=0
%end
!-----------------------------------------------------------------------
%routine readsym(%integername n)
  read symbol(n) ; print symbol(n)
  lines = lines.tostring(n)
  %if 'A'<=n<='Z' %then n=n-'A'+'a'
%end
!-----------------------------------------------------------------------
%routine fault(%string(63) s)
%integer tpp
  tpp=0
  print symbol(t(tpp)) %and tpp=tpp+1 %until t(tpp-1)=nl
  spaces(tp) ; print string("^".snl.s.snl)
  tp=tp+1 %while t(tp)#';' %and t(tp)#nl
  %if t(tp)=';' %then tp=tp+1
  faulty=true
%end
!--------------------------------------------------------------------------
%integerfn getname(%integername name)
%string(255) s
  %unless 'a'<=t(tp)<='z' %then %result=false
  s=tostring(t(tp)) ; tp=tp+1
  %while 'a'<=t(tp)<='z' %or '0'<=t(tp)<='9' %cycle
    s=s.tostring(t(tp)) ; tp=tp+1
  %repeat
  {find name in dictionary}
  %for name=1,1,namesend-1 %cycle
    %if s=names(name) %then %result=true
  %repeat
  {insert name if not already in dictionary}
  %if namesend=namessize %then fault("too many names") %and %result=false
  names(namesend)=s
  name=namesend
  namesend=namesend+1
  %result=true
%end
!--------------------------------------------------------------------------
%integerfn checklit(%integer sym)
  %if t(tp)=sym %then tp=tp+1 %and %result=true
  %result=false
%end
!-------------------------------------------------------------------------
%integerfn checksep
  %if t(tp)=';' %then tp=tp+1 %and %result=true
  %if t(tp)=nl %then %result=true
  %result=false
%end
!--------------------------------------------------------------------------
%integerfn getsexpr(%string(*)%name s)
%integer i,tpi
  {string literal only as yet}
  s=""
  %if checklit(encchar(language))=false %then %result=false
  tpi=tp
  %cycle
    i=t(tp) ; tp=tp+1
    %if i=nl %then tp=tpi %and %result=false
    %if i#encchar(language) %then s=s.tostring(i) %and %continue
    i=t(tp)
    %if i#encchar(language) %then %result=true
    s=s.encstring(language)
    tp=tp+1
  %repeat
%end
!--------------------------------------------------------------------------
%integerfn getexpr(%integername e)
%integer i,tpi,sign
  {constants only as yet}
  tpi=tp
  i=t(tp) ; tp=tp+1
  sign=1
  %if i='+' %or i='-' %then %start
    %if i='-' %then sign=-1
    i=t(tp) ; tp=tp+1
  %finish
  %unless '0'<=i<='9' %then tp=tpi %and %result=false
  e=i-'0'
  %cycle
    i=t(tp)
    %unless '0'<=i<='9' %then e=sign*e %and %result=true
    tp=tp+1
    e=10*e+i-'0'
  %repeat
%end
!--------------------------------------------------------------------------
%routine startwort(%integer type,x,y,l)
  endwort
  wort=true
  worttype=type
  wortx=x ; worty=y
  legp=1
  %if xydir(worttype)=xdir %then xleg(l) %else yleg(l)
%end
!----------------------------------------------------------------------
%routine xleg(%integer l)
  %if l=0 %then %return
  %if legp>1 %and legy(legp-1)=0 %then legx(legp-1)=legx(legp-1)+l %else %start
    %if legp>legs %then fault("too many dx/y legs") %and %return
    legx(legp)=l
    legy(legp)=0
    legp=legp+1
  %finish
%end
!----------------------------------------------------------------------
%routine yleg(%integer l)
  %if l=0 %then %return
  %if legp>1 %and legx(legp-1)=0 %then legy(legp-1)=legy(legp-1)+l %else %start
    %if legp>legs %then fault("too many dx/y legs") %and %return
    legy(legp)=l
    legx(legp)=0
    legp=legp+1
  %finish
%end
!-----------------------------------------------------------------------
%routine endwort
%integer l,path,other,imp,pathlim,otherlim,implim
%record(point fm) pt
  %if wort=false %then %return
  lege=legp-1
  %if etpx<=worttype<=dtdby %then %start    {transistors}
    path=tranp(worttype)
    %if path=poly %then other=diffusion %else other=poly
    %if worttype>=dtpx %then imp=true %else imp=false
    %if xydir(worttype)=xdir %then %start
      %if worttype=dtdbx %then contact(bu,wortx,worty+1)
      l=legx(1)
      pathlim=wortx+l ; otherlim=pathlim
      %if l>0 %then %start    {east}
        implim=pathlim+2
        %if lege=1 %then pathlim=implim %else otherlim=implim
        box(path,wortx-2,worty,pathlim,worty+2)
        box(other,wortx,worty-2,otherlim,worty+4)
        %if imp=true %then box(implant,wortx-2,worty-2,implim,worty+4)
        pt_x=wortx+l-2
        pt_y=worty
        %if lege>1 %then subst(pt,path,other,imp,2)
      %finish %else %start    {west}
        implim=pathlim-2
        %if lege=1 %then pathlim=implim %else otherlim=implim
        box(path,pathlim,worty,wortx+2,worty+2)
        box(other,otherlim,worty-2,wortx,worty+4)
        %if imp=true %then box(implant,implim,worty-2,wortx+2,worty+4)
        pt_x=wortx+l
        pt_y=worty
        %if lege>1 %then subst(pt,path,other,imp,2 )
      %finish
    %finish %else %start    {ydir=true}
      %if worttype=dtdby %then contact(bu,wortx+1,worty)
      l=legy(1)
      pathlim=worty+l ; otherlim=pathlim
      %if l>0 %then %start    {north}
        implim=pathlim+2
        %if lege=1 %then pathlim=implim %else otherlim=implim
        box(path,wortx,worty-2,wortx+2,pathlim)
        box(other,wortx-2,worty,wortx+4,otherlim)
        %if imp=true %then box(implant,wortx-2,worty-2,wortx+4,implim)
        pt_x=wortx
        pt_y=worty+l-2
        %if lege>1 %then subst(pt,path,other,imp,2)
      %finish %else %start    {south}
        implim=pathlim-2
        %if lege=1 %then pathlim=implim %else otherlim=implim
        box(path,wortx,pathlim,wortx+2,worty+2)
        box(other,wortx-2,otherlim,wortx+4,worty)
        %if imp=true %then box(implant,wortx-2,implim,wortx+4,worty+2)
        pt_x=wortx
        pt_y=worty+l
        %if lege>1 %then subst(pt,path,other,imp,2)
      %finish
    %finish
  %finish %else %start    {wires}
    %if worttype=wirex %then %start
      l=legx(1)
      %if l>0 %then %start    {east}
        box(curlay,wortx,worty,wortx+l,worty+curwid)
        %if lege>1 %then subsw(wortx+l-curwid,worty,2)
      %finish %else %start    {west}
        box(curlay,wortx+l,worty,wortx,worty+curwid)
        %if lege>1 %then subsw(wortx+l,worty,2)
      %finish
    %finish %else %start    {wirey}
      l=legy(1)
      %if l>0 %then %start    {north}
        box(curlay,wortx,worty,wortx+curwid,worty+l)
        %if lege>1 %then subsw(wortx,worty+l-curwid,2)
      %finish %else %start    {south}
        box(curlay,wortx,worty+l,wortx+curwid,worty)
        %if lege>1 %then subsw(wortx,worty+l,2)
      %finish
    %finish
  %finish
  wort=false
%end
!----------------------------------------------------------------------
%routine subsw(%integer x,y,p)
%integer l
  %if legx(p)=0 %then %start
    l=legy(p)
    %if l>0 %then box(curlay,x,y+curwid,x+curwid,y+curwid+l) %c
            %else box(curlay,x,y+l,x+curwid,y)
    %if lege>p %then subsw(x,y+l,p+1)
  %finish %else %start
    l=legx(p)
    %if l>0 %then box(curlay,x+curwid,y,x+curwid+l,y+curwid) %c
            %else box(curlay,x+l,y,x,y+curwid)
    %if lege>p %then subsw(x+l,y,p+1)
  %finish
%end
!----------------------------------------------------------------------
%routine subst(%record (point fm) pt,%integer path,other,imp,p)
%integer l,pathlim,otherlim,implim
%integer x, y

  x = pt_x     { APM only takes five params }
  y = pt_y

  %if legx(p)=0 %then %start
    l=legy(p)
    %if l>0 %then %start    {north}
      pathlim=y+2+l ; otherlim=pathlim ; implim=pathlim+2
      %if lege=p %then pathlim=implim %else otherlim=implim
      box(path,x,y+2,x+2,pathlim)
      box(other,x-2,y+4,x+4,otherlim)
      %if imp=true %then box(implant,x-2,y+4,x+4,implim)
      pt_y=y+l
      pt_x = x
      %if lege>p %then subst(pt,path,other,imp,p+1)
    %finish %else %start    {south}
      pathlim=y+l ; otherlim=pathlim ; implim=pathlim-2
      %if lege=p %then pathlim=implim %else otherlim=implim
      box(path,x,pathlim,x+2,y)
      box(other,x-2,otherlim,x+4,y-2)
      %if imp=true %then box(implant,x-2,implim,x+4,y-2)
      pt_y=y+l
      pt_x = x
      %if lege>p %then subst(pt,path,other,imp,p+1)
    %finish
  %finish %else %start
    l=legx(p)
    %if l>0 %then %start    {east}
      pathlim=x+l+2 ; otherlim=pathlim ; implim=pathlim+2
      %if lege=p %then pathlim=implim %else otherlim=implim
      box(path,x+2,y,pathlim,y+2)
      box(other,x+4,y-2,otherlim,y+4)
      %if imp=true %then box(implant,x+4,y-2,implim,y+4)
      pt_x=x+l
      pt_y=y
      %if lege>p %then subst(pt,path,other,imp,p+1)
    %finish %else %start    {west}
      pathlim=x+l ; otherlim=pathlim ; implim=pathlim-2
      %if lege=p %then pathlim=implim %else otherlim=implim
      box(path,pathlim,y,x,y+2)
      box(other,otherlim,y-2,x-2,y+4)
      %if imp=true %then box(implant,implim,y-2,x-2,y+4)
      pt_x=x+l
      pt_y = y
      %if lege>p %then subst(pt,path,other,imp,p+1)
    %finish
  %finish
%end
!----------------------------------------------------------------------
%routine contact( %integer type,x,y)

  ! two fold use. first of all increments the contact count and sets it up
  ! secondly it draws it
  %integer i,j,ii,jj              
  !                                  p d pd pd pd pd pd  pd  pd pd pd pd b
  ! sizes of the contacts            m m bn be bs bw bns bew cn ce cs cw u
  %constant %byte %array  xl(0:12) = 2,2,2, 2, 2, 3, 2,  3,  2, 2, 2, 3, 2
  %constant %byte %array  xr(0:12) = 1,1,1, 2, 1, 1, 1,  2,  1, 2, 1, 1, 1
  %constant %byte %array  yb(0:12) = 2,2,2, 2, 3, 2, 3,  2,  2, 2, 3, 2, 2
  %constant %byte %array  yt(0:12) = 1,1,2, 1, 1, 1, 2,  1,  2, 1, 1, 1, 1

  x = x + start_x
  y = y + start_Y

  %return %if x < 0 %or x > xrlim %or y < 0 %or y > yt lim

  %if x + xr(type) > maximum x %then maximum x = x + xr(type)
  %if y + yt(type) > maximum y %then maximum y = y + yt(type)
  %if x - xl(type) < minimum x %then minimum x = x - xl(type)
  %if y - yb(type) < minimum y %then minimum y = y - yb(type)
  %for i = x-xl(type),1,x+xr(type) %cycle
    %for j = y-yb(type),1,y+yt(type) %cycle
      %return %if grid(i)_y(j) & 32 # 0 
    %repeat
  %repeat
  %for i = x-xl(type),1,x+xr(type) %cycle
    %for j = y-yb(type),1,y+yt(type) %cycle
      grid(i)_y(j) = grid(i)_y(j) ! 32
    %repeat
  %repeat
  con(con ptr)_t = type
  con(con ptr)_x = x
  con(con ptr)_y = y
  con ptr = con ptr + 1
  %if con ptr > 200 %start
       printstring("too many contacts")
  %finish
%end
!----------------------------------------------------------------------
%routine box(%integer layer,xl,yb,xr,yt)
  %const %byte %array grid col(poly:implant) = 1,2,4,8
  %integer i,j,ii,jj

  xl = xl + start_x
  xr = xr + start_x

  yb = yb + start_y
  yt = yt + start_y

  ! forget it if totaly of the edge of the screen

  %return %if xr < 0 %or xl > xr lim %or yt < 0 %or yb > yt lim
  xl = -frames %if xl < -frames
  xr = xr lim %if xr > xr lim
  yt = yt lim %if yt > yt lim
  yb = -frames %if yb < -frames
  %if xr > maximum x %then maximum x = xr
  %if yt > maximum y %then maximum y = yt
  %if xl < minimum x %then minimum x = xl
  %if yb < minimum y %then minimum y = yb

  %if xl>=xr %or yb>=yt %then %return  {addition of = nb }
  %for i = xl,1,xr-1 %cycle
    %for j = yb,1,yt-1 %cycle
      grid(i)_y(j) = grid(i)_y(j) ! grid col(layer)
    %repeat
  %repeat
%end
!----------------------------------------------------------------------
%end
%endoffile