rem Bezier Curves (Assembler Version) ....... Rev 3.0
      rem A J Tooth // November 11th 2003 Revised 4th December 2003
      on error if (err=17) then quit
      *FLOAT64
      rem Call Utility Procedures
      proc_fullscreen(22) :  rem Set up use of Full Screen
      
      dim lps%(8,2),phi(4),vps(2,2)
      
      dim a% 7,b% 7,C1% 7,C2% 7,C12% 7
      dim s11% 7,s21% 7,s31% 7,s41% 7,s12% 7,s22% 7,s32% 7,s42% 7
      dim i% 3,num% 3,x% 3,y% 3,thr% 7
      
      |thr%=3.0  : rem Sets up a FP constant equal to 3.0 for later use.
      
      dim bezier% 1000
      
      rem Dual-pass assembly, in case of labels
      for pass%=0 to 2 step 2
        proc_bezier(pass%)
      next pass%
      colour 136 : cls
      
      rem Parameter Initialisation for "Source" Curve
      proc_setpars  : !num%=1500
      
      repeat
        cnt%=0
        repeat
          rem Parameters for "Destination" Curve
          proc_setdespars
          
          rem Pick a colour, any colour
          re%=rnd(255) : gr%=rnd(255) : bl%=rnd(255)
          
          c=0 : rem Re-initialise Control Variable
          repeat
            sys "GetCurrentProcess" to hprocess%
            sys "SetPriorityClass", hprocess%, &100
            for k=0.001 to K step 0.001
              rem Set Parameters for Intermediate Curves
              proc_setinterpars(c+k)
              
              rem Adjust Colour for Brightness
              f=k/K
              vdu 19,10,16,f*re%,f*gr%,f*bl%
              gcol 10
              
              rem Draw a single BEZIER Curve
              for !i%=1 to (!num%-1)
                
                call bezier%
                
                plot |x%,|y%
              next
            next k
            sys "GetCurrentProcess" to hprocess%
            sys "SetPriorityClass", hprocess%, &20
            
            c+=0.04 : rem Increase Control Variable
            f$=inkey$(1) : rem Wait 1ms for a key to be pressed
          until c>=1 or f$=" "
          
          rem Swap "Destination" Parameters for "Source" Parameters
          proc_swappars
          
          cnt%+=1
        until f$=" " or cnt%>Lim%
        
        rem Clear the screen unless the space-bar was pressed
        if not(f$=" ") then clg : colour 136 : cls
      until f$=" "
      
      repeat
        g$=inkey$(1)
      until g$<>" "
      
      a$=get$
      quit
      end
      rem End of Program
      rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Set up use of Full Screen
      def proc_fullscreen(N%)
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      mode N%
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      
      rem Parameter Initialisation for "Source" Curve
      def proc_setpars
      lps%(1,1)=rnd(2048) : lps%(1,2)=rnd(1536)
      lps%(4,1)=rnd(2048) : lps%(4,2)=rnd(1536)
      phi(1)=2*pi*rnd(1) : phi(2)=2*pi*rnd(1)
      st1%=300+rnd(500) : st2%=300+rnd(500)
      Lim%=5*rnd(5) : K=0.02
      endproc
      
      rem Parameters for "Destination" Curve
      def proc_setdespars
      lps%(5,1)=rnd(2048) : lps%(5,2)=rnd(1536)
      lps%(8,1)=rnd(2048) : lps%(8,2)=rnd(1536)
      phi(3)=2*pi*rnd(1) : phi(4)=2*pi*rnd(1)
      st3%=300+rnd(500) : st4%=300+rnd(500)
      endproc
      
      rem Set Parameters for Intermediate Curves
      def proc_setinterpars(C)
      D=1-C
      stx=D*st1%+C*st3% : sty=D*st2%+C*st4%
      phi1=D*phi(1)+C*phi(3) : phi2=D*phi(2)+C*phi(4)
      
      vps(1,1)=stx*cos(phi1) : vps(1,2)=stx*sin(phi1)
      vps(2,1)=sty*cos(phi2) : vps(2,2)=sty*sin(phi2)
      
      |s11%=D*lps%(1,1)+C*lps%(5,1)
      |s12%=D*lps%(1,2)+C*lps%(5,2)
      |s21%=D*lps%(1,1)+C*lps%(5,1) + vps(1,1)
      |s22%=D*lps%(1,2)+C*lps%(5,2) + vps(1,2)
      |s31%=D*lps%(4,1)+C*lps%(8,1) + vps(2,1)
      |s32%=D*lps%(4,2)+C*lps%(8,2) + vps(2,2)
      |s41%=D*lps%(4,1)+C*lps%(8,1)
      |s42%=D*lps%(4,2)+C*lps%(8,2)
      endproc
      
      rem Swap "Destination" Parameters for "Source" Parameters
      def proc_swappars
      lps%(1,1)=lps%(5,1) : lps%(1,2)=lps%(5,2)
      lps%(4,1)=lps%(8,1) : lps%(4,2)=lps%(8,2)
      phi(1)=phi(3) : phi(2)=phi(4)
      st1%=st3% : st2%=st4%
      endproc
      
      rem Assembly Language Routine
      rem for Bezier Calculation
      def proc_bezier(opt%)
      P%=bezier%
      
      [opt opt%
      
      finit
      
      fild dword [i%]        \Set up Factors
      fild dword [num%]
      fdivp st1,st0
      fst qword [a%]
      fld1
      fsubrp st1,st0
      fst qword [b%]
      fld st0
      fld st0
      fmulp st1,st0
      fmulp st1,st0
      fstp qword [C2%]
      fld qword [a%]
      fld st0
      fld st0
      fmulp st1,st0
      fmulp st1,st0
      fstp qword [C1%]
      fld qword [a%]
      fld qword [b%]
      fmulp st1,st0
      fstp qword [C12%]     \Set up Factors
      
      fld qword [b%]        \Calculate x term
      fld qword [s21%]
      fmulp st1,st0
      fld qword [a%]
      fld qword [s31%]
      fmulp st1,st0
      faddp st1,st0
      fld qword [C12%]
      fmulp st1,st0
      fld qword [thr%]
      fmulp st1,st0         \Middle x term left On stack here
      
      fld qword [s11%]
      fld qword [C2%]
      fmulp st1,st0         \First x term left here
      
      fld qword [s41%]
      fld qword [C1%]
      fmulp st1,st0         \Third x term left here
      
      faddp st1,st0
      faddp st1,st0         \Add all three Together
      fistp dword [x%]       \Calculate x term
      
      fld qword [b%]        \Calculate y term
      fld qword [s22%]
      fmulp st1,st0
      fld qword [a%]
      fld qword [s32%]
      fmulp st1,st0
      faddp st1,st0
      fld qword [C12%]
      fmulp st1,st0
      fld qword [thr%]
      fmulp st1,st0         \Middle y term left On stack here
      
      fld qword [s12%]
      fld qword [C2%]
      fmulp st1,st0         \First y term left here
      
      fld qword [s42%]
      fld qword [C1%]
      fmulp st1,st0         \Third y term left here
      
      faddp st1,st0
      faddp st1,st0         \Add all three Together
      fistp dword [y%]       \Calculate y term
      
      ret
      ]
      endproc