'===========================================================================
' Subject: XMAS SNOWFALL                     Date: 12-19-96 (21:26)       
' Author:  Woody Pope                        Code: QB, QBasic, PDS        
' Origin:  comp.lang.basic.misc            Packet: GRAPHICS.ABC
'===========================================================================
'Here's a QBASIC program I whipped up for your Xmas Cheer, enjoy!

' XSNOW by Woody Pope (c) 1996
'May be freely copied for nonprofit

DECLARE SUB windmove (mydata AS ANY)
DECLARE SUB putit (mydata AS ANY, x%)
DECLARE SUB moveit (mydata AS ANY)
DIM tree%(2900)
DIM moon%(2800)
DIM moonblnk%(1000)
DIM santa1%(1600)
DIM santa2%(1600)
DIM SHARED flake%(18)
DIM SHARED blank%(18, 10)
DIM SHARED maxsnow%
DIM x%, z%, wind%, s%, m%, v%, n%, st%
DIM santaflg%, santaph%, repeatflg%
DIM SHARED d%
RANDOMIZE TIMER

TYPE fdata
 xpos AS INTEGER
 hilimit AS INTEGER
 lolimit AS INTEGER
 ypos AS INTEGER
 ftype AS SINGLE
 offset AS INTEGER
END TYPE

DIM sflake(0 TO 9)  AS fdata
maxsnow% = 470

sflake(0).offset = 32
sflake(0).xpos = 32
sflake(0).hilimit = 57
sflake(0).lolimit = 0
sflake(0).ypos = 25
sflake(0).ftype = 1

sflake(1).offset = 96
sflake(1).xpos = 96
sflake(1).hilimit = 121
sflake(1).lolimit = 64
sflake(1).ypos = 360
sflake(1).ftype = 0

sflake(2).offset = 160
sflake(2).xpos = 160
sflake(2).hilimit = 185
sflake(2).lolimit = 128
sflake(2).ypos = 100
sflake(2).ftype = 1

sflake(3).offset = 224
sflake(3).xpos = 224
sflake(3).hilimit = 249
sflake(3).lolimit = 192
sflake(3).ypos = 275
sflake(3).ftype = 0

sflake(4).offset = 288
sflake(4).xpos = 288
sflake(4).hilimit = 313
sflake(4).lolimit = 256
sflake(4).ypos = 0
sflake(4).ftype = 1

sflake(5).offset = 340
sflake(5).xpos = 340
sflake(5).hilimit = 377
sflake(5).lolimit = 320
sflake(5).ypos = 400
sflake(5).ftype = 0

sflake(6).offset = 416
sflake(6).xpos = 416
sflake(6).hilimit = 441
sflake(6).lolimit = 384
sflake(6).ypos = 75
sflake(6).ftype = 1

sflake(7).offset = 480
sflake(7).xpos = 480
sflake(7).hilimit = 505
sflake(7).lolimit = 448
sflake(7).ypos = 27
sflake(7).ftype = 0

sflake(8).offset = 544
sflake(8).xpos = 544
sflake(8).hilimit = 569
sflake(8).lolimit = 512
sflake(8).ypos = 60
sflake(8).ftype = 1

sflake(9).offset = 608
sflake(9).xpos = 608
sflake(9).hilimit = 631
sflake(9).lolimit = 576
sflake(9).ypos = 150
sflake(9).ftype = 0


SCREEN 12
GOSUB clrblack
GOSUB flake
GET (0, 0)-(6, 7), flake%
'draw santa
GOSUB clrblack
GOSUB santa




'get moon
GOSUB clrblue
CIRCLE (52, 48), 48, 3, , , 1
PAINT (50, 50), 3, 3
GET (0, 0)-(100, 100), moon%
GET (0, 30)-(100, 55), moonblnk%
m% = 100
n% = 220


GOSUB clrblue
GOSUB tree
GET (0, 0)-(100, 110), tree%

GOSUB clrblue
'set trees
  PUT (100, 364), tree%, PSET
  PUT (288, 364), tree%, PSET
  PUT (433, 364), tree%, PSET

  PUT (m%, n%), moon%, PSET
'set snowy ground
s% = 476
LINE (0, s%)-(639, 479), 15, BF
counter% = 2500
z% = 1
wind% = 0
santaflg% = 0
repeatflg% = 0
santaph% = 0
st% = 0
COLOR 4
LOCATE 2, 22
PRINT "MERRY CHRISTMAS AND A HAPPY NEW YEAR!"
DRAW "bm200,20 c1 p1,4"
COLOR 15

'main loop
mylp:
'adjust snow height
counter% = counter% - 1
IF (counter% = 2500 / 2 OR counter% = 0) THEN
  wind% = 1: santaflg% = 1: repeatflg% = 1
  v% = 100 + INT(RND * 100)
  IF RND < .5 THEN d% = 1 ELSE d% = 0
END IF
IF counter% = 0 THEN
 IF maxsnow% > 400 THEN
   maxsnow% = maxsnow% - 2
   s% = s% - 2
   LINE (0, s%)-(639, s% + 2), 15, BF
 END IF
 counter% = 2500
END IF

'put flakes
FOR x% = 0 TO 9
 CALL putit(sflake(x%), x%)
NEXT x%

