'===========================================================================
' Subject: SNOW ENGINE                       Date: 12-25-99 (20:50)       
' Author:  Jernej Simoncic                   Code: QB, QBasic, PDS        
' Origin:  jernej.simoncic@guest.arnes.si  Packet: GRAPHICS.ABC
'===========================================================================
' Winter - a snow demo with a nice image :)
'
' Programmed by Jernej Simoncic
' jernej.simoncic@guest.arnes.si
' ICQ: 26266467
'
' Use the snow 'engine' freely, just give me a credit!
'

DECLARE SUB Winter ()
DECLARE SUB SetPal (Attr%, Red%, Green%, Blue%)
DECLARE SUB DefSnow (S AS ANY, YPos AS INTEGER)
CONST NumSnow = 200
TYPE Snow
  X AS INTEGER
  y AS SINGLE
  oX AS INTEGER
  oY AS SINGLE
  mY AS SINGLE
  mX AS INTEGER
  Amp AS INTEGER
  sX AS SINGLE
  Col AS INTEGER
END TYPE

RANDOMIZE TIMER

DIM Snow(NumSnow) AS Snow

FOR i% = 0 TO NumSnow
  DefSnow Snow(i%), 190
NEXT

SCREEN 13

Winter  'Draw image

FOR i% = 0 TO 15
  SetPal i% + 32, 0, i% * (63 / 15), 0
  SetPal i% + 48, 63, i% * (63 / 15), i% * (63 / 15)
NEXT
FOR i% = 1 TO 16
  SetPal i% + 239, i% * (40 / 16) + 23, i% * (40 / 16) + 23, i% * (40 / 16) + 23
NEXT
SetPal 100, 63, 31, 0
SetPal 101, 47, 31, 0

r1! = 25
g1! = 13
b1! = 0
r2! = 37
g2! = 24
b2! = 12
r! = (r2! - r1!) / 16
g! = (g2! - g1!) / 16
B! = (b2! - b1!) / 16
FOR i% = 0 TO 15
  SetPal i% + 64, (r1!), (g1!), (b1!)
  r1! = r1! + r!
  g1! = g1! + g!
  b1! = b1! + B!
NEXT

DO
  FOR i% = 0 TO NumSnow
    Snow(i%).y = Snow(i%).y + Snow(i%).mY

    Snow(i%).mX = SIN(Snow(i%).y * Snow(i%).sX) * Snow(i%).Amp - Snow(i%).Amp \ 2

    PSET (Snow(i%).oX, Snow(i%).oY), 0

    pnt% = POINT(Snow(i%).X + Snow(i%).mX, Snow(i%).y)
    IF pnt% < 0 THEN pnt% = 0
    IF pnt% THEN
      IF RND AND 1 THEN n% = 1 ELSE n% = -1
      p% = POINT(Snow(i%).X + Snow(i%).mX + n%, Snow(i%).y)
      IF p% = 0 THEN
        m% = n%
      ELSE
        p% = POINT(Snow(i%).X + Snow(i%).mX - n%, Snow(i%).y)
        IF p% = 0 THEN
          m% = -n%
        ELSE
          m% = 0
          FOR j% = 0 TO 3
            IF POINT(Snow(i%).X + Snow(i%).mX, Snow(i%).y - j%) = 0 THEN
              PSET (Snow(i%).X + Snow(i%).mX, Snow(i%).y - j%), Snow(i%).Col
              EXIT FOR
            END IF
          NEXT
          DefSnow Snow(i%), 10
        END IF
      END IF
      Snow(i%).X = Snow(i%).X + m%
    END IF

    IF INT(Snow(i%).y) >= 199 THEN
      PSET (Snow(i%).X + Snow(i%).mX, 199), Snow(i%).Col
      DefSnow Snow(i%), 10
    END IF

    PSET (Snow(i%).X + Snow(i%).mX, Snow(i%).y), Snow(i%).Col

    Snow(i%).oX = Snow(i%).X + Snow(i%).mX
    Snow(i%).oY = Snow(i%).y
  NEXT
  WAIT &H3DA, 8
  WAIT &H3DA, 8, 8
LOOP WHILE INKEY$ = ""

'Make the snow fall down before quitting

DO
  FOR i% = 0 TO NumSnow
    Snow(i%).y = Snow(i%).y + Snow(i%).mY

    Snow(i%).mX = SIN(Snow(i%).y * Snow(i%).sX) * Snow(i%).Amp - Snow(i%).Amp \ 2

    PSET (Snow(i%).oX, Snow(i%).oY), 0

    pnt% = POINT(Snow(i%).X + Snow(i%).mX, Snow(i%).y)
    IF pnt% < 0 THEN pnt% = 0
    IF pnt% THEN
      IF RND AND 1 THEN n% = 1 ELSE n% = -1
      p% = POINT(Snow(i%).X + Snow(i%).mX + n%, Snow(i%).y)
      IF p% = 0 THEN
        m% = n%
      ELSE
        p% = POINT(Snow(i%).X + Snow(i%).mX - n%, Snow(i%).y)
        IF p% = 0 THEN
          m% = -n%
        ELSE
          m% = 0
          FOR j% = 0 TO 3
            IF POINT(Snow(i%).X + Snow(i%).mX, Snow(i%).y - j%) = 0 THEN
              PSET (Snow(i%).X + Snow(i%).mX, Snow(i%).y - j%), Snow(i%).Col
              EXIT FOR
            END IF
          NEXT
          Snow(i%).X = 400
        END IF
      END IF
      Snow(i%).X = Snow(i%).X + m%
    END IF

    IF INT(Snow(i%).y) >= 199 THEN
      PSET (Snow(i%).X + Snow(i%).mX, 199), Snow(i%).Col
      Snow(i%).X = 400
    END IF

    PSET (Snow(i%).X + Snow(i%).mX, Snow(i%).y), Snow(i%).Col

    Snow(i%).oX = Snow(i%).X + Snow(i%).mX
    Snow(i%).oY = Snow(i%).y
  NEXT
  WAIT &H3DA, 8
  WAIT &H3DA, 8, 8
  n% = 0
  FOR i% = 0 TO NumSnow
    IF Snow(i%).X <> 400 THEN
      n% = -1
      EXIT FOR
    END IF
  NEXT
  IF n% = 0 THEN EXIT DO
