%begin
%include "level1:graphinc.imp"
%include "inc:util.imp"
%routine pcircle(%integer x, y, r, p)
   %integer d, e, s, da, db, dda, ddb, oda, odb, odda, oddb,
          ddax, ddbx, oddax, oddbx
   %integer %function mulshf(%integer a, b, c)
      *mulu d1,d0
      *lsr.l d2,d0
      *lea 12(sp),sp
      *rts
      %result=a
   %end
   e = 1
   s = 0
   %while e<r %cycle
      e = e<<1
      s = s+1
   %repeat
   da = r<<s
   dda = r
   ddax = (r*p)>>4
   db = 0
   ddb = 0
   ddbx = 0
   %cycle
      odda = dda
      oddb = ddb
      oddax = ddax
      oddbx = ddbx
      %cycle
         odb = db
         db = db+(da>>s)
         da = da-(odb>>s)
         dda = da>>s
      %repeat %until odda#dda
      ddb = db>>s
      ddax = mulshf(da, p, s+4); !
!     ddax = (da*p)>>(s+4)
      ddbx = mulshf(db, p, s+4); !
!     ddbx = (db*p)>>(s+4)
      hline(x-ddbx,x+ddbx,y+odda)
      fill(x-oddax,y+oddb,x+oddax,y+ddb)
      fill(x-oddax,y-oddb,x+oddax,y-ddb)
      hline(x-ddbx,x+ddbx,y-odda)
   %repeat %until da<odb
%end
%constant %integer CX = 344, back = black
%routine apm(%integer c1, c2, p)
   %own %integer lp=0, lp1=0, cy = 255, cy1 = 767, t = 0
   offset(0, cy-255)
   t = cpu time+3
   %while cpu time<t %cycle; %repeat
!   colour(back)
!   fill(cx-lp1*14,cy1-244,cx+lp1*14,cy1+244)
   half clear(cy1>>9)
   lp1 = lp
   lp = cy1
   cy1 = cy
   cy = lp
   lp = p
   colour(c1)
   %if p=0 %start
      fill(cx+1, cy-223, cx+3, cy+223)
      colour(c2)
      fill(cx-2, cy-223, cx, cy+223)
      %for c1 = 0, 1, 5000 %cycle
      %repeat
   %finish %else %start
      pcircle(cx, cy, 224, p)
      colour(c2)
      pcircle(cx-10*p, cy, 48, p)
      fill(cx-9*p, cy-48, cx-7*p, cy)
      fill(cx-5*p, cy-96, cx-3*p, cy)
      pcircle(cx-2*p, cy, 48, p)
      fill(cx+3*p, cy-48, cx+5*p, cy)
      pcircle(cx+6*p, cy, 48, p)
      fill(cx+7*p, cy-48, cx+9*p, cy)
      pcircle(cx+10*p, cy, 48, p)
      fill(cx+11*p, cy-48, cx+13*p, cy)
      colour(c1)
      pcircle(cx-10*p, cy, 16, p)
      pcircle(cx-2*p, cy, 16, p)
      fill(cx+5*p, cy-48, cx+7*p, cy)
      pcircle(cx+6*p, cy, 16, p)
      fill(cx+9*p, cy-48, cx+11*p, cy)
      pcircle(cx+10*p, cy, 16, p)
   %finish
%end
%integer p
%on %event 0 %start
   print symbol(27)
   print symbol('R')
   %stop
%finish

select input(0)
open input(0, ":t")
clear
%cycle
   apm(blue, red, p) %for p = 16, -1, 1
   apm(red, blue, p) %for p = 0, 1, 15
   apm(red, blue, p) %for p = 16, -1, 1
   apm(blue, red, p) %for p = 0, 1, 15
%repeat %until test symbol>=0
%end %of %program
