rem FireWorks II ...... Rev 2.0
      rem A J Tooth // May 2007
      
      rem ===================================================================
      on error if (err=17) then quit
      *FLOAT 64
      install @lib$+"MyUtils.bbc"
      rem ===================================================================
      
      rem Initial Setup
      proc_setup(Xs%,Ys%)
      
      rem Parameters
      proc_param
      
      *REFRESH OFF
      repeat
        rem Set origin and base colour
        proc_setpars
        
        for Cnt%=0 to 50
          rem Star Burst
          proc_Fire(Cnt%)
          
        next Cnt%
        
        rem Plot points in correct sequence
        proc_Pltt(XY(),Num%,Pts%)
        
        a$=inkey$(1)
      until a$<>""
      
      *REFRESH ON
      proc_event(a$,b&)
      if (b&=4 or a$=" ") then run else quit
      quit
      rem End of Program =================================================
      rem ================================================================
      
      rem Initial Setup
      def proc_setup(return xs%,return ys%)
      
      proc_fullscreen(xscreen%,yscreen%)
      
      xs%=xscreen% : ys%=yscreen% : rem Origin placement
      
      origin xs%,ys%
      
      endproc
      rem ================================================================
      
      rem Parameters
      def proc_param
      
      rem Universal variables
      Vmax=150.0   : rem Initial velocity [m/s]
      Th%=60   : rem Launch angle [degrees]
      X0=0.0   : rem Initial x-position
      Y0=0.0   : rem Initial y-position
      g=9.81   : rem Acceleration due to gravity [m/s/s]
      Lam=0.07 : rem Strength of drag
      Max=0.9  : rem Mass [kg]
      dt=0.02  : rem Time step [s]
      Tlm=5.0  : rem Time limit [s]
      Xd=30.0  : rem X-scale [m]
      Yd=30.0  : rem Y-scale [m]
      Fg&=0    : rem Flag for major colour
      Num%=50  : rem Number of stars in burst
      
      Pts%=int(Tlm/dt)
      dim XY(Num%,Pts%,1)
      
      endproc
      rem ================================================================
      
      rem Set origin and base colour
      def proc_setpars
      
      Xs%=rnd(2*xscreen%) : Ys%=rnd(2*yscreen%)
      origin Xs%,Ys%
      
      Fg&+=1 : if Fg&>3 then Fg&=1
      case Fg& of
        when 1: Rd&=230+rnd(25) : Gr&=rnd(255) : Bl&=rnd(255)
        when 2: Rd&=rnd(255) : Gr&=230+rnd(25) : Bl&=rnd(255)
        when 3: Rd&=rnd(255) : Gr&=rnd(255) : Bl&=230+rnd(25)
      endcase
      endproc
      rem ================================================================
      
      rem Fire the Gun
      def proc_Fire(cnt%)
      local a%
      
      x0=X0 : y0=Y0
      V=Vmax*rnd(1) : Th%=360*rnd(1) : M=0.1+Max*rnd(1)
      xdot0=V*cos(rad(Th%)) : ydot0=V*sin(rad(Th%))
      w=Lam/M
      Tim=0.0
      
      for a%=1 to Pts%
        
        cx1=-dt*w*xdot0*sqr(xdot0*xdot0 + ydot0*ydot0)
        cy1=-dt*(w*ydot0*sqr(xdot0*xdot0 + ydot0*ydot0)+g)
        
        xdot11=xdot0+cx1 : ydot11=ydot0+cy1
        
        cx2=-dt*w*xdot11*sqr(xdot11*xdot11 + ydot11*ydot11)
        cy2=-dt*(w*ydot11*sqr(xdot11*xdot11 + ydot11*ydot11)+g)
        
        xdot1=xdot0 + (cx1+cx2)/2
        ydot1=ydot0 + (cy1+cy2)/2
        
        x1=x0 + xdot1*dt
        y1=y0 + ydot1*dt
        
        XY(cnt%,a%,0)=x1
        XY(cnt%,a%,1)=y1
        
        x0=x1 : y0=y1 : xdot0=xdot1 : ydot0=ydot1
        Tim+=dt
      next a%
      
      endproc
      rem ================================================================
      
      rem Plot a point
      def proc_Pltt(XY(),num%,pts%)
      local Xp%,Yp%,a%,b%,c&
      
      for a%=1 to pts%
        fac=1-0.75*a%/pts%
        R&=int(fac*Rd&) : G&=int(fac*Gr&) : B&=int(fac*Bl&)
        
        rem Plot the points
        proc_points(XY(),num%,0,R&,G&,B&)
        
        *REFRESH
        
        if a%>3 then
          for c&=1 to 3
            if c&<3 then
              fac=fac/1.1
              R&=int(fac*Rd&) : G&=int(fac*Gr&) : B&=int(fac*Bl&)
            else
              R&=0 : G&=0 : B&=0
            endif
            rem Plot the points
            proc_points(XY(),num%,c&,R&,G&,B&)
          next c&
        endif
      next a%
      
      rem a$=get$
      endproc
      rem ================================================================
      
      rem Plot the points
      def proc_points(XY(),num%,f&,R&,G&,B&)
      local b%,k&
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      
      for b%=1 to num%
        
        xl=XY(b%,a%-1-f&,0) : yl=XY(b%,a%-1-f&,1)
        xn=XY(b%,a%-f&,0) : yn=XY(b%,a%-f&,1)
        
        Xl%=int(xl*xscreen%/Xd)
        Yl%=int(yl*yscreen%/Yd)
        
        Xn%=int(xn*xscreen%/Xd)
        Yn%=int(yn*yscreen%/Yd)
        for k&=0 to 9 step 3
          fak=fac*k&/9
          Rt&=int(fak*R&) : Gt&=int(fak*G&) : Bt&=int(fak*B&)
          colour 3,Rt&,Gt&,Bt& : gcol 3
          @vdu%!248=12-k&
          move Xl%,Yl% : draw Xn%,Yn%
        next k&
      next b%
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      endproc
      rem ================================================================