LOOP UNTIL INKEY$ = CHR$(27)

SUB DefSnow (S AS Snow, YPos AS INTEGER)
  S.X = INT(RND * 320)
  S.y = -RND * YPos - 10
  S.mY = RND / 2 + .5
  S.Amp = INT(RND * 12) + 8
  S.sX = RND / 8
  S.Col = INT(RND * 16) + 240
END SUB

DEFINT A-Z
SUB SetPal (Attr%, Red%, Green%, Blue%)
  OUT &H3C7, Attr%
  OUT &H3C8, Attr%
  OUT &H3C9, Red%
  OUT &H3C9, Green%
  OUT &H3C9, Blue%
END SUB

DEFSNG A-Z
SUB Winter

FOR i% = 0 TO 4
  LINE (50 + i% \ 3, 50)-(50 + i% - 2, 169), i% * (15 / 4) + 64
  LINE (90 + i% \ 3, 60)-(90 + i% - 2, 173), i% * (15 / 4) + 64
NEXT

FOR i% = 0 TO 5
  LINE (150 + i% \ 3, 70)-(150 + i% - 2, 189), i% * (15 / 5) + 64
NEXT

LINE (0, 180)-(50, 170), 240
LINE -(125, 175), 240
LINE -(170, 183), 240
LINE -(200, 177), 240
LINE -(230, 175), 240
LINE -(290, 169), 240
LINE -(319, 173), 240
PAINT (0, 199), 240
CIRCLE (220, 166), 12, 240
PAINT (220, 166), 240
CIRCLE (220, 148), 10, 240
PAINT (220, 148), 240
CIRCLE (220, 134), 8, 240
PAINT (220, 134), 240
LINE (200, 140)-(205, 176), 74
FOR i% = 0 TO 10 STEP 3
  IF i% >= 5 THEN n% = 1 ELSE n% = 0
  LINE (195 + i%, 133 - n%)-(201, 143), 64
NEXT
LINE (216, 129)-(224, 123), 48, BF
LINE (216, 129)-(216, 123), 4
PSET (215, 129), 4
PSET (225, 129), 51
PSET (216, 123), 0
FOR i% = 0 TO 1
  LINE (220 + i%, 129)-(220 + i%, 123), 52 + i% * 4
NEXT
FOR i% = 0 TO 2
  LINE (222 + i%, 129)-(222 + i%, 123), 62 - i% * 4
NEXT
PSET (224, 123), 0
CIRCLE (217, 132), 1, 0
CIRCLE (223, 132), 1, 0
CIRCLE (205, 148), 7, 240, , , .38
CIRCLE (235, 148), 7, 240, , , .38
PAINT (205, 148), 240
PAINT (235, 148), 240
CIRCLE (220, 134), 1, 101
PSET (220, 134), 100
CIRCLE (220, 134), 5, 0, 230 * 3.14 / 180, 310 * 3.14 / 180
FOR X% = 0 TO 319
  FOR y% = 127 TO 199
    IF POINT(X%, y%) >= 240 THEN
      PSET (X%, y%), INT(RND * 16) + 240
    END IF
  NEXT
NEXT

PSET (217, 132), 240
PSET (223, 132), 240

X! = 0
n! = 28 / 90
FOR y% = 140 TO 50 STEP -1
  X! = X! + n!
  IF RND * 5 > 2 THEN
    LINE (20 + X!, y% + RND * 2)-(50, y% - RND * 2), INT(RND * 8) + 40
  END IF
  IF RND * 5 > 2 THEN
    LINE (80 - X!, y% + RND * 2)-(50, y% - RND * 2), INT(RND * 8) + 40
  END IF
NEXT

X! = 0
n! = 18 / 90
FOR y% = 150 TO 60 STEP -1
  X! = X! + n!
  IF RND * 5 > 2 THEN
    LINE (70 + X!, y% + RND * 2)-(90, y% - RND * 2), INT(RND * 8) + 40
  END IF
  IF RND * 5 > 2 THEN
    LINE (110 - X!, y% + RND * 2)-(90, y% - RND * 2), INT(RND * 8) + 40
  END IF
NEXT

X! = 0
n! = 28 / 90
FOR y% = 160 TO 70 STEP -1
  X! = X! + n!
  IF RND * 5 > 2 THEN
    LINE (120 + X!, y% + RND * 2)-(150, y% - RND * 2), INT(RND * 8) + 40
  END IF
  IF RND * 5 > 2 THEN
    LINE (180 - X!, y% + RND * 2)-(150, y% - RND * 2), INT(RND * 8) + 40
  END IF
NEXT
END SUB