!  Clipping, scaling, zooming

%integer xoffset=0,yoffset=0
%real xscale=1,yscale=1
%integer vl = 0,vr = 688,vb = 0,vt = 512; !Viewport (physical coordinates)
%integer wl = 0,wr = 688,wb = 0,wt = 512; !Window   (virtual  coordinates)
%real screen aspect ratio = ((vt-vb)*4)/((vr-vl)*3)

%routine scale(%integername x,y); !Map to device coords
  x = intpt(x*xscale)+xoffset
  y = intpt(y*yscale)+yoffset
%end

%routine align window with viewport
! Make sure scaled middle of virtual window
! maps to middle of device window
%integer vx = (vl+vr)//2, vy = (vb+vt)//2
%integer wx = (wl+wr)//2, wy = (wb+wt)//2
  xoffset = 0; yoffset = 0; scale(wx,wy)
  xoffset = vx-wx; yoffset = vy-wy
%end

%routine aspect ratio
%real f
  f = |yscale/xscale/screen aspect ratio|
  %if f>1 %then yscale = yscale/f %else xscale = xscale*f
  align window with viewport
%end

%routine compute scalings
  xscale = (vr-vl)/(wr-wl)
  yscale = (vt-vb)/(wt-wb)
  aspect ratio
%end

%routine viewport(%integer x1,y1,x2,y2)
  vl = x1; vb = y1; vr = x2; vt = y2
  compute scalings
%end

%routine window(%integer x1,y1,x2,y2)
  wl = x1; wr = x2; wt = y2; wb = y1
  compute scalings
%end

%routine zoom(%integer tx,ty,%real f)
! TX, TY are the centre of the new window
%integer wx = intpt((wr-wl)/f)
%integer wy = intpt((wt-wb)/f)
  wl = tx-wx//2; wr = wl+wx
  wb = ty-wy//2; wt = wb+wy
  compute scalings
%end

%integerfn clipcode(%integer x,y)
%integer c=0
  c = 1 %if x<vl
  c = c+2 %if x>vr
  c = c+4 %if y<vb
  c = c+8 %if y>vt
  %result=c
%end

%routine clipped line(%integer x1,y1,x2,y2)
%integer c1 = clipcode(x1,y1)
%integer c2 = clipcode(x2,y2)
%integer dx,dy

  %routine into range(%integername x,y)
    y = intpt((vl-x)*dy/dx)+y %and x = vl %if x<vl
    y = intpt((vr-x)*dy/dx)+y %and x = vr %if x>vr
    x = intpt((vb-y)*dx/dy)+x %and y = vb %if y<vb
    x = intpt((vt-y)*dx/dy)+x %and y = vt %if y>vt
  %end

  %returnunless c1&c2=0
  %unless c1!c2=0 %start
    dx = x2-x1; dy = y2-y1
    into range(x1,y1)
    into range(x2,y2)
  %finish
  line(x1,y1,x2,y2)
%end

%routine scaled line(%integer x1,y1,x2,y2)
  scale(x1,y1); scale(x2,y2)
  clipped line(x1,y1,x2,y2)
%end

%routine clipped fill(%integer x1,y1,x2,y2)
%integer c1 = clipcode(x1,y1)
%integer c2 = clipcode(x2,y2)

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

  %returnunless c1&c2=0
  sw(x1,x2) %if x1>x2
  sw(y1,y2) %if y1>y2
  x1 = vl %if x1<vl
  y1 = vb %if y1<vb
  x2 = vr %if x2>vr
  y2 = vt %if y2>vt
  fill(x1,y1,x2,y2)
%end

%routine scaled fill(%integer x1,y1,x2,y2)
  scale(x1,y1); scale(x2,y2)
  clipped fill(x1,y1,x2,y2)
%end

%endoffile