%begin
   %include "mach:extl1.imp"
   %routine half clear(%integer half)
! hclear   movem.l d4-d7/a4,-(sp)
!          movem.l hclrdata,d1-d7/a0-a4
!          move.w  #$FF00,fspwrten
!          and.l   #1,d0
!          swap    d0
!          add.l   d0,a4
!          move.l  #127,d0
! hclrloop lea     -40(a4),a4
!          movem.l d1-d7/a0-a3,-(a4)
!          movem.l d1-d7/a0-a3,-(a4)
!          lea     -40(a4),a4
!          movem.l d1-d7/a0-a3,-(a4)
!          movem.l d1-d7/a0-a3,-(a4)
!          lea     -40(a4),a4
!          movem.l d1-d7/a0-a3,-(a4)
!          movem.l d1-d7/a0-a3,-(a4)
!          lea     -40(a4),a4
!          movem.l d1-d7/a0-a3,-(a4)
!          movem.l d1-d7/a0-a3,-(a4)
!          dbra    d0,hclrloop
!          movem.l (sp)+,d4-d7/a4
!          rts
! hclrdata dc.l    -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,fsbase+$10000
*=16_48E7;*=16_0F08;*=16_4CFA;*=16_1FFE;
*=16_0050;*=16_33FC;*=16_FF00;*=16_00E2;
*=16_0000;*=16_C0BC;*=16_0000;*=16_0001;
*=16_4840;*=16_D9C0;*=16_707F;*=16_49EC;
*=16_FFD8;*=16_48E4;*=16_7FF0;*=16_48E4;
*=16_7FF0;*=16_49EC;*=16_FFD8;*=16_48E4;
*=16_7FF0;*=16_48E4;*=16_7FF0;*=16_49EC;
*=16_FFD8;*=16_48E4;*=16_7FF0;*=16_48E4;
*=16_7FF0;*=16_49EC;*=16_FFD8;*=16_48E4;
*=16_7FF0;*=16_48E4;*=16_7FF0;*=16_51C8;
*=16_FFCE;*=16_4CDF;*=16_10F0;*=16_4E75;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_FFFF;*=16_FFFF;
*=16_FFFF;*=16_FFFF;*=16_00E1;*=16_0000;
   %end

   %integer xa, xb, xc, xd, ya, yb, yc, yd, b, h, t, xinca, xincb, xincc,
            xpos, ypos, yinca, yincb, yincc, xe, ye, xince, yince, pinc,
            ppos, s, f
