! Pan and Zoom for TED
! Zooming- draw a picture at 479,568 (origin at 335,512)
! scale = 2 pixels per lambda

%external %routine zoom(%record(array fm) %array %name grid(-frames:xrlim+frames),
                        %record(con f)    %array %name contacts(1:200),
                        %integer con ptr)
  ! because of the size differnce we introduce other scaling functions
  !-------------------------------------------------------------------------------
  %integer %function toxpix(%integer i)
    %result = i*2+478
  %end
  !-------------------------------------------------------------------------------
  %integer %function toypix(%integer i)
    %result = I*2 + 568
  %end
  !-------------------------------------------------------------------------------
  %routine box(%integer i,j,k,l)
    l = 1023 %if l > 1023
    k = 1023 %if k > 1023
    line(i,j,i,l)
    line(i,l,k,l)
    line(k,l,k,j)
    line(k,j,i,j)
 %end
  !--------------------------------------------------------------------------------
  %routine draw contact(%record (con f) contact)
  %integer i,j,k,l,ii,jj,x,y,type,ll,kk
  %constant %byte poly = red,diff=green,metal = blue
  %switch contype(0:12)

  
  type = contact_t
  y = contact_y + 1
  x = contact_x + 1
  -> contype(type)
  contype(0):         {PM}
    i = x - 2; j = y - 2; k = x + 2; l = y + 2
    enable  (15)
    colour(poly ! metal)
    fill(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    colour(white)
    box(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    colour(black)
    i = i + 1; j = j + 1; k = k - 1; l = l - 1
    fill(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    %return
  contype(1):         { DM }
    i = x - 2; j = y - 2; k = x + 2; l = y + 2
    enable  (15)
    colour(diff ! metal )
    fill(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    colour(white)
    box(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    colour(black)
    i = i + 1; j = j + 1; k = k - 1; l = l - 1
    fill(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    %return
  contype(2):         { PDBN }
    i = x - 2; j = y - 2; k = x + 2; l = y + 3
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    enable  (15)
    colour(white)
    box(ii,jj,kk,ll)
    enable  (poly)
    colour(poly)
    j = j + 1; l = y + 1
    fill(ii+1,toypix(j),kk-1,toypix(l)-1)
    enable  (diff)
    colour(diff)
    i = i + 1; j = y - 2; k = x + 1; l = y + 3
    fill(toxpix(i),toypix(j)+1,toxpix(k)-1,toypix(l)-2)
    enable  (15)
    %return
  contype(3):       { PDBE }
    enable  (15)
    colour(white)
    i = x - 2; j = y - 2; k = x + 3; l = y + 2
    ii = toxpix(i);jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (diff)
    colour(diff)
    j = j + 1; l = l - 1
    fill(ii,toypix(j),kk,toypix(l)-1)
    i = i + 1; j = y - 2; k = x + 1; l = y + 2
    enable  (poly)
    colour(poly)
    fill(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    %return
  contype(4):        { PDBS }
    i = x - 2; j = y - 3; k = x + 2; l = y + 2
    enable  (15)
    colour(white)
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (poly)
    colour(poly)
    j = j + 2; l = y + 1
    fill(ii+1,toypix(j),kk-1,toypix(l)-1)
    enable  (diff)
    colour(diff)
    i = i + 1; j = y - 3; k = x + 1; l = y + 2
    fill(toxpix(i),toypix(j)+1,toxpix(k)-1,toypix(l)-2)
    %return
  contype(5):        { PDBW }
    enable  (15)
    colour(white)
    i = x - 3; j = y - 2; k = x + 2; l = y + 2
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (diff)
    colour(diff)
    j = j + 1; l = l - 1
    fill(ii,toypix(j),kk-1,toypix(l)-1)
    i = i + 2; j = y - 2; k = x + 1; l = y + 2
    enable  (poly)
    colour(poly)
    fill(toxpix(i),toypix(j)+1,toxpix(k)-1,toypix(l)-2)
    %return
  contype(6):        { PDBNS }
    i = x - 2; j = y - 3; k = x + 2; l = y + 3
    enable  (15)
    colour(white)
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (poly)
    colour(poly)
    j = y - 1; l = y + 1
    fill(ii+1,toypix(j),kk-1,toypix(l)-1)
    enable  (diff)
    colour(diff)
    i = i + 1; j = y - 3; k = x + 1; l = y + 3
    fill(toxpix(i),toypix(j)+1,toxpix(k)-1,toypix(l)-2)
    %return
  contype(7):       { PDBEW }
    enable  (15)
    colour(white)
    i = x - 3; j = y - 2; k = x + 3; l = y + 2
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (diff)
    colour(diff)
    j = j + 1; l = l - 1
    fill(ii+1,toypix(j),kk-1,toypix(l)-1)
    i = i + 2; j = y - 2; k = x + 1; l = y + 2
    enable  (poly)
    colour(poly)
    fill(toxpix(i),toypix(j)+1,toxpix(k)-1,toypix(l)-2)
    %return
  contype(8):     { PDCN }
    enable  (15)
    colour (white)
    i = x - 2; j = y - 2; k = x + 2; l = y + 3
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (poly)
    colour(poly)
    fill(ii+1,jj+1,kk-1,toypix(l-2))
    enable  (diff)
    colour( diff )
    i = x - 1; j = y - 1; k = x + 1
    fill(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-2)
    %return
  contype(9):     { PDCE }
    enable  (15)
    colour (white)
    i = x - 2; j = y - 2; k = x + 3; l = y + 2
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (poly)
    colour(poly)
    fill(ii+1,jj+1,toxpix(k-2)-1,ll)
    enable  (diff)
    colour(diff)
    i = x - 1; j = y - 1; k = x + 3; l = y + 1
    fill(toxpix(i),toypix(j),toxpix(k)-2,toypix(l)-1)
    %return
  contype(10):    { PDCS }
    enable  (15)
    colour (white)
    i = x - 2; j = y - 3; k = x + 2; l = y + 2
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (poly)
    colour(poly)
    fill(ii+1,toypix(y - 1),kk-1,ll-1)
    enable  (diff)
    colour( diff )
    i = x - 1; j = y - 3; k = x + 1; l = y +1
    fill(toxpix(i),toypix(j)+1,toxpix(k)-1,toypix(l)-1)
    %return
  contype(11):    { PDCW }
    enable  (15)
    colour (white)
    i = x - 3; j = y - 2; k = x + 2; l = y + 2
    ii = toxpix(i); jj = toypix(j);kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
    enable  (poly)
    colour(poly)
    fill(toxpix(i+2),jj+1,kk-1,ll-1)
    enable  (diff)
    colour(diff)
    i = x - 3;j = y - 1; k = x + 1;l = y + 1
    fill(toxpix(i),toypix(j),toxpix(k)-1,toypix(l)-1)
    %return
  contype(12):   { B C }
    i = x - 2; j = y - 2; k = x + 2; l = y + 2
    enable  (15)
    colour(white)
    ii = toxpix(i); jj = toypix(j); kk = toxpix(k)-1; ll = toypix(l)-1
    box(ii,jj,kk,ll)
!    %return
  %end
  !-----------------------------------------------------------------------------
  %routine move cursor(%integer %name oldi,oldj, %integer i,j)
    colour(0)
    box(oldi,oldj,oldi+152,oldj+134)
   colour(8)
    box(i,j,i+152,j+134)
    oldi=i;oldj=j
  %end
  !-----------------------------------------------------------------------------
  %record (mouse fm) %map mouse change
    %constant %integer xr=879,xl=326
    %constant %integer yb=434,yt=968
    %own %record (mouse fm) last = 0
    %record (mouse fm) test
  
    %cycle
      test = mouse
    %repeat %until test_x # last_x %or test_y # last_y %or test_buttons # last_buttons
    %if test_x > xr %then coordinates(xr,test_y,test_buttons) %and test_x=xr
    %if test_x < xl %then coordinates(xl,test_y,test_buttons) %and test_x=xl
    %if test_y > yt %then coordinates(test_x,yt,test_buttons) %and test_y=yt
    %if test_y < yb %then coordinates(test_x,yb,test_buttons) %and test_y=yb
    last = test
    %result == last
  %end
 
  %record (mouse fm) mou
  %integer i,j,k,ii,jj

  enable  (15)
  colour(black)
  fill(335,512,1023,1023)
  colour(white)
  box(toxpix(0)-1,toypix(0)-1,toxpix(xrlim)+1,toypix(ytlim)+1)
  offset(335,512)
  ii = toxpix(minimum x)
  %for i = minimumx-1,1,maximum x+1 %cycle
    jj = toypix(minimumy)
    %for j = minimumy-1,1,maximum y+1 %cycle
      k = grid(i)_y(j)
      %if k&7 # 0 %start
        colour(k&7)
        fill(ii,jj,ii+1,jj+1)
      %finish
      %if k&8 # 0 %start
        colour(yellow)
        %if grid(i)_y(j-1) &8 = 0 %then line(ii,jj,ii+1,jj)
        %if grid(i)_y(j+1) &8 = 0 %then line(ii,jj+1,ii+1,jj+1)
        %if grid(i-1)_y(j) &8 = 0 %then line(ii,jj,ii,jj+1)
        %if grid(i+1)_y(j) &8 = 0 %then line(ii+1,jj,ii+1,jj+1)
      %finish
      jj = jj + 2
    %repeat
    colour(red)
    fill(ii,520,ii+1,525)
    ii = ii + 2
  %repeat
  %if con ptr > 1 %start
    draw contact(contacts(i)) %for i = 1,1,con ptr -1
  %finish
  enable  (8)
  colour(8)
  i = toxpix(scxl)
  j = toypix(scyb)
  k = toxpix(scxr)
  jj= toypix(scyt)
  box(i,j,k,jj)
  coordinates(i,j,0)
  ! Now set up the box as the cursor , and use it to setup scxr,&c
  cursor(0,3)
  printstring("| RETURN |  RETURN   | RETURN  |")
  %cycle
    mou= mouse change
    move cursor(i,j,mou_x,mou_y)
  %repeat %until mou_buttons # 0
  scxl = (mou_x - 479)//2
  scxr = scxl + 76
  scyb = (mou_y - 568)//2
  scyt = scyb + 67
  enable  (15)
  cursor(0,3)
  printstring("| ERASE  |    DRAW   | TOGGLE  |")
  offset(0,0)
  colour(red)
  fill(0,513,688,1023)
%end

%endoffile