'move santa
IF santaflg% = 1 AND repeatflg% = 1 THEN
 IF santaph% = 0 THEN
  PUT (m%, n% + 30), moonblnk%, PSET
  PUT ((m% - 100) + st%, n% + 30), santa1%, AND
  santaph% = 1
 ELSE
  PUT (m%, n% + 30), moonblnk%, PSET
  PUT ((m% - 100) + st%, n% + 30), santa2%, AND
  santaph% = 0
 END IF
  st% = st% + 4
  IF st% > 200 THEN st% = 0: santaph% = 0: santaflg% = 0: repeatflg% = 0
  savecnt% = counter%
END IF
repeatflg% = 0
IF savecnt% >= 10 THEN
  IF (savecnt% - 10) = counter% THEN repeatflg% = 1
  ELSE
  savecnt% = 2500 - 10
END IF

IF wind% = 1 THEN
 FOR x% = 0 TO 9
  PUT (sflake(x%).xpos, sflake(x%).ypos), blank%(0, x%), PSET
  CALL windmove(sflake(x%))
 NEXT x%
  IF counter% = (1250 - v%) OR counter% = (2500 - v%) THEN
    wind% = 0
    IF m% < 300 THEN
     m% = m% + 2
     n% = n% - 1
     PUT (m%, n%), moon%, PSET
    END IF
  END IF
ELSE
'clear flakes & move to next pos
 FOR x% = 0 TO 9
  IF sflake(x%).ypos >= maxsnow% THEN
    sflake(x%).ypos = 0
    sflake(x%).xpos = sflake(x%).offset + (RND * 5)
    IF RND > .5 THEN
      sflake(x%).ftype = 1
    ELSE
       sflake(x%).ftype = 0
    END IF
  ELSE
    PUT (sflake(x%).xpos, sflake(x%).ypos), blank%(0, x%), PSET
  END IF
  CALL moveit(sflake(x%))
 NEXT x%
END IF


'check keys for exit
a$ = INKEY$
IF a$ = "" THEN GOTO mylp
END

flake:
DRAW "c15 bm3,4 nh3 nu3 ne3 nr3 nf3 nd3 ng3 nl3"
RETURN

clrblue:
DRAW "bm0,0"
DRAW "p1,5"
RETURN

clrblack:
DRAW "bm0,0"
DRAW "p0,5"
RETURN

tree:
DRAW "c2 bm50,0 m30,30 m40,30 m15,60 m30,60 m0,100 m100,100 m70,60 m85,60 m60,30 m70,30 m50,0 bm50,2 p2,2"
DRAW "c6 bm45,101 m55,101 m55,110 m45,110 m45,101 bm48,104 p6,6"
RETURN

santa:
LINE (0, 0)-(200, 25), 15, BF
DRAW "c1 bm5,12 m10,14 m20,14 m22,12 m20,9 m28,12 m27,14 m32,17 m34,17 m36,14 m41,14 m41,16 m38,16 m36,24 m0,24 m0,22 m5,22 m5,12"
DRAW "bm10,17 p1,1"
deer$ = "m+2,-2 m-2,-2 m+2,-2 m+2,+2 r20 m-4,-4 r2 nh3 ne3 r4 nh3 ne3 r2 m-4,+4 d4 m-4,+4 l16 m-4,-4"
DRAW "bm60,16" + deer$ + "bm+24,-6 p1,1 bm -20,+6 p1,1"
DRAW "bm105,16" + deer$ + "bm+24,-6 p1,1 bm -20,+6 p1,1"
DRAW "bm150,16" + deer$ + "bm+24,-6 p1,1 bm -20,+6 p1,1"
'draw legs
DRAW "bm64,20 m-4,+4 bm80,20 m+4,+4"
DRAW "bm109,20 m-4,+4 bm125,20 m+4,+4"
DRAW "bm154,20 m-4,+4 bm170,20 m+4,+4"
'draw reins
DRAW "bm41,14 m60,16"
DRAW "bm84,12 m105,16"
DRAW "bm129,12 m150,16"
GET (0, 0)-(200, 25), santa1%
LINE (60, 20)-(174, 24), 15, BF
'draw legs
DRAW "c1 bm64,20 m+4,+4 bm80,20 m-4,+4"
DRAW "bm109,20 m+4,+4 bm125,20 m-4,+4"
DRAW "bm154,20 m+4,+4 bm170,20 m-4,+4"
GET (0, 0)-(200, 25), santa2%
RETURN

SUB moveit (mydata AS fdata)
 
 IF mydata.ftype = 1 THEN
   mydata.ypos = mydata.ypos + 1

 ELSE
   mydata.ypos = mydata.ypos + 2

 END IF
 IF RND > .5 THEN
  mydata.xpos = mydata.xpos + (RND * 3)
  IF mydata.xpos > mydata.hilimit THEN mydata.xpos = mydata.hilimit
 ELSE
  mydata.xpos = mydata.xpos - (RND * 3)
  IF mydata.xpos < mydata.lolimit THEN mydata.xpos = mydata.lolimit
 END IF
END SUB

SUB putit (mydata AS fdata, x%)
  GET (mydata.xpos, mydata.ypos)-(mydata.xpos + 6, mydata.ypos + 7), blank%(0, x%)
  PUT (mydata.xpos, mydata.ypos), flake%, OR
END SUB

'
SUB windmove (mydata AS fdata)
 IF d% = 1 THEN
   mydata.xpos = mydata.xpos + 5
   IF mydata.xpos >= 631 THEN mydata.xpos = 0
 ELSE
   mydata.xpos = mydata.xpos - 5
   IF mydata.xpos <= 0 THEN mydata.xpos = 630
 END IF
END SUB