%routine sws(%integer s, ypos, half, %integer %name xpos, font)
!          lsl.w   #2,d0
!          and.w   #$03FC,d0
!          move.l  0(a1,d0.w),d0
!          lsl.l   #2,d0
!          lea     0(a1,d0.l),a1
!          move.l  (a1)+,d4
!          move.l  (a0),d0
!          move.l  d0,d3
!          add.l   (a1)+,d3
!          cmp.l   #688,d3
!          blt.s   nowrapx
!          sub.l   #688,d3
! nowrapx  move.l  d3,(a0)
!          dbra    d4,drawchar
!          rts
! drawchar lea     fsbase,a0
!          swap    d2
!          add.l   d2,a0
!          move.l  #-128,d2
!          lsl.w   #7,d1
!          move.l  d0,d3
!          and.w   #$000F,d3
!          lsr.w   #3,d0
!          and.w   #$FFFE,d0
!          cmp.w   #84,d0
!          beq.s   split
!          add.w   d0,a0
! simplelp move.l  (a1)+,d0
!          lsr.l   d3,d0
!          move.l  d0,0(a0,d1.l)
!          sub.w   d2,d1
!          dbra    d4,simplelp
!          rts
! split    move.l  a0,a2
!          add.w   d0,a0
! splitlp  move.l  (a1)+,d0
!          lsr.l   d3,d0
!          move.w  d0,0(a2,d1.l)
!          swap    d0
!          move.w  d0,0(a0,d1.l)
!          sub.w   d2,d1
!          dbra    d4,splitlp
!          rts
*=16_E548;*=16_C07C;*=16_03FC;*=16_2031;
*=16_0000;*=16_E588;*=16_43F1;*=16_0800;
*=16_2819;*=16_2010;*=16_2600;*=16_D699;
*=16_B6BC;*=16_0000;*=16_02B0;*=16_6D06;
*=16_96BC;*=16_0000;*=16_02B0;*=16_2083;
*=16_51CC;*=16_0004;*=16_4E75;*=16_41F9;
*=16_00E0;*=16_0000;*=16_4842;*=16_D1C2;
*=16_7480;*=16_EF49;*=16_2600;*=16_C67C;
*=16_000F;*=16_E648;*=16_C07C;*=16_FFFE;
*=16_B07C;*=16_0054;*=16_6712;*=16_D0C0;
*=16_2019;*=16_E6A8;*=16_2180;*=16_1800;
*=16_9242;*=16_51CC;*=16_FFF4;*=16_4E75;
*=16_2448;*=16_D0C0;*=16_2019;*=16_E6A8;
*=16_3580;*=16_1800;*=16_4840;*=16_3180;
*=16_1800;*=16_9242;*=16_51CC;*=16_FFEE;
*=16_4E75;
%end

   %integer %function mod688(%integer x)

      %if x>=688 %start
         %if x>13760 %start
            x = rem(x, 688)
         %else
            x = x-688 %while x>=688
         %finish
      %else %if x<0
         x = rem(x, 688) %if x<-13760
         x = x+688 %while x<0
      %finish
      %result = x
   %end

   %routine showwrapsymbol(%integer s)

      sws(s, ypos, h, xpos, integer(f))
   %end

   %routine showwrapstring(%string(255)s)
     %integer i

     showwrapsymbol(charno(s,i)) %for i=1,1,length(s)
   %end

   %routine wrapat(%integer x, y)

      xpos = mod688(x)
      ypos = y&511
   %end

   %routine wrapfill(%integer x0, y0, x1, y1)

      %routine ywrap(%integer x0, y0, x1, y1)
         %if y0<y1 %start
            fill(x0, y0+b, x1, y1+b)
         %else
            fill(x0, b, x1, y1+b)
            fill(x0, y0+b, x1, b+511)
         %finish
      %end

      y0 = y0&511
      y1 = y1&511
      x0 = mod688(x0)
      x1 = mod688(x1)
      %if x0<x1 %start
         ywrap(x0, y0, x1, y1)
      %else
         ywrap(0, y0, x1, y1)
         ywrap(x0, y0, 687, y1)
      %finish
   %end



   %integer %function random(%integer %name s, %integer bits)
      *and.l #15,d0
      *move.l #-1,d2
      *lsl.l  d0,d2
      *not.l  d2
      *move.l #15,d1
      *sub.l d0,d1
      *move.l (a0),d0
      *mulu #23501,d0
      *add.l #6923,d0
      *and.l #16_7FFF,d0
      *move.l d0,(a0)
      *lsr.l  d1,d0
      *and.l  d2,d0
      *add.l #8,a7
      *rts
      %result = s
   %end
   %integer %function randy(%integer %name s)
      %integer i
      i = random(s, 4)-8
      i = 0 %if i<-7
      %result = (i+1)//2
   %end

   %record%format point(%integer x, y)
   %record %format hl(%integer x0, x1, y)
   %record(hl) pa, pb

   read font("mach:visual", f)
   h = 0
   b = 0
   s = cputime
   xa = rem(random(s, 12), 488)
   ya = rem(random(s, 12), 411)
   xb = rem(random(s, 12), 488)
   yb = rem(random(s, 12), 411)
   xc = rem(random(s, 12), 438)
   yc = rem(random(s, 12), 411)
   xd = rem(random(s, 12), 488)
   yd = rem(random(s, 12), 361)
   xe = rem(random(s, 12), 488)
   ye = rem(random(s, 12), 311)
   ppos = 0
   pinc = random(s, 4)-8
   pinc = 8 %if pinc=0
   pinc = (pinc+1)//2
   xinca = randy(s)
   xincb = randy(s)
   xincc = randy(s)
   xince = randy(s)
   yinca = randy(s)
   yincb = randy(s)
   yincc = randy(s)
   yince = randy(s)


   t = cpu time+20
   %cycle
      half clear(h)
      short integer(16_E20000) = 16_0F01
      wrapfill(xa, ya, xa+200, ya+100)
      short integer(16_E20000) = 16_0F00
      wrapat(xa+10, ya+80)
      showwrapstring("A red box.")
      short integer(16_E20000) = 16_0F04
      wrapfill(xd, yd, xd+200, yd+150)
      short integer(16_E20000) = 16_0F00
      wrapat(xd+10, yd+130)
      showwrapstring("A fixed blue box.")
      short integer(16_E20000) = 16_0F02
      wrapfill(xb, yb, xb+200, yb+100)
      short integer(16_E20000) = 16_0F00
      wrapat(xb+10, yb+80)
      showwrapstring("A green box.")
      short integer(16_E20000) = 16_0F03
      wrapfill(xc, yc, xc+250, yc+100)
      short integer(16_E20000) = 16_0F00
      wrapat(xc+10, yc+80)
      showwrapstring("A long yellow box.")
      short integer(16_E20000) = 16_0F06
      short integer(16_E20000) = 16_0F05
      wrapfill(xe, ye, xe+200, ye+20)
      wrapfill(xe, ye+20, xe+20, ye+180)
      wrapfill(xe, ye+180, xe+200, ye+200)
      wrapfill(xe+180, ye+20, xe+200, ye+180)
      wrapfill(xe+95, ye+20, xe+105, ye+180)
      wrapfill(xe+20, ye+95, xe+180, ye+105)
      short integer(16_E20000) = 16_0F00
      wrapat(xe+10, ye+183)
      show wrapstring("A window")
      offset(0, b)
      t = cputime+3
      h = 1-h
      b = 512-b
      ppos = ppos+pinc
      xa = mod688(xa+xinca)
      ya = (ya+yinca)&511
      xb = mod688(xb+xincb)
      yb = (yb+yincb)&511
      xc = mod688(xc+xincc)
      yc = (yc+yincc)&511
      xe = mod688(xe+xince)
      ye = (ye+yince)&511
      %while cputime<t %cycle; %repeat
   %repeat


%end %of %program