! TED for the APM main part

%include "inc:util.imp"
%include "level1:graphinc.imp"
%include "ie:terminal.inc"
%include "frig.inc"

%routine pline (%string(255) p)
   printstring (p);newline
%end

%routine setup
  %integer z=0
  @16_E30000 %short %integer %array colour map(0:511) {ANOTHER FRIG}
  %integer i
  %on 0 %start
    newline
    printstring("Machine is not configured with a Level 1 Graphics system")
    newlines(2)
    %stop
  %finish
  enable(15)   {poke at it to see if graphics there }
!  offset(0,0)
!  colour(white)
!  %for i = 0, 32, 480 %cycle
!    colourmap(1+i) = z
!    colourmap(3+i) = 31
!    colourmap(5+i) = 31 << 5
!    colourmap(7+i) = (31 << 5) + 31
!    colourmap(9+i) = 31 << 10
!    colourmap(11+i) = 31 << 10 + 31
!    colourmap(13+i) = 31 << 10 + 31 << 5 
!    colourmap(15+i) = 31 << 10 + 31 << 5 + 31
!    colourmap(17+i) = 31 << 10 + 31 << 5 + 31
!    colourmap(19+i) = 31 << 10 + 31 << 5
!    colourmap(21+i) = 31 << 10 + 31
!    colourmap(23+i) = 31 << 10
!    colourmap(25+i) = 31 << 5 + 31
!    colourmap(27+i) = 31 << 5
!    colourmap(29+i) = 31
!    colourmap(31+i) = z
!  %repeat
!  font(0)
%end

%begin

!   %routine showstring(%string(255)s,%integer x,y)
!      %integer i
!      textat(x,y)
!      showsymbol(charno(s,i)) %for i=1,1,length(s)
!   %end

  %own %string (63) last in file = ""

  !  Define two dimensional grid for APM
  !
  !  (in the absense of 2-dimensional array name parameters)
  
  %constinteger frames=4    {max line width}
  %constbyteinteger mxlim=18,xrlim=200,ytlim=200
  
  %record %format array fm (%byte %array y (-frames:ytlim+frames) )
  
  ! in the absense of > 5 parameters -
  %record %format point fm (%integer x, y)
  
  ! pointer format
  %record %format con f  (%integer t,x,y)

  ! externals from mouse
  %record %format mouse fm (%integer X, Y, %byte buttons )
  %external %routine %spec wait for  (%byte %integer butt)
  %external %routine %spec set scale(%integer x,y)
  %external %routine %spec coordinates  (%integer X,Y,buttons)
  %external %record (mouse fm)  %map %spec mouse

  ! externals from pan
  %external %routine %spec zoom (%record (array fm) %array %name grid %c
                                         (-frames:xrlim + frames),
                                 %record (con f) %array %name contact(1:200),
                                 %integer cpt)
 
  ! externals from CONTACT
  
  %external %integer %spec scxl,scxr,scyb,scyt,xlat,ybat
  %external %integer %spec overflow          { of the from screen thingies }
  %external %integer %function %spec to x lambda(%integer i)
  %external %integer %function %spec to y lambda(%integer i)
  %external %integer %function %spec to x pixel(%integer i)
  %external %integer %function %spec to y pixel(%integer i)
  %external %integer %function %spec to screen x(%integer i)
  %external %integer %function %spec to screen y(%integer i)
  %external %integer %function %spec from screen x(%integer i)
  %external %integer %function %spec from screen y(%integer i)
  %external %routine %spec draw contact(%integer type,x,j)
  %external %routine %spec flash screen

{@@@} %external %byte %spec error ptr

  ! from REFRESH
  %external %integer %spec maximum x,maximum y,minimum x,minimum y
  %external %routine %spec repaint(%record (array fm) %array %name grid %c
                                         (-frames:xrlim + frames),
                                   %integer xl,yb,xr,yt )
 
  %external %routine %spec refresh(%record (array fm) %array %name grid %c
                                         (-frames:xrlim + frames),
                                   %record (conf) %array %name con(1:200),
                                   %integer con ptr)

  ! from READILAP
  %external %routine  %spec readilap(%string(31) name,
                                     %record (point fm) start,
                                     %record (array fm) %array %name grid %c
                                             (-frames:xrlim + frames),
                                     %record (conf) %array %name con (1:200),
                                     %integer %name con ptr)
 
  ! from EXTRACT
  %external %routine %spec extract(%string(31) name,
                                   %record(conf) confm,
                                   %record(array fm)%array %name grid %c
                                                (-frames:xrlim + frames),
                                        oldgrid (-frames:xrlim + frames),
                                   %record(conf)%arrayname con (1:200))

%routine initialise              
! clears the screen and puts in the menu

  %constant %integer delta = 18
  %integer i,j,k
  %integer sscxr,sscxl,sscyb,sscyt,sxlat,sybat
    
  
  !pline ("in init");
  setup
  sscxl=scxl
  scxl=0
  sscxr=scxr
  scxr=70
  sscyb=scyb
  scyb=0
  sscyt=scyt
  scyt=200
  sxlat=xlat
  xlat=0
  sybat = ybat
  ybat = 0
  colour(black)
  fill(0,0,1023,1023)
  !pline ("print commie box")
  colour(red)
  fill(0,513,688,1023)
  i = to screen x(7)
  j = to screen y(62)
  colour(red)
  line(79,0,79,512)
  fill(i,j,i-32,j-32)
  !pline ("draw contact")
  draw contact(2,5,53)          { PDBnsew  group }
  !pline ("back from contact with martians")
  draw contact(6,5,45)          { PDBns ew group }
  draw contact(0,5,38)          { PM DM          }
  draw contact(8,5,31)          { PDCnsew  group }
  enable  (white)
  colour(white)
  j = toscreeny(25)-4
  k = 24
  textat(20,j)
  showstring("Input")
  j = j - k
  textat(20,j)
  showstring("Output")
  j = j - k
  textat(20,j)
  showstring("Stop")
  j = j - k
  textat(20,j)
  showstring("Clone")
  j = j - k
  textat(20,j)
  showstring("Move")
  j = j - k
  textat(20,j)
  showstring("Wipe")
  j= j - k
  textat(20,j)
  showstring("Clean")
  j = j - k
  textat(20,j)
  showstring("Zoom")
  j = j - k
  textat(20,j)
  showstring("Pan")
  scxl=sscxl
  scxr=sscxr
  scyb=sscyb
  scyt=sscyt
  xlat=sxlat
  ybat=sybat
