rem Shooting Stars........ Rev 4.0
      rem A J Tooth // October 2004
      rem Assembler Version with Screen Dimming - Revised 30th December 2006
      on error if (err=17) then quit
      
      himem=lomem + 100000000
      *FLOAT64
      
      rem Setup
      proc_setup
      
      *REFRESH OFF
      repeat
        
        rem Parameter Selection for each new object
        proc_params
        
        rem Sequence of fading "star" patterns
        proc_fadstar
        
        rem Dim the screen
        proc_dimmer
        
        a$=inkey$(0) : rem Permits interruption of the program.
      until (a$<>"")
      
      *REFRESH ON
      a$=get$
      quit
      end
      rem End of Program +++++++++++++++++++++++++++++++++
      
      rem PROCEDURES
      rem--------------------------------------------------
      
      rem Setup
      def proc_setup
      
      rem Call Utility Procedures
      proc_fullscreen(xscreen%,yscreen%)  :  rem Set up use of Full Screen
      
      rem Preamble
      dim Cen%(100,2)
      dim Dimm% 1000
      
      xmax%=2*xscreen% : ymax%=2*yscreen%
      RM%=500 : LmM&=10
      dim PreVer%(LmM&,2)
      
      wlim%=((xscreen%*3+3)and-4)
      lgth%=wlim%*yscreen% + 54
      dim pic% lgth%
      
      rem OSCLI command strings
      command1$=" SCREENSAVE temp.bmp 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
      command2$=" LOAD "+"temp.bmp "+str$~pic%
      command3$="MDISPLAY "+str$~pic%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_Dimm(pass&)
      next pass&
      endproc
      rem--------------------------------------------------
      
      rem Set up use of Full Screen
      def proc_fullscreen(return xscreen%, return yscreen%)
      
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      rem--------------------------------------------------
      
      rem Parameter Selection for each new object
      def proc_params
      
      Cen%(0,1)=rnd(xmax%) : Cen%(0,2)=rnd(ymax%) : rem Reset Origin
      TrM&=0 : Lm&=2+rnd(LmM&-3)                  : rem Select vertices between 3 to 10
      Ang%=rnd(360)-1  : AnR=rad(Ang%)            : rem Direction of movement
      Rot=(2*rnd(1))-1 : Rot=rad(Rot)             : rem Rate of rotation -1<angle<1 degree.
      Sc=5+5*rnd(1)                               : rem Scale factor for rate of movement
      Xinc=Sc*cos(AnR) : Yinc=Sc*sin(AnR)         : rem Increment in direction of movement
      re&=100+rnd(155) : gr&=100+rnd(155) : bl&=100+rnd(155) : rem Random colour
      R%=50+rnd(RM%-50)                           : rem Random radius from 50 to 300
      endproc
      rem--------------------------------------------------
      
      rem Sequence of fading "star" patterns
      def proc_fadstar
      
      repeat
        rem Entire "star" pattern
        for Tr&=0 to TrM& step 2
          origin Cen%(Tr&,1),Cen%(Tr&,2)
          rem Need an offset (Fx%,Fy%) in order to draw a solid triangle between
          rem the current and previous position of the same vertex
          rem because the origin has moved in the meantime.
          if Tr&>0 then
            Fx%=Cen%(Tr&-2,1)-Cen%(Tr&,1)
            Fy%=Cen%(Tr&-2,2)-Cen%(Tr&,2)
          endif
          rem Colour fading
          Fac=(1+Tr&)/(1+TrM&)
          colour 10,int(Fac*re&),int(Fac*gr&),int(Fac*bl&) : gcol 10
          
          rem Vertices
          for a&=0 to (Lm&-1)
            rem Calculate plot positions for vertices
            Angle=Tr&*Rot+(2*pi*a&/Lm&)
            x=R%*cos(Angle)
            y=R%*sin(Angle)
            sx%=sgn(x) : sy%=sgn(y)
            x%=sx%*abs(int(x)) : y%=sy%*abs(int(y))
            
            rem Only draw a triangle if Tr&>0
            if Tr&>0 then
              move PreVer%(a&,1)+Fx%,PreVer%(a&,2)+Fy%
              move 0,0
              plot 85,x%,y%
            else
              move 0,0 : draw x%,y%
            endif
            rem Reset "previous" vertex position
            PreVer%(a&,1)=x% : PreVer%(a&,2)=y%
          next a&
        next Tr&
        *REFRESH
        rem Calculate and store next origin
        if TrM&<100 then
          TrM&+=2
          Cen%(TrM&,1)=Cen%(0,1)+int(TrM&*Xinc)
          Cen%(TrM&,2)=Cen%(0,2)+int(TrM&*Yinc)
        endif
      until TrM&=100
      endproc
      rem--------------------------------------------------
      
      rem Dim the screen
      def proc_dimmer
      
      vdu 26
      oscli command1$
      oscli command2$
      
      rem Dims the entire Screen
      call Dimm%
      
      sys "SetStretchBltMode", @memhdc%, 3
      oscli command3$
      *REFRESH
      
      endproc
      rem--------------------------------------------------
      
      rem Assembly Language Routine for Screen Dimming
      def proc_Dimm(opt&)
      P%=Dimm%
      [opt opt&
      
      mov edx,0
      mov [^y%],edx
      
      .yloop
      mov edx,0
      mov [^x%],edx
      
      .xloop
      mov eax,[^y%]
      imul eax,[^wlim%]
      add eax,[^x%]
      add eax,[^x%]
      add eax,[^x%]
      add eax,54
      
      mov cl,pic%[eax]
      mov bl,cl
      shr cl,4
      sub bl,cl
      mov pic%[eax],bl
      mov cl,pic%[eax+1]
      mov bl,cl
      shr cl,4
      sub bl,cl
      mov pic%[eax+1],bl
      mov cl,pic%[eax+2]
      mov bl,cl
      shr cl,4
      sub bl,cl
      mov pic%[eax+2],bl
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[^xscreen%]
      jl near xloop
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[^yscreen%]
      jl near yloop
      
      ret
      ]
      endproc
      rem--------------------------------------------------