'===========================================================================
' Subject: FAST SNOW FALL ROUTINE            Date: 08-28-97 (13:59)       
' Author:  Danny Beardsley                   Code: QB, QBasic, PDS        
' Origin:  beards@dnai.com                 Packet: GRAPHICS.ABC
'===========================================================================
SCREEN 13
CLS
DEFINT A-Z
'init the palette
FOR I = 1 TO 60
  OUT &H3C8, I
  OUT &H3C9, I / 2 + 33
  OUT &H3C9, I / 2 + 33
  OUT &H3C9, I / 2 + 33
NEXT I

NUMFLK = 1000      'Number of flakes

'Define the snow flake variable type
TYPE snfk
  X AS INTEGER
  Y AS INTEGER
  C AS INTEGER
END TYPE

'-                                         -
'Draw what you want the snow to fall on here
COLOR 64
LOCATE 15, 15: PRINT "ESC to exit"
LOCATE 16, 9: PRINT "Any key to clear screen"
'-                                         -

'Dimension the snow flake array
DIM FLK(NUMFLK) AS snfk

'Init the flakes pos and speed
FOR I = 1 TO NUMFLK
  FLK(I).X = RND * 320
  FLK(I).Y = -4000
  FLK(I).C = RND * 50 + 50
NEXT I

'Move the flakes a little so they're not so bunched up
FOR REP = 1 TO 80
  FOR I = 1 TO NUMFLK
    FLK(I).Y = FLK(I).Y + FLK(I).C
  NEXT I
NEXT REP

TIM! = TIMER
'Do the snow
DO
CNT = CNT + 1
RANDOMIZE TIMER
FOR I = 1 TO NUMFLK

  MVD = 0         'Set up the
  OY = FLK(I).Y '
  OX = FLK(I).X '
  OC = FLK(I).C 'temporary   (not array is faster)
  TC = OC         '
  TY = OY         '
  TX = OX         'variables
  TYH = TY \ 100  'Set another variable

  IF POINT(TX, TYH + 1) <> 0 AND TY > 2000 THEN 'Check if the current pixel is filled
    MVD = 2
    IF POINT(TX - 1, TYH + 1) = 0 THEN                       'how about the down & left pixel?
      IF POINT(TX - 1, TYH) = 0 THEN TX = TX - 1: MVD = 1    'no so move the pixel there
    ELSEIF POINT(TX + 1, TYH + 1) = 0 THEN                   'how about the down & right pixel?
      IF POINT(TX + 1, TYH) = 0 THEN TX = TX + 1: MVD = 1    'no so move the pixel there
    END IF
  END IF

  IF MVD = 2 THEN       'If the flake cant move then put it on the top
    FLK(I).X = RND * 320
    FLK(I).Y = 100
    FLK(I).C = RND * 50 + 50
    GOTO 1
  END IF

  TY = TY + TC    'Increment the flake vertically

  PSET (OX, TYH), 0                 'Erase the flake
  PSET (TX, TY \ 100), TC - 40         'Draw the flake

  FLK(I).X = TX                        ' Put the flake
  FLK(I).Y = TY                        '   where its
  FLK(I).C = TC                        'supposed to be
1
NEXT I
A$ = INKEY$
IF A$ = CHR$(27) THEN EXIT DO
IF A$ <> "" THEN CLS
LOOP
SCREEN 12
PRINT CNT / (TIMER - TIM!)
DO
LOOP UNTIL INKEY$ = ""
PRINT "FAST SNOW ROUTINE BY DANNY BEARDSLEY (made in QB4.5)"
PRINT "COMPILE ME! 2 TIMES FASTER"
PRINT "COMPILE ME! 2 TIMES FASTER"
PRINT "COMPILE ME! 2 TIMES FASTER"
PRINT "________________________________________________________"
PRINT "This is a fast snow routine in 320X200 with 1000 flakes!"
PRINT "    If you COMPILE it will be !!!2 times faster!!!!"
PRINT "    I think that every variablle here is an integer"
PRINT "  If you want more code for other amazing feats then>"
PRINT "--------------------------------------------------------"
PRINT "Email:       dsb@cyberdude.com"
PRINT "Homepage:    www.dnai.com/~beards"
PRINT "FREEWARE (just put my name in somewhere if you use it {:-)"
SLEEP

END