%end
!-------------------------------------------------------------------------------
%integer gridit = 1  ;! sh don't tell anyone
!-------------------------------------------------------------------------------
%record (mouse fm) %map mouse change(%integer xl,yb,xr,yt)
  %own %record (mouse fm) last = 0
  %record (mouse fm) test
  %own %integer lastx=112,lasty=0

  colour(white)
  %cycle
    test = mouse
    test_x = test_x & \ 7
    test_y = test_y & \ 7
    %if gridit # 0 %start
      fill(lastx,lasty,lastx,lasty)
      lasty=lasty + 16
      fill(lastx,lasty,lastx,lasty)
      lasty=lasty + 16
      fill(lastx,lasty,lastx,lasty)
      lasty=lasty + 16
      fill(lastx,lasty,lastx,lasty)
      lasty=lasty + 16
      %if lasty > 512 %start
        lasty = 0
        lastx = lastx + 16
        lastx = 112 %if lastx > 688
      %finish
    %finish
  %repeat %until test_x # last_x %or test_y # last_y %or test_buttons # last_buttons
  last = test
  %if last_x > xr %then coordinates(xr,last_y,last_buttons) %and last_x=xr
  %if last_x < xl %then coordinates(xl,last_y,last_buttons) %and last_x=xl
  %if last_y > yt %then coordinates(last_x,yt,last_buttons) %and last_y=yt
  %if last_y < yb %then coordinates(last_x,yb,last_buttons) %and last_y=yb
  %result == last
%end
!-------------------------------------------------------------------------------
%routine move cursor (%integer lastx,lasty,newx,newy)
  ! Pixel addres (abs)
  ! at present just an ordinary 2 lamda x 2 lamda box
  %integer xi, yi
  xi = toxpixel(2)-1;   yi=toypixel(2)-1
  enable  (8)
  lastx = lastx & \7; lasty = lasty & \7;newx = newx & \7; newy = newy& \7
  colour(black)
  fill(lastx,lasty,lastx+xi,lasty+yi)  
  colour(8)
  fill(newx,newy,newx+xi,newy+yi)  
  enable  (15)
%end
!-------------------------------------------------------------------------------
%routine box(%integer i,j,k,l)
   ! pixel(abs)
   line(i,j,i,l)
   line(i,l,k,l)
   line(k,l,k,j)
   line(k,j,i,j)
%end    
!-------------------------------------------------------------------------------
%constant %integer poly s = 0,diff s = 1,metal s = 2, implant s = 3,
                   pdbn s = 4,pdbe s = 5,pdbs  s = 6, pdbw    s = 7,
                   pdbnss = 8,pdbews = 9,pm s   = 10, dm     s = 11,
                   pdcn s= 12,pdce s= 13,pdcs s = 14, pdcw   s = 15,
                   bu    = 16,
                   Move s= 21,wipe s= 22,II s  = 17,oo s   = 18,
                   Stop s = 19,Grid s = 23,zoom s = 24,pan s=25,
                   clone s=20,implement end = 25
 
%integer selected = -1
%integer x pix low, y pix low, x pix lim, y pix lim
!-------------------------------------------------------------------------------
%routine draw picture(%integer what)
  %constant %string (22) %array message (poly s:implement end)=
            "layer is poly      ",
            "layer is diffusion ",
            "layer is metal     ",
            "layer is implant   ",
            "contact is PDBN    ",
            "contact is PDBE    ",
            "contact is PDBS    ",
            "contact is PDBW    ",
            "contact is PDBNS   ",
            "contact is PDBEW   ",
            "contact is PM      ",
            "contact is DM      ",
            "contact is PDCN    ",
            "contact is PDCE    ",
            "contact is PDCS    ",
            "contact is PDCW    ",
            "contact is buried  ",
            "function is input  ",
            "function is output ",
            "function is STOP   ",
            "function is clone  ",
            "function is move   ",
            "function is wipe   ",
            "function is Clean  ",
            "function is zoom   ",
            "function is pan    "

  %constant %integer %array yb(poly s:bu) =  %c
     464(4),400(4),336(2),288(2),224(4),288
  %constant %integer %array yt(poly s:bu) = %c
     496(4),448(4),384(2),320(2),272(4),320
  %switch which(poly s:bu)
  %integer sscxl,sscyb,sscyt,sscxr,sxlat,sybat

  %if last in file # "" %start
      cursor (0,6)
      clear line
      print string ("Last file input = """.last in file."""")
  %finish
  cursor(0,7)
  printstring("Current ".message(what))
  %if what>bu %start
      cursor (0,8); clearline
      cursor (0,9); clearline
      cursor (0,10); clearline
      %return
  %finish
  sscxl = scxl
  sscyb = scyb
  sscxr = scxr
  sscyt = scyt
  sxlat = xlat
  sybat = ybat
  !
  xlat=0
  ybat=0
  !
  scyb=0
  scxl=0
  scyt=200
  scxr=70
  !
  colour(black)
  enable  (7)
  fill(16,yb(what),64,yt(what))
  -> which(what)
  which(poly s):
    colour(red)
    fill(24,464,56,496)
    -> endit
  which(diff s):
    colour(green)
    fill(24,464,56,496)
    -> endit
  which(metal s):
    colour(blue)
    fill(24,464,56,496)
    -> endit
  which(implant s):
    colour(yellow)
    box(24,464,56,496)
    -> endit
  which(pdbs s):
  which(pdbe s):
  which(pdbn s):
  which(pdbw s):
    draw contact(2 + what - pdbn s,5,53)
    -> endit
  which(pdbns s):
  which(pdbew s):
    draw contact(6-pdbnss + what,5,45)
    -> endit
  which(pm s):
  which(dm s):
    draw contact(what- pm s,5,38)
    -> endit
  which(bu):
    draw contact(12,5,38)
    -> endit
  which(pdcn s):
  which(pdcs s):
  which(pdce s):
  which(pdcw s):
    draw contact(8 - pdcn s + what,5,31)
    -> endit
  endit:
  xlat=sxlat
  ybat=sybat
  scxl=sscxl
  scyb=sscyb
  scxr=sscxr
  scyt=sscyt
%end
  
%routine %spec draw (%integer what,%record (mouse fm) %name mou)
%routine %spec erase(%integer what,%record (mouse fm) %name mou)
 
%routine pick(%integer position)
  %constant %integer %array xl(poly s:implement end)= %c
    8(*)
  %constant %integer %array xr(poly s:implement end) = %c
    72(*)
  %constant %integer %array yt(poly s:implement end) = %c
    504(4),456(4),392(2),328(2),280(4),0,212,188,164,140,116,92,68,44,20
  %constant %integer %array yb(poly s:implement end) = %c
    456(4),392(4),328(2),280(2),216(4),0,192,168,144,120,96,72,48,24,0
  %own %integer last =poly s
  %switch immediate(stop s:pan s)
  %record(mouse fm) dummy
  
  %if position >=456 %then selected = poly s %else %c
  %if position >=392 %then selected = pdbn s %else %c
  %if position >=328 %then selected = pdbnss %else %c
  %if position >=280 %then selected = pm s   %else %c
  %if position >=216 %then selected = pdcn s %else %c
  %if position >=192 %then selected = ii s   %else %c
  %if position >=168 %then selected = oo s   %else %c
  %if position >=144 %then selected = stop s %else %c
  %if position >=120 %then selected = clones %else %c
  %if position >= 96 %then selected = move s %else %c
  %if position >= 72 %then selected = wipe s %else %c
  %if position >= 48 %then selected = grid s %else %c
  %if position >= 24 %then selected = zoom s %else selected = pan s
  enable  (7)
  colour(0)
  box(xl(last),yb(last),xr(last),yt(last))
  colour(white)
  box(xl(selected),yb(selected),xr(selected),yt(selected))
  last =selected
  draw picture(selected)
  %return %if selected < stop s 
  -> immediate(selected)
  immediate(stop s):
  immediate(zoom s):
  immediate(wipe s):
    draw(selected,dummy)
  immediate(*):
    %return
%end
!-----------------------------------------------------------------------------
%routine next(%integer what)
  %if what = implant s %then selected = poly s %else %c
  %if what = pdbw s    %then selected = pdbns  %else %c
  %if what = pdbew s   %then selected = pdbnss %else %c
  %if what = pdcw s    %then selected = pdcn s %else %c
  %if what = dm s      %then selected = bu     %else %c
  %if what = bu        %then selected = pm s   %else %c
  %if what < bu %then selected = selected + 1
  draw picture(selected)
%end
!------------------------------------------------------------------   
%routine readstring(%string(31) prompt string,%string(31) %name what)
  %integer i
  
  select input(0)
  prompt(promptstring)
  what = ""
  i = testsymbol %until i<0
  %cycle
    readsymbol(i)
    %return %if i = nl
    what = what.tostring(i)
  %repeat
%end
!-------------------------------------------------------------------------------
%record (array fm) %array grid(-frames:xrlim + frames)
%record (con f) %array contacts(1:200)
%integer con ptr = 1
%record (mouse fm)mou
%integer xcoor= 0,ycoor = 0
%integer i,j
%switch but(0:Mouse left!Mouse middle!Mouse right)
 
! constants for drawing/erasing contacts
!                                      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 con  xl(0:12) = 2,2,2, 2, 2, 3, 2,  3,  2, 2, 2, 3, 2
%constant %byte %array con  xr(0:12) = 1,1,1, 2, 1, 1, 1,  2,  1, 2, 1, 1, 1
%constant %byte %array con  yb(0:12) = 2,2,2, 2, 3, 2, 3,  2,  2, 2, 3, 2, 2
%constant %byte %array con  yt(0:12) = 1,1,2, 1, 1, 1, 2,  1,  2, 1, 1, 1, 1
 
 
%constant %integer %array lookup(pdbns:bu) =  2,3,4,5,6,7,0,1,8,9,10,11,12
%constant %integer %array layer col(poly s:implant s) = red,green,blue,yellow
%constant %integer %array layer m(poly s:implant s) = 1,2,4,8
!-------------------------------------------------------------------------------
%routine add con marker(%record (con f) con)
  %integer i,j,k
  
  k = con_t
  %for i = con_x - con xl(k),1,con_x+con xr(k) %cycle
    %for j = con_y - con yb(k),1,con_y+con yt(k) %cycle
      grid(i)_y(j) = grid(i)_y(j) ! 32
    %repeat
  %repeat
%end
!-------------------------------------------------------------------------------
%routine remove con marker(%record (con f) con)
  %integer i,j,k
  
  k = con_t
  %for i = con_x - con xl(k),1,con_x+con xr(k) %cycle
    %for j = con_y - con yb(k),1,con_y+con yt(k) %cycle
      grid(i)_y(j) = grid(i)_y(j) & \ 32
    %repeat
  %repeat
%end
!-------------------------------------------------------------------------------
%routine draw(%integer what,%record(mouse fm) %name mou)
  %integer maxx,maxy,minx,miny
  %integer notex,notey,cx,cy,lcx,lcy 
  %integer firstx,firsty,lastx,lasty
  %integer i,j,ii,jj,t,ox,oy
  %switch sel(poly s:implement end)
  %record (con f) con
  %record (point fm) point
  %string(31) filename
  %record (array fm) %array copy(-frames:xrlim+frames)
  !-------------------------------------------------
  %routine top and tail(%integer %name xl,yb,xr,yt)
    ! of picture in window
    %integer i
    
    xl = minimum x
    yb = minimum y
    ! first find the lower coord (xl)
    %while grid(xl)_y(yb) = 0 %cycle
      xl = xl + 1
      %if xl > maximum x %start
        yb = yb + 1
        xl = minimum x
        %if yb > maximum y %start
          xl = scxl;yb = scyb;xr = scxr;yt = scyt
          %return
        %finish
      %finish
    %repeat
    ! yb is found now xl , by a similar route
    i = minimum y
    xl = minimum x
    %while grid(xl)_y(i) = 0 %cycle
      i = i + 1
      %if i > maximum y %then i = minimum y %and xl = xl + 1
    %repeat
    ! xl,yb lower coords
    ! now the uppers
    xr = maximum x
    yt = maximum y
    %while grid(xr)_y(yt) = 0 %cycle
       xr = xr - 1
       %if xr < minimum x %then xr = maximum x %and yt = yt - 1
    %repeat
    i = maximum y
    xr  = maximum x
    %while grid(xr)_y(i) = 0 %cycle
       i = i -1
       %if i < minimum y %then i = maximum y %and xr = xr - 1
    %repeat
  %end
  !-------------------------------------------------------  
  %integer %function sign(%integer i)
    %result = -1 %if i < 0
    %result = 1
  %end
  !-------------------------------------------------------  
  %routine rubout(%record(mouse fm) to,%integer centrex,centrey,oldx,oldy)
    ! all in pixels (abs)
    %integer i,j
      
    i = centrex + toxpixel(2) -1
    j = centrey + toypixel(2) -1
    ! rubout old one in 3 mouthfulls
    colour(0)
    fill(centrex,centrey,oldx,oldy)
    fill(i,centrey,centrex,oldy)
    fill(centrex,centrey,oldx,j)
    ! and fill in the new one 
    colour(layer col(what))
    fill(centrex,centrey,to_x,to_y)
    to_x = to_x-1 %if to_x > i
    to_y = to_y-1 %if to_y > j
    fill(i,centrey,centrex,to_y)
    fill(centrex,centrey,to_x,j)
    fill(centrex,centrey,i,j)
  %end
  !---------------------------------------------------------  
  %predicate contact there (%integer x,y,type)
    %integer i,j
 
    %for i = x - con xl(type),1,x+con xr(type) %cycle
      %for j = y - con yb(type),1,y+con yt(type) %cycle
        flash screen %and %true %if grid(i)_y(j) & 32 # 0
      %repeat
    %repeat
    %false
  %end
  !-----------------------------------------------------------------------------
  %routine define box(%integer %name lox,loy,hix,hiy)
    ! The user defines  two corners, This routine takes these
    ! puts a box around them . The coordinates are the  pixel
    ! measurements in such a form that the to screen of them
    ! will give the lambda range of the box
    %integer i,j,k,l
    %integer fx,fy
    
    enable  (8)
    lox = mou_x;loy=mou_y
    fx = lox;fy=loy
    hix = lox + 16
    hiy = loy + 16
    colour(0)
    fill(lox,loy,lox+24,loy+24)
    colour(8)
    i = lox;j=loy;k=hix;l=hiy
    box(lox,loy,hix,hiy)
    %cycle
      mou = mouse change(xpixlow,ypixlow,xpixlim,ypixlim)    
      colour(0)
      box(i,j,k,l)
      %if mou_x > fx %start
        lox = fx;hix = mou_x + 16
      %else %if mou_x = fx 
        lox = fx;hix=fx + 16
      %else
        lox = mou_x;hix = fx + 16
      %finish
       %if mou_y > fy %start
        loy = fy;hiy = mou_y + 16
      %else %if mou_y = fy 
        loy = fy;hiy=fy + 16
      %else
        loy = mou_y;hiy = fy + 16
      %finish
     colour(8)
      i = lox;j=loy;k=hix;l=hiy
      box(i,j,k,l)
    %repeat %until mou_buttons = 0
    hix = hix - 8;hiy=hiy-8
    coordinates(lox,loy,mou_buttons)
  %end
  !----------------------------------------------------------------------------------
  %predicate contact within(%record (con f) contact,%integer xl,yb,xr,yt)
    %integer i, x, y

    i = contact_t;   x=contact_x;   y=contact_y
    xr = xr + 1
    yt = yt + 1
    %true %if xl <= x <= xr %and yb <= y <= yt 
    %false
  %end
  !-----------------------------------------------------------------------------
  %integer rotations, parity { rot is in 90 deg clockwise }
  !
  %record (point fm) centre,offset,which
  !
  %integer %function type
    %result = ((parity & 1) << 2) ! ( rotations & 3 )
  %end
  !
  %routine transform (%integer type,%record(point fm) %name what)
    ! There are only 8 possible transformation, 4 rotatations of 2 parities
    !
    !  A B  |  D A |  C D  |  B C  |  D C  |  C B  |  B A  |  A D  ||
    !  D C  |  C B |  B A  |  A D  |  A B  |  D A  |  C D  |  B C  ||
    ! r0,p0 | r1,p0| r2,p0 | r3,p0 | r0,p1 | r1,p1 | r2,p1 | r3,p1 ||
    !   0   |   1  |   2   |   3   |   4   |   5   |   6   |   7   ||
    %integer i,j
    %switch rtype(0:7)
 
    i = what_x - centre_x
    j = what_y - centre_y
    ! coordinates i,j are wrt centre
    -> rtype(type)
    rtype(1):
      ! one clockwise rotation
      what_x = centre_x + j
      what_y = centre_y - i
      -> rtype(0)
    rtype(2):
      ! 2 clock rot
      what_x = centre_x - i
      what_y = centre_y - j
      -> rtype(0)
    rtype(3):
      ! 3 clock rot
      what_x = centre_x - j
      what_y = centre_y + i
      -> rtype(0)
    rtype(5):
      ! one clockwise rotation
      what_x = centre_x + j
      what_y = centre_y + i
      -> rtype(0)
    rtype(6):
      ! 2 clock rot
      what_x = centre_x - i
      what_y = centre_y + j
      -> rtype(0)
    rtype(7):
      ! 3 clock rot
      what_x = centre_x - j
      what_y = centre_y - i
      -> rtype(0)
    rtype(4):
      what_y = centre_y - j
    rtype(0):
      ! add offset and return
      what_x = what_x + offset_x
      what_y = what_y + offset_y
  %end
  !-----------------------------------------------------------------------------
  %routine print message
    %constant %string(4) %array upper(0:7) = %C
        "A  B","D  A","C  D","B  C","D  C","C  B","B  A","A  D"
    %constant %string(4) %array lower(0:7) = %C
        "D  C","C  B","B  A","A  D","A  B","D  A","C  D","B  C"
    %integer r type
    
    rtype = type
    cursor(0,20);clearline
    cursor(0,21);clearline
    cursor(0,22);clearline
    cursor(5,20);printstring(upper(0));spaces(5);printstring(upper(r type))
    cursor(11,21);printstring("->")
    cursor(5,22);printstring(lower(0));spaces(5);printstring(lower(r type))
  %end
  !-----------------------------------------------------------------------------
  %routine transform contact(%record (conf) %name what,%integer type)
    %switch adj(0:7)  { this is because rotating contacts is HARD }
    %record (point fm) which
 
    %integer %function next cont(%integer type,amt)
      %result = type %if type <=1 %or type = 12 %or amt = 0
      %if amt < 4 %start
        %if type < 6 %then %result = ((type - 2 + amt) & 3) + 2
        %if type < 8 %then %result = ((type - 6 + amt) & 1) + 6
        %result = ((type-8+amt) & 3) + 8
      %else
        %if type & 1 = 1 %start { even as for rot - 4 }
          %result = next cont(type,amt-4)
        %else
          %result = next cont(type,(amt-2)&3) 
        %finish
      %finish
    %end
 
    which_x = what_x
    which_y = what_y
    transform(type,which)
    what_t = next cont(what_t,type)
    -> adj(type)
    adj(0):
      what_y = which_y
      what_x = which_x
      %return
    adj(1):
      what_y = which_y + 1
      what_x = which_x
      %return
    adj(2):
      what_y = which_y + 1
      what_x = which_x + 1
      %return
    adj(3):
      what_y = which_y
      what_x = which_x + 1
      %return
    adj(6):
      what_y = which_y
      what_x = which_x + 1
      %return
    adj(5):
      what_x = which_x
      what_y = which_y
      %return
    adj(4):
      what_y = which_y + 1
      what_x = which_x
      %return
    adj(7):
      what_y = which_y + 1
      what_x = which_x + 1
      %return
  %end
    
  %on 3,9 %start
    select output(0)
    clear line
    printstring(event_message);newline
    flash screen
    %return
  %finish

  ! Body of draw ---------------------

  -> sel(what)
  !--------------------------------------------------------------------------
  sel(clone s):
    ! vey similar to move, the differences are trivial but too much t
    ! parameterise
    cursor(0,3)
    printstring("| ROTATE |    DRAW   | REFLECT |")
    define box(firstx,firsty,notex,notey)
    mou_x = (firstx + 8 + notex)//2
    mou_y = (firsty + 8 + notey)//2
    mou_x = ((mou_x + 4) & \7)-4;mou_y = ((mou_y+4)&\7)-4
    ox = mou_x - firstx
    oy = mou_y - firsty
    lastx = notex + 8 - mou_x
    lasty = notey + 8 - mou_y
    ii = ox
    jj = oy
    coordinates(mou_x,mou_y,0)
    parity = 0
    rotations = 0
    print message
    enable  (8)
    lcx = firstx;lcy=firsty;cx=notex+8;cy=notey+8
    %cycle
      mou = mouse change(xpixlow-mou_x,ypixlow-mou_y,xpixlim+mou_y,ypixlim+mou_y)
      mou_x = mou_x + 4
      mou_y = mou_y + 4
      %if mou_buttons & Mouse left # 0 %start
         rotations = rotations + 1
         print message
         i=ox;ox=oy;oy=lastx;lastx=lasty;lasty=i
         wait for(0)
      %finish
      %if mou_buttons & Mouse right # 0 %start
        parity = parity + 1        
        print message
        i = oy;oy=lasty;lasty= i
        wait for(0)
      %finish
      colour(0)
      box(lcx,lcy,cx,cy)
      colour(8)
      lcx = mou_x - ox
      lcy = mou_y - oy
      cx = mou_x + lastx
      cy = mou_y + lasty
      %if lcx < 0   %then lcx= 0
      %if lcy < 0   %then lcy= 0
      %if cx > 1023 %then cx = 1023
      %if cy > 1023 %then cy = 1023
      box(lcx,lcy,cx,cy)
    %repeat %until mou_buttons & Mouse middle # 0
    ! but first of all convert into lambda (key into grid)
    ! this next bit is a cheat to reset the coordinates to the bl corner
    ! (we were in the centre)
    coordinates(mou_x,mou_y,0)                           { reset coords }
    mou_x = mou_x - ii
    mou_y = mou_y - jj
    firstx = from screen x(firstx)
    notex =  from screen x(notex)
    mou_x =  from screen x(mou_x)
    firsty = from screen y(firsty)
    notey =  from screen y(notey)
    mou_y =  from screen y(mou_y)
    centre_x = (notex + firstx)//2
    centre_y = (notey + firsty)//2
    ii = type
    %if overflow = 1 %then flash screen
    ! firstx <= notex ,firsty <= notey
    ! if the to < first then run from first -> note 
    ! else from note -> from
    ox = mou_x - firstx     { unaffected by direction therefore calculated 
    oy = mou_y - firsty     { previous to working out lower and upper bounds
    offset_x = ox
    offset_y = oy
    i = 1
    j = con ptr - 1
    %while I <= j %cycle
      %if contact within(contacts(i),firstx,firsty,notex,notey) %start 
        contacts(conptr) = contacts(i)
        transform contact(contacts(con ptr),ii)
        %unless contacts(conptr)_x < 0 %or contacts(conptr)_x > xrlim %or %c
                contacts(conptr)_y < 0 %or contacts(conptr)_y > ytlim %or %c
                contact there(contacts(con ptr)_x,contacts(con ptr)_y,
                 contacts(con ptr)_t) %then %c
          con ptr = con ptr + 1
      %finish
      i = i + 1
    %repeat
    !
    copy(i) = 0 %for i = -frames,1,xrlim+frames
    %for i = firstx,1,notex %cycle
      %for j = firsty,1,notey %cycle
        which_x = i
        which_y = j
        transform(ii,which)
        %if 0 <= which_x <= xrlim %and 0 <= which_y <=ytlim %then %c
                copy(which_x)_y(which_y) = grid(i)_y(j) & \32
      %repeat
    %repeat
    ii = notex - firstx
    jj = notey - firsty
    %if ii < jj %then ii = jj//2 %else ii = ii//2
    jj = centre_x + offset_x
    %if firstx > jj - ii %then firstx = jj - ii
    %if notex  < jj + ii %then notex  = jj + ii
    jj = centre_y + offset_y
    %if firsty > jj - ii %then firsty = jj - ii
    %if notey  < jj + ii %then notey  = jj + ii
    %if notex > xr lim %then notex = xr lim
    %if firstx < 0 %then firstx = 0
    %if notey > yt lim %then notey = yt lim
    %if firsty < 0 %then firsty = 0
    %if firstx < minimum x %then minimum x = firstx
    %if notex  > maximum x %then maximum x = notex 
    %if firsty < minimum y %then minimum y = firsty
    %if notey  > maximum y %then maximum y = notey 
    %for i = firstx-2,1,notex+2 %cycle
      %for j = firsty-2,1,notey+2 %cycle
        grid(i)_y(j) = grid(i)_y(j) ! copy(i)_y(j)
      %repeat
    %repeat
    refresh(grid,contacts,con ptr)
    add con marker(contacts(i)) %for i = 1,1,con ptr -1
    enable  (8)
    colour(0)
    fill(0,0,100,512)
    cursor(0,3)
    printstring("| ERASE  |    DRAW   | TOGGLE  |")
    %return
  !----------------------------------------------------------------------------
  sel(move s):
    ! WE first note the position (leave the cursor)
    ! move until button released
    ! when released draw a bounding box
    ! move until next button
    ! if it's middle move and repaint
    ! If not just repaint
    define box(firstx,firsty,notex,notey)
    ox = notex - firstx + 8
    oy = notey - firsty + 8
    lastx = firstx
    lasty = firsty
    i = lastx + ox
    j = lasty + oy
    %cycle
      mou = mouse change(xpixlow,ypixlow,xpixlim,ypixlim)
      colour(0)
      box(lastx,lasty,i,j)
      colour(8)
      lastx = mou_x
      lasty = mou_y
      i = lastx + ox
      j = lasty + oy
      %if i > 1023 %then i = 1023
      %if j > 1023 %then j = 1023
      box(lastx,lasty,i,j)
    %repeat %until mou_buttons # 0
    %if mou_buttons & Mouse middle # 0 %and %c
      ( mou_x # firstx %or mou_y # firsty ) %start  ;! move the screen
      ! but first of all convert into lambda (key into grid)
      firstx = from screen x(firstx)
      notex =  from screen x(notex)
      mou_x =  from screen x(mou_x)
      firsty = from screen y(firsty)
      notey =  from screen y(notey)
      mou_y =  from screen y(mou_y)
      %if overflow = 1 %then flash screen
      ! firstx <= notex ,firsty <= notey
      ! if the to < first then run from first -> note 
      ! else from note -> from
      ox = mou_x - firstx     { unaffected by direction therefore calculated 
      oy = mou_y - firsty     { previous to working out lower and upper bounds
      i = 1
      %while I <= con ptr -1 %cycle
        j = contacts(i)_t     { MUST be quicker and is certainly easier }
        %if contact within(contacts(i),firstx,firsty,notex,notey) %start 
          remove con marker(contacts(i))
          contacts(i)_x = contacts(i)_x + ox
          contacts(i)_y = contacts(i)_y + oy
          %if contacts(i)_x < 0 %or contacts(i)_x > xrlim %or %c
              contacts(i)_y < 0 %or contacts(i)_y > ytlim %or %c
              contact there(contacts(i)_x,contacts(i)_y,contacts(i)_t) %start
            contacts(i) = contacts(con ptr- 1)
            con ptr = con ptr - 1
          %else
            i = i + 1
          %finish
        %else
          i = i + 1
        %finish
      %repeat
      !
      %if mou_x < firstx %start
        %if minimum x > firstx + ox %start
          minimum x = firstx + ox
          minimum x = 0 %if minimum x < 0
        %finish
        ii = 1
      %else
        %if maximum x < notex + ox %start
          maximum x = notex + ox
          maximum x = xrlim %if maximum x > xrlim
        %finish
        i = notex              { Swap back (!)
        notex = firstx
        firstx = i
        ii = -1
      %finish
      %if mou_y < firsty %start
        %if minimum y > firsty + oy %start
          minimum y = firsty + oy
          minimum y = 0 %if minimum y < 0
        %finish
        jj = 1
     %else
        %if maximum y < notey + oy %start
          maximum y = notey + oy
          maximum y = ytlim %if maximum y > ytlim
        %finish
        i = notey              { Swap back (!)
        notey = firsty
        firsty = i
        jj = -1
      %finish
      %for i = firstx,ii,notex %cycle
        %for j = firsty,jj,notey %cycle
          %if 0 <= (i+ox) < xrlim %and 0 <= (j+oy) < ytlim %then %c
                  grid(i+ox)_y(j+oy) = grid(i)_y(j)
          grid(i)_y(j) = 0
        %repeat
      %repeat
    %finish
    refresh(grid,contacts,con ptr)
    add con marker(contacts(i)) %for i = 1,1,con ptr -1
    %return
    !---------------------------------------------------------------------------
  sel(wipe s):
{@@@} error ptr = 0
    cursor (0,8);clearline
    select input(0)
    prompt("Do you want to wipe all?")
    readsymbol(i) %until i # nl %and i # ' '
    %if i = 'Y' %or i = 'y' %start
      con  ptr = 1
      %for i = -frames,1,xrlim+frames %cycle
        grid(i) = 0 
      %repeat
      maximum x = sc xr
      maximum y = sc yb
      minimum x = sc xl
      minimum y = sc yb
      %if maximum x > 200 %start
        maximum x = 200
      %finish
      maximum y = 200 %if maximum y > 200
      refresh(grid,contacts,con ptr)
    %finish
    %return
    !---------------------------------------------------------------------------
  sel(ii s):
    cursor (0,8);clearline
    readstring("Input file:",filename)
    %if filename = "$" %start
      newline
      printstring("Terminating TED")
      newlines(2)
      colour(0)
      enable  (8)
      fill(0,0,1023,1023)
      %stop
    %finish
    %if filename = "^^" %start
       %if gridit = 0 %then gridit = 1 %else gridit = 0
       refresh(grid,contacts,con ptr)
       %return
    %finish
    %return %if filename = ""
    point_x = from screen x(mou_x)
    point_y = from screen y(mou_y) 
    %if overflow = 1 %then flash screen
    readilap(filename,point,grid,contacts,con ptr)
    refresh(grid,contacts,con ptr)
    coordinates(mou_x,mou_y,0)
    last in file = filename
    cursor (0,6)
    clear line
    print string ("Last file input = """.last in file."""")
    %return
    !---------------------------------------------------------------------------
  sel(oo s):
    cursor (0,8);clearline
    readstring("Output file:",filename)
    %if filename = "$" %start
      newline
      printstring("Terminating TED")
      newlines(2)
      colour(0)
      enable  (8)
      fill(0,0,1023,1023)
      %stop
    %else %if filename="*"
      filename = last in file
    %finish
    %return %if filename = ""
    con_t = con ptr - 1
    minimum x = minimum x - 1
    minimum y = minimum y - 1
    maximum x = maximum x + 1
    maximum y = maximum y + 1
    maximum x = xr lim %if maximum x >= xrlim
    maximum y = yt lim %if maximum y >= ytlim
    minimum x = 0 %if minimum x <= 0
    minimum y = 0 %if minimum y <= 0
    top and tail(con_x,con_y,point_x,point_y)
    maximum x = point_x;maximum y = point_y
    minimum x = con_x;minimum y=con_y
    con_x = from screen x(mou_x)
    con_y = from screen y(mou_y)
    %for i = -frames,1,xrlim+frames %cycle
      copy(i) = 0 
    %repeat
    %for i = 0,1,maximum  x + 1 %cycle
      copy(i)  = grid(i)
    %repeat
    extract(filename,con,copy,grid,contacts)
    coordinates(mou_x,mou_y,0)
    %return
    !---------------------------------------------------------------------------
  sel(poly s):
  sel(diff s):
  sel(metals):
    ! this bit is the fun part which is why I have left it 'till late
    ! first of all we delete the cursor, and put in a lamda square of
    ! the appropriate colour, Then according to the movement of the mouse
    ! paint in. 
    lcx = mou_x
    lcy = mou_y
    first x = mou_x
    first y = mou_y
    ox = first x + to x pixel (2)-1   ;! thus (firstx,firsty,ox,oy)
    oy = firsty  + to y pixel (2)-1   ;! is the basic box
    enable   (layer col(what))
    colour(layer col(what))
    fill(firstx,firsty,ox,oy)
    maxx= ox;minx=firstx
    maxy= oy;miny=firsty
    %cycle
      %if mou_x > maxx %then maxx = mou_x
      %if mou_y > maxy %then maxy = mou_y
      %if mou_x < minx %then minx = mou_x
      %if mou_y < miny %then miny = mou_y
      last x = mou_x
      last y = mou_y
      mou  = mouse change(xpixlow,ypixlow,xpixlim,ypixlim)
      cx = mou_x;cy=mou_y
      move cursor(lcx,lcy,cx,cy)
      lcx=cx;lcy =cy
      enable   (layer col(what))
      colour(layer col(what))
      %exit %if mou_buttons & Mouse middle = 0
      ! The update of a box has cause me more problem than anything
      ! else to date. This version will try to run simply but if it
      ! cannot will rub out the whole lot and redraw
      !
      mou_x = mou_x - 1 + toxpixel(2) %if mou_x > first x
      mou_y = mou_y - 1 + toypixel(2) %if mou_y > first y
      %if mou_x >= first x <= last x %start    { F M/L
        mou_x = ox %if mou_x < ox
        %if mou_x > last x %start { expand the box in the X dimension }
          fill(lastx,firsty,mou_x,mou_y)       { F L M
          fill(lastx,firsty,mou_x,oy)
        %finish
        %if mou_x < last x %start { shrink the box   F M L
          mou_x = mou_x + 1
          colour(0)
          fill(mou_x,firsty,lastx,lasty)
          fill(mou_x,firsty,lastx,oy)
          colour(layer col(what))
        %finish
      %else %if mou_x <= first x >= last x          { M/L  F
        mou_x = first x %if mou_x > first x
        %if mou_x < last x %start { expand box in negative X }
          fill(lastx,firsty,mou_x,mou_y)            { M L F
          fill(lastx,firsty,mou_x,oy)
        %finish
        %if mou_x > last x %start { shrink box negative X }
          colour(0)
          fill(mou_x-1,firsty,lastx,lasty)
          fill(mou_x-1,firsty,lastx,oy)
          colour(layer col(what))
        %finish
      %else
        rubout(mou,firstx,firsty,lastx,lasty)
        %continue
      %finish
      %if mou_y >= firsty <= last y %start   { positive Y }
        mou_y = oy %if mou_y < oy
        %if mou_y > last y %start            { increase box }
          fill(firstx,lasty,mou_x,mou_y)
          fill(ox,last y,firstx,mou_y)
        %finish
        %if mou_y < last y %start            { shrink box ]
          mou_y = mou_y + 1
          colour(0)
          fill(firstx,mou_y,lastx,lasty)
          fill(ox,mou_y,firstx,lasty)
          colour(layer col(what))
       %finish
       %else %if mou_y <= oy >= last y       { negative y }
         mou_y = first y %if mou_y > first y
         %if mou_y < last y %start            { increase box }
           fill(firstx,lasty,mou_x,mou_y)
           fill(ox,last y,firstx,mou_y)
         %finish
         %if mou_y > last y %start            { shrink box ]
           colour(0)
           fill(firstx,mou_y-1,lastx,lasty)
           fill(ox,mou_y-1,firstx,lasty)
           colour(layer col(what))
         %finish
       %else
         rubout(mou,firstx,firsty,lastx,lasty)
         %continue
       %finish
    %repeat
  EXTRACT:
    ! We now have to update the lambda array and also the contacts, which have
    ! become corrupted (maybe)
    ! first the array
    ii = from screen x( first x)
    jj = from screen y( first y)
    i = from screen x(last x+1)         {just in case}
    j = from screen y(last y+1)         { just in case}
    %if first x = last x %and first y = last y %start
      i = ii + 1
      j = jj + 1
    %else
      %if ii >= i %then ii = ii + 1  %else i = i - 1
      %if jj >= j %then jj = jj + 1  %else j = j - 1
    %finish
    %for i = ii,sign(i-ii),i %cycle
      %for j = jj,sign(j-jj),j %cycle 
        grid(i)_y(j) = grid(i)_y(j) ! layer m(what)
      %repeat
    %repeat
    %if overflow = 0 %start
       repaint(grid,fromscreenx(minx+1),from screeny(miny+1),fromscreenx(maxx+1),fromscreeny(maxy+1))
       draw contact(contacts(i)_t,contacts(i)_x,contacts(i)_y) %for i = 1,1,con ptr -1
    %else
       refresh(grid,contacts,con ptr)
    %finish
    coordinates(cx,cy,0)
    mou_x = cx;mou_y = cy   { fix next cursor position }
    %return
    !---------------------------------------------------------------------------
  sel(implant s):
    enable  (yellow)
    colour(yellow)
    first x = mou_x
    first y = mou_y
    ox = first x + to x pixel(2)
    oy = first y + to y pixel(2)
    box(first x,firsty,ox,oy)
    i = ox
    j = oy
    cx = mou_x
    cy = mou_y
    maxx= ox;minx=firstx
    maxy= oy;miny=firsty
    %cycle
      %if mou_x > maxx %then maxx = mou_x
      %if mou_y > maxy %then maxy = mou_y
      %if mou_x < minx %then minx = mou_x
      %if mou_y < miny %then miny = mou_y
      ii = i
      jj = j
      last x = mou_x
      last y = mou_y
      lcx=cx;lcy =cy
      mou  = mouse change(xpixlow,ypixlow,xpixlim,ypixlim)
      cx = mou_x;cy=mou_y
      move cursor(lcx,lcy,cx,cy)
      %if mou_x > firstx %then mou_x = mou_x + toxpixel(2)
      %if mou_y > firsty %then mou_y = mou_y + toypixel(2)
      %exit %if mou_buttons & Mouse middle = 0
      %if firstx < mou_x < ox %then mou_x = ox 
      %if firsty < mou_y < oy %then mou_y = oy
      %if mou_x < ox %then i = ox %else i = firstx
      %if mou_y < oy %then j = oy %else j = firsty
      enable  (yellow)
      colour(0)
      box(ii,jj,lastx,lasty)
      colour(yellow)
      box(i,j,mou_x,mou_y)
    %repeat
      enable  (15)
    -> extract
    !---------------------------------------------------------------------------
  sel(stop s):
    cursor (0,8);clearline
    select input(0)
    prompt("Do you really want to stop?")
    readsymbol(i) %until i # nl %and i # ' '
    %if i = 'Y' %or i = 'y' %start
      colour(0)
      enable  (8)
      fill(0,0,1023,1023)
      %stop
    %finish
    %return
    !---------------------------------------------------------------------------
  sel(grid s):
    define box(firstx,firsty,notex,notey)
    firstx = fromscreenx(firstx)
    notex = fromscreenx(notex)
    firsty = fromscreeny(firsty)
    notey = fromscreeny(notey)
    %for i = firstx,1,notex %cycle
      %for j = firsty,1,notey %cycle
        grid(i)_y(j) = 0
      %repeat
    %repeat
    %if con ptr # 1 %start
      i = 1
      %while i <= con ptr - 1 %cycle
        %if contact within(contacts(i),firstx,firsty,notex,notey) %start
          remove con marker(contacts(i))
          con ptr = con ptr - 1
          contacts(i) = contacts(con ptr)
        %else 
          i = i + 1
        %finish
      %repeat
    %finish
    minimum x = minimum x - 1
    minimum y = minimum y - 1
    maximum x = maximum x + 1
    maximum y = maximum y + 1
    maximum x = xr lim %if maximum x >= xrlim
    maximum y = yt lim %if maximum y >= ytlim
    minimum x = 0 %if minimum x <= 0
    minimum y = 0 %if minimum y <= 0
    top and tail(con_x,con_y,point_x,point_y)
    refresh(grid,contacts,conptr)
    %return
    !---------------------------------------------------------------------------
  sel(zoom s):
!    enable  (15)
!    colour(white)
!    fill(mou_x,mou_y,mou_x+toxpixel(2),mou_y+toypixel(2))
!    firstx= mou_x
!    firsty = mou_y
!    %cycle
!      lastx=mou_x;lasty=mou_y
!      mou= mouse change(xpixlow,ypixlow,xpixlim,ypixlim)
!      move cursor(lastx,lasty,mou_x,mou_y)
!    %repeat %until mou_buttons & middle = 0
    zoom(grid,contacts,con ptr)
    refresh(grid,contacts,con ptr)
    coordinates(mou_x,mou_y,0)
    %return
    !---------------------------------------------------------------------------
  sel(pan s):
    enable  (15)
    colour(white)
    fill(mou_x,mou_y,mou_x+toxpixel(2),mou_y+toypixel(2))
    firstx= mou_x
    firsty = mou_y
    %cycle
      lastx=mou_x;lasty=mou_y
      mou= mouse change(xpixlow,ypixlow,xpixlim,ypixlim)
      move cursor(lastx,lasty,mou_x,mou_y)
    %repeat %until mou_buttons = 0
    I = toxlambda(mou_x-firstx)
    j=  toylambda(mou_y-firsty)
    scxl=scxl-i
    scxr=scxr-i
    scyb=scyb-j
    scyt=scyt-j
    %if scxl < -70 %then scxl =-70 %and scxr =0
    %if scxr > xrlim+76 %then scxr=xrlim+76 %and scxl=xrlim
    %if scyb < -60 %then scyb =-60 %and scyt=0
    %if scyt > ytlim+67 %then scyt=ytlim+67 %and scyb=ytlim
    refresh(grid,contacts,conptr)
    move cursor(mou_x,mou_y,mou_x,mou_y)
    %return
    !---------------------------------------------------------------------------
  sel(*):              { contact . 4 stages, first check that it may be placed }
                       { then place in lamda array, put into contact list and  }
                       { finally draw on the screen }
    t = lookup(what)
    ii = from screen x(mou_x) + con xl(t)
    jj = from screen y(mou_y) + con yb(t)
    %if overflow = 1 %or ii >= xrlim-1 %or jj >= ytlim-1  %start
      flash screen
      %return
    %finish
    %return %if contact there(ii,jj,t)
    contacts(con ptr)_t = t
    contacts(con ptr)_x = ii
    contacts(con ptr)_y = jj
    add con marker(contacts(con ptr))
    con ptr = con ptr + 1
    draw contact(t,ii,jj)
    coordinates(mou_x,mou_y,0)
%end    { OF DRAW }
!-------------------------------------------------------------------------------
%routine erase(%integer what,%record (mouse fm) %name mou)
  
  %integer %function locate contact(%integer type,x,y)
    %integer i,j,k
  
    i = 0
    %cycle
      i = i + 1
      %result = -1 %if i = con ptr
      %result = i %if contacts(i)_t = type                         %and %c
           - con xl(type) <= ( x - contacts(i)_x ) <= con xr(type) %and %c
           - con yb(type) <= ( y - contacts(i)_y ) <= con yt(type)
    %repeat
  %end
  !-----------------------------------------------------------------------------
  %integer first x,first y,last x,lasty,reg
  %integer i,j,x,y,l,ii,jj,m
  %byte k
  %switch del(0:implement end)
  
  -> del(what)
  !--------------------
  del(poly s):
  del(diff s):
  del(metals):
  del(implant s):
    reg = layer col(what)
    first x = mou_x
    first y = mou_y
    x = firstx
    y = firsty
    l = firstx + 15
    m = firsty + 15
    %cycle
      last x = mou_x
      last y = mou_y
      enable  (reg)
      colour(0)
      ii = firstx
      jj = firsty
      i = mou_x
      j = mou_y
      %if i >= first x %then i = i + 15 %else ii = ii + 15
      %if j >= first y %then j = j + 15 %else jj = jj + 15
      fill(ii,jj,i,j)
      %if mou_x < x %then x = mou_x
      %if mou_y < y %then y = mou_y
      %if mou_x > l %then l = mou_x
      %if mou_y > m %then m = mou_y
      mou = mouse change(xpixlow,ypixlow,xpixlim,ypixlim)
      move cursor(last x,lasty,mou_x,mou_y)
    %repeat %until mou_buttons& Mouse left = 0
    ! Now extract the stuff
    first x = from screen x(firstx)
    first y = from screen y(firsty)
    last x = from screen x(lastx)
    last y = from screen y(lasty)
    ii = 1   { ii and jj are the increments for writing through
    jj = 1
    %if firstx > last x %then  ii = -1 %and firstx=firstx+1 %else lastx=lastx+1
    %if firsty > lasty  %then  jj = -1 %and firsty=firsty+1 %else lasty=lasty+1
    %for i = firstx,ii,lastx %cycle
      %for j = firsty,jj,lasty %cycle
        grid(i)_y(j) = grid(i)_y(j) & \ layer m(what)
      %repeat
    %repeat
    l = from screen x(l)+1
    m = fromscreeny(m)+1
    x = fromscreenx(x)-1
    y = fromscreeny(y)-1
    %if overflow = 0 %start
      repaint(grid,x,y,l,m)
      draw contact(contacts(i)_t,contacts(i)_x,contacts(i)_y) %for i = 1,1,con ptr -1
    %else
      refresh(grid,contacts,con ptr)
    %finish
    coordinates(mou_x,mou_y,0)
    !
    %return
    !---------------------------------------------------------------------------
  del(zoom s):
  del(pan s):
  del(move s):
  del(wipe s):
  del(ii s):
  del(oo s):
  del(stop s):
  del(grid s):
  del(clones):
    draw(what,mou)
    %return
    !---------------------------------------------------------------------------
  del(*):       { contacts }
    l = lookup(what)
    i = locate contact(l,from screen x(mou_x),from screen y(mou_y))
    %if overflow = 1 %or i = -1 %start
      flash screen
      coordinates(mou_x,mou_y,0)
      %return
    %finish
    x = contacts(i)_x;y = contacts(i)_y
    con ptr = con ptr -1
    remove con marker(contacts(i))
    contacts(i) = contacts(con ptr)
    enable  (7)
    repaint(grid,(x-conxl(l)),(y-conyb(l)),(x+conxr(l)),(y+conyt(l)))
    coordinates(mou_x,mou_y,0)
    %return
%end         { OF ERASE }
!-------------------------------------------------------------------------------
%routine cart cursor(%integer ox,oy,nx,ny)
  %constant %integer %array sizeof(poly s:implement end)=2(4),5(4),6(2),
                                                        4(2),5(4),4,2(*)
  %integer k,i,j,l
  k = overflow
  overflow = 0
  i = from screen x(ox)
  j = from screen y(oy)
  enable  (8)
  colour(0)
  fill(ox,oy,ox+15,oy+15)
  %if overflow = 0 %and  ox > 80 %start
     enable  (7)
     l = sizeof(selected)
     repaint(grid,i,j,i+l,j+l)
     %if con ptr >  1 %start
       %for l = 1,1,con ptr -1 %cycle
          %if i-3 < contacts(l)_x < i+10 %and %c
              j-3 < contacts(l)_y < j+10 %then %c
            draw contact(contacts(l)_t,contacts(l)_x,contacts(l)_y)
       %repeat
     %finish     
  %finish
  overflow = 0
  i = from screen x(nx)
  j = from screen y(ny)
  %if nx < 112 %or overflow = 1 %or selected > bu %start
     enable  (8)
     colour(8)
     fill(nx,ny,nx+15,ny+15)
  %else %if selected < pdbns 
     enable  (layer col(selected)!! 15 {7})
     colour(layer col(selected)!!15)
     %if selected = implant s %then box(nx,ny,nx+15,ny+15) %else %start
        fill(nx,ny,nx+15,ny+15)
{       colour(white)
 {       box(nx,ny,nx+15,ny+15)
     %finish
  %else
     enable  (7)
     l = lookup(selected)
     draw contact(l,i+conxl(l),j+conyb(l))
  %finish
  enable  (7)
  overflow = k
%end
!-----------------------------------------------------------------------------
! The main prog

x pix low = to screen x(sc xl)
y pix low = to screen y(sc yb)
x pix lim = to screen x(scxr)
y pix lim = to screen y(scyt)
%for i = -frames,1,xrlim + frames %cycle
  grid(i) = 0 
%repeat
set terminal mode(nopage)
Terminal Model = Visual 200                  { We must find a better way...
Set Terminal Characteristics
clear screen
printstring("+--------+-----------+---------+")
newline
printstring("|  LEFT  |  MIDDLE   |   RIGHT |")
newline
printstring("+--------+-----------+---------+")
newline
printstring("| ERASE  |    DRAW   | TOGGLE  |")
newline
printstring("| PICK   |    PICK   | TOGGLE  |")
newline
printstring("+--------+-----------+---------+")
initialise
move cursor(0,0,0,0)
select input(0)
pick(500)
offset(0,0)
refresh(grid,contacts,con ptr)
coordinates(0,0,0)
%CYCLE
  overflow = 0
  mou = mouse change(0,0,xpixlim,ypixlim)
  cart cursor(xcoor,ycoor,mou_x,mou_y)
  xcoor = mou_x
  ycoor = mou_y
  -> but(mou_buttons)
  !----------------
  but(Mouse right):
    next(selected)
    coordinates(mou_x,mou_y,0)
    %continue
    !--------------------
  but(Mouse left):
    %if mou_x > 80 %start
     erase(selected,mou)
     cart cursor(mou_x,mou_y,mou_x,mou_y)
     xcoor = mou_x
     ycoor = mou_y
   %else 
     pick(mou_y)
     coordinates(mou_x,mou_y,0)
   %finish
   %continue
   !---------------
  but(Mouse middle):
    %if mou_x > 80 %start
      draw(selected,mou)
      xcoor = mou_x;ycoor = mou_y
      cart cursor(mou_x,mou_y,mou_x,mou_y)
    %else
      pick(mou_y)
      coordinates(mou_x,mou_y,0)
    %finish
    %continue
  but(*):
%REPEAT
 
%endofprogram