سورس کد بارش برف کد توسط:Bob Seguin در December 1998 ایمیل:BOBSEG@Sympatico.ca
کد:
TYPE FlakeType
x AS INTEGER
y AS INTEGER
Speed AS INTEGER
BkGrnd AS INTEGER
END TYPE
TYPE SpeckType
x AS INTEGER
y AS INTEGER
END TYPE
DIM Flakes(1 TO 120) AS FlakeType 'An array in which the x and y
'coordinates of each snowflake
'are stored, along with the color
'of the background pixel the flake is
'about to overdraw; also, its speed
'of descent. (120, 4-part elements).
'Textural specks and ice reflections are drawn initially to make the
'picture more interesting. After a good deal of the landscape becomes
'snow-covered, these specks are erased to permit snow to land there, since
'snow will not remain on the speck colors. As the coordinates for the
'randomly-located specks are established, they are stored in the following
'arrays for later use when erasing.
DIM TreeSpecks(1 TO 5000) AS SpeckType
DIM IceSpecks(1 TO 5000) AS SpeckType
DIM PineSpecks(1 TO 5000) AS SpeckType
'Speed variations to create perspective
FOR Reps = 1 TO 120
SELECT CASE Reps
CASE IS < 30
Flakes(Reps).Speed = 3 'Background snow
CASE 30 TO 80
Flakes(Reps).Speed = 5 'Mid-ground snow
CASE IS > 80
Flakes(Reps).Speed = 8 'Foreground snow
END SELECT
NEXT Reps
DIM ColorARRAY&(31) '0 to 15 used initially to mask drawing process and
'print title screen; 16 to 21 for specialized palette.
'Set all colors in ColorArray 0 - 15 to midnight blue
FOR Set = 0 TO 15
ColorARRAY&(Set) = 786432
NEXT Set
'Set two of the first 16 ColorArray colors to values used for opening screen
ColorARRAY&(2) = 4137248 'Color used in title: Lavender
ColorARRAY&(15) = 4144959 'Color used for "one moment please...": White
'Specialized palette colors in ColorArray 16 to 31
ColorARRAY&(16) = 786432 'Midnight blue (00)
ColorARRAY&(17) = 1446152 'Ice blue (01)
ColorARRAY&(18) = 2304 'Deep green (02)
ColorARRAY&(19) = 63 'Bright red (03)
ColorARRAY&(20) = 1248530 'Violet gray (04)
ColorARRAY&(21) = 16128 'Bright green (05)
ColorARRAY&(22) = 1716287 'Window glow yellow (06)
ColorARRAY&(23) = 3682604 'Snow blue (07)
ColorARRAY&(24) = 1118485 'Warm gray (08)
ColorARRAY&(25) = 787720 'Warm dark gray (09)
ColorARRAY&(26) = 1024 'Midnight green (10)
ColorARRAY&(27) = 3022880 'Background snow (11)
ColorARRAY&(28) = 4133900 'Bright blue (12)
ColorARRAY&(29) = 983040 'Horizon blue (13)
ColorARRAY&(30) = 3946809 'Snow white (14)
ColorARRAY&(31) = 4144959 'Snowflake white (15)
DEFINT A-Z 'Define all variables as INTEGER (to speed things up)
SCREEN 12 'Set screen mode to VGA: 640 x 480 pixels, 16 colors.
_FULLSCREEN
'If you would like to watch the winter scene being drawn, change
'the 0 in the following PALETTE USING statement to 16
'PALETTE USING ColorARRAY&(0) 'All midnight blue, except for two
'DRAWING OF WINTER LANDSCAPE COMMENCES:
'SKY DIVISION BETWEEN NIGHT SKY AND GLOW FROM THE CITY
CIRCLE (480, 2300), 2060, 13 'Huge circle, the center of which is
'somewhere down by your right knee.
PAINT (400, 400), 13 'Paint area below arc in lighter shade
'of midnight blue.
'HILL RANGE BEYOND THE TOWN WITH LIGHTS
PSET (0, 300), 0 'Position cursor and set pen color to 0: midnight blue.
DRAW "M+100,-20M+200,+10M+30,-10M+100,+10M+20,-5M+60,+10M+100,-5R40"
PAINT (5, 475), 0 'Paint the area below the hill range midnight blue.
'AT RANDOM...
'Many of the drawing procedures involve random numbers.
'Naturally, not all of the results are workable in that
'you will get trees located such that they completely
'obliterate important background detail. On the other
'hand, you want the kind of "unpredictability" that can
'only come from a random placement of trees, branches, etc..
'In order to get the best of both worlds (Forrest Gump),
'I tried many different "seed" numbers for the random
'number generator. If zero had worked, I could have
'left this line out completely, but it didn't. "65432"
'fortunately, gave me the look I wanted.
RANDOMIZE 65432
FOR Reps = 1 TO 80
x = FIX(RND * 640) 'Placement of extreme background
y = FIX(RND * 12) + 295 'city lights done at random in a
PSET (x + 10, y - 5), 3 'defined area in red and light blue.
PSET (x + 20, y), 7
NEXT Reps
'REDDISH OFFICE TOWER WITH SOME OF ITS LIGHTS ON
LINE (413, 230)-(458, 340), 4, BF 'Vertical rectangle.
FOR x = 421 TO 452 STEP 6
FOR y = 240 TO 320 STEP 4
OnOff = INT(RND * 2) + 1 'With "OnOff" (random) not all lights on.
IF OnOff = 2 THEN PSET (x, y), 6
NEXT y
NEXT x
'Antenna and flashing lights
LINE (436, 200)-(436, 229), 0 'Antenna
PSET (436, 203), 3 '<
PSET (436, 204), 3 '< These antenna lights blink (see Updates sub routine)
PSET (436, 213), 3 '<
PSET (436, 214), 3 '<
LINE (413, 230)-(458, 230), 11
'WARM-GRAY OFFICE BUILDING WITH SOME OF ITS LIGHTS ON
LINE (460, 280)-(506, 319), 8, BF 'Vertical rectangle; different color.
LINE (460, 283)-(506, 283), 4
LINE (460, 320)-(506, 330), 4, BF
FOR x = 466 TO 506 STEP 6
FOR y = 286 TO 340 STEP 4
OnOff = INT(RND * 2) + 1
IF OnOff = 1 THEN PSET (x, y), 6
NEXT y
NEXT x
'Roof lights and antenna
PSET (468, 272), 3
PSET (498, 272), 3
LINE (483, 246)-(483, 279), 10, B
PSET (483, 250), 12
PSET (483, 251), 12
LINE (460, 280)-(506, 280), 11
'School beyond church
LINE (120, 322)-(182, 346), 4, BF
FOR x = 125 TO 170 STEP 5
LINE (x, 326)-(x + 3, 335), 13, BF
NEXT x
LINE (120, 330)-(182, 330), 4, BF
'CITY SKYLINE IN MID-BACKGROUND (building shapes)
PSET (550, 342), 9 'Locate cursor for DRAW command and set pen color
DRAW "U20H24G24L10D5L42U5R5H10L10U8L3D8L10U10R2U2L10U10R2U2L20U5L5D5L5U20D10"
DRAW "L10D2R2D10L20U5L5D10L20D10L20U30L20U10L20D36L20"
DRAW "U8L12U6M-8,-40M-8,+40D6L44D49R370"
PAINT (548, 338), 9
LINE (0, 336)-(639, 420), 9, BF
'Partially hidden building
LINE (320, 306)-(353, 320), 4, BF
FOR x = 322 TO 348 STEP 6
LINE (x, 310)-(x + 1, 312), 13, BF 'Windows
NEXT x
'Cathedral spire
FOR x = 181 TO 249 STEP 17
LINE (x, 289)-(x, 293), 8
PSET (x, 289), 11
NEXT x
LINE (226, 283)-(240, 283), 0
LINE (225, 283)-(233, 248), 8
LINE (233, 237)-(233, 253), 4
CIRCLE (233, 241), 1, 4
'House window lights
LINE (363, 312)-(365, 318), 6, BF
LINE (363, 316)-(365, 316), 9
LINE (368, 344)-(372, 350), 6, BF
LINE (367, 349)-(372, 349), 9
LINE (376, 344)-(376, 350), 9
'Office buildings lights
FOR x = 278 TO 311 STEP 5
FOR y = 280 TO 340 STEP 8
OnOff = INT(RND * 3) + 1
IF OnOff = 1 THEN LINE (x, y)-(x, y + 1), 6
NEXT y
NEXT x
'Church lights
FOR x = 192 TO 242 STEP 10
LINE (x, 316)-(x + 2, 326), 6, BF
PSET (x, 316), 9
PSET (x + 2, 316), 9
NEXT x
LINE (192, 324)-(242, 324), 9
LINE (190, 319)-(244, 319), 9
'Create stained-glass effect in top panes of church windows
FOR x = 193 TO 243 STEP 10
PAINT (x, 317), 12, 9
PSET (x, 316), 7
PSET (x, 317), 3
PSET (x, 318), 5
NEXT x
'Christmas lights on house
FOR x = 381 TO 413 STEP 4
Set = Set + 1
IF Set MOD 2 = 0 THEN Clr = 12 ELSE Clr = 3
PSET (x, 296), Clr
PSET (x, 320), Clr
PSET (x - 28, 340), Clr
IF x < 408 THEN PSET (x - 28, 306), Clr
NEXT x
'Street lights
y = 316
FOR x = 111 TO 171 STEP 15
y = y - 1
LINE (x - 3, y - 4)-(x - 3, 320), 11 'Lamp posts
CIRCLE (x, y), 1, 7 'Lights
PSET (x, y), 14
NEXT x
'RANDOM CITY LIGHTS
FOR Reps = 1 TO 60
x = FIX(RND * 440)
y = FIX(RND * 20)
WhichColor = INT(RND * 3) + 1 'Colors chosen at random
SELECT CASE WhichColor
CASE 1
PSET (x + 210, 320 - y), 5 'Bright green
CASE 2
PSET (x + 210, 320 - y), 3 'Bright red
CASE 3
PSET (x + 210, 320 - y), 14 'White
END SELECT
NEXT Reps
PSET (405, 305), 9 'Erase badly located light
'SNOW ON ROOFTOPS
'Angled house on right
LINE (550, 322)-(526, 298), 11
LINE (550, 323)-(526, 299), 11
LINE (550, 324)-(526, 300), 11
FOR x = 490 TO 502
LINE (x, 322)-(x + 24, 298), 11
NEXT x
LINE (526, 299)-(502, 323), 11
LINE (526, 300)-(502, 324), 11
'Victorian house - center right
LINE (415, 294)-(416, 340), 9, BF
LINE (376, 288)-(419, 293), 11, BF
LINE (418, 288)-(419, 293), 4
LINE (419, 288)-(420, 293), 4
LINE (391, 280)-(397, 280), 11
LINE (352, 298)-(377, 304), 11, BF
LINE (417, 298)-(425, 304), 11, BF
LINE (423, 298)-(425, 304), 4
LINE (424, 298)-(426, 304), 4
'Tip of pine tree against roof snow
PSET (416, 304), 10
DRAW "M+2,-5M+2,+5L4"
PAINT (418, 302), 10
LINE (324, 320)-(352, 323), 11, BF
CIRCLE (324, 320), 3, 9
PAINT (325, 321), 9
LINE (356, 328)-(420, 338), 11, BF
LINE (273, 265)-(292, 265), 11
LINE (294, 275)-(313, 275), 11
LINE (120, 322)-(180, 322), 11
'Snow on church roof and spire
'and definition of bell louvres
LINE (180, 293)-(253, 312), 11, BF
LINE (250, 293)-(253, 312), 13
LINE (250, 293)-(253, 293), 13
LINE (253, 293)-(253, 312), 13
PAINT (252, 294), 13
LINE (226, 283)-(240, 304), 9, BF
PSET (233, 240), 7
LINE (231, 292)-(235, 300), 8, B
LINE (231, 292)-(231, 290), 8
LINE (235, 292)-(235, 290), 8
LINE (232, 289)-(232, 287), 8
LINE (234, 289)-(234, 287), 8
PSET (233, 286), 8
LINE (231, 294)-(235, 294), 8
LINE (231, 296)-(235, 296), 8
LINE (231, 298)-(235, 298), 8
'DRAW EVERGREEN TREE LINE
FOR Reps = 1 TO 90
PineX = FIX(RND * 640) + 20
TreeHeight = INT(RND * 40) + 1
PineY = 338 - TreeHeight
GOSUB Pinetree 'Sub routine draws pine tree: random x location and height.
NEXT Reps
'Heavier tree grouping at left of screen (limited x range)
FOR Reps = 1 TO 20
PineX = FIX(RND * 120)
TreeHeight = INT(RND * 40) + 1
PineY = 315 - TreeHeight 'Tree height range raised slightly
GOSUB Pinetree
NEXT Reps
'Texturing on pine trees
FOR Reps = 1 TO 3600
x = FIX(RND * 640)
y = INT(RND * 120) + 275
IF POINT(x, y) = 10 THEN
PSET (x, y), 4
TSpeck = TSpeck + 1
TreeSpecks(TSpeck).x = x 'Store coordinates for later
TreeSpecks(TSpeck).y = y ' " " " "
END IF
NEXT Reps
'Vary baselines of pines
FOR Reps = 1 TO 20
x = INT(RND * 620) + 1
y = INT(RND * 2) + 395
LINE (x, y)-(x + 40, y), 7
NEXT Reps
'HARDWOOD TREES IN BACKGROUND WITH BRANCHES
'A narrow strip of snow which will backdrop the bases of the tree trunks
LINE (0, 395)-(639, 402), 14, BF
LINE (0, 395)-(639, 396), 11, BF
'A series of faint tree shadows on the strip of snow. (To draw shadows to
'directly correspond to the trees when they are drawn, produces only a solid
'band instead of the more natural-looking, light scattering that this method
'produces).
FOR Reps = 1 TO 30
x = FIX(RND * 640) 'Full x width, 0 - 639
y = INT(RND * 3) + 397 'Limited y depth, 397 to 399
ShadowLength = INT(RND * 30) + 1
LINE (x, y)-(x + ShadowLength, y), 7
NEXT Reps
RANDOMIZE 11 'A new random number seed is "planted" to "influence growth".
'The location of 80 trees (1) is established at random (2): 0 to 639 x.
'Next, a height of 20 to 80 pixels is randomly determined (3).
'The trunk is then drawn at the x coordinate from a base line of 398 y
'minus Scatter (4). (Scatter aids the perspective by placing the bottom of
'the tree trunks at slightly varying levels). Color: 4 (gray-lavender).
FOR Reps = 1 TO 80 '(1)
x = FIX(RND * 640) '(2)
Height = INT(RND * 60) + 21 '(3)
Scatter = INT(RND * 3) '(4) 'Generates number 0 to 2
LINE (x, 400 - Scatter)-(x, 400 - Height), 4
'Next, we determine an appropriate number of branches for the tree given
'the formula of 1 branch for every 6 pixels of height (5).
'The lengths of these branches are determined randomly (6). The height
'of the branches is next determined to be from 25% to 100% of the
'tree's height (7). The direction the branch grows (left or right) is
'the final randomly-established factor (8).
FOR n = 1 TO Height STEP 6 '(5)
Twig = INT(RND * 15) + 1 '(6) '1 to 15 pixels long
TrunkHeight = Height * .2 '(7)
TwigHeight = INT(RND * (Height * .8)) + TrunkHeight
WhichWay = INT(RND * 2) '(8) '0 or 1
'Finally, the branch is drawn left or right (9), both as a quarter of a
'circle curving upwards, and as a 45-degree upward line on the opposing
'side of the tree. In the case of the quarter-circle, the branch length
'is used as a radius and the branch height is used as its center. The
'branches are drawn in either color 8 (gray-brown) or 4 (gray-lavender)
'by random choice (TwigClr: Color 8, the color which attracts background
'snow, is favoured 2 to 1).
TwigClr = INT(RND * 3)
IF TwigClr = 0 THEN TwigClr = 4 ELSE TwigClr = 8
SELECT CASE WhichWay '(9)
CASE 0 'Right
IF 398 - TwigHeight < 382 THEN 'Keeps branches off the ground
CIRCLE (x, 398 - TwigHeight), Twig, 8, 3.14159, 4.8
END IF
LINE (x, 398 - TwigHeight)-(x + Twig, 398 - TwigHeight - Twig), TwigClr
CASE 1 'Left
IF 398 - TwigHeight < 382 THEN 'Keeps branches off the ground
CIRCLE (x, 398 - TwigHeight), Twig, 8, 4.71, 6.283
END IF
IF x <> 327 AND (398 - TwigHeight) < 324 THEN 'Unworkable branch
LINE (x, 398 - TwigHeight)-(x - Twig, 398 - TwigHeight - Twig), TwigClr
END IF
END SELECT
NEXT n 'Loop which draws branches on individual trees ends here.
NEXT Reps 'Tree drawing loop ends after 80 trees drawn.
'House window lights
LINE (524, 313)-(528, 318), 6, BF
LINE (526, 313)-(526, 318), 9
LINE (391, 306)-(395, 316), 6, BF
LINE (401, 306)-(405, 316), 6, BF
PSET (391, 306), 9
PSET (395, 306), 9
PSET (401, 306), 9
PSET (405, 306), 9
LINE (391, 313)-(408, 313), 9
LINE (379, 298)-(386, 316), 9, BF
'FOREGROUND ICE AND SNOW
'Band of snow
LINE (0, 400)-(639, 422), 7, BF
LINE (0, 401)-(639, 414), 14, BF
'Frozen pond
LINE (0, 421)-(639, 421), 1
LINE (0, 423)-(639, 423), 1
LINE (0, 424)-(639, 479), 1, BF
'Snowy peninsula
CIRCLE (734, 440), 400, 7, , , .05
PAINT (634, 440), 7
'Next 3 code lines define highlight on peninsula
CIRCLE (734, 440), 400, 14, 0, 3.7, .05
CIRCLE (780, 446), 390, 14, 0, 3.28, .07
PAINT (340, 440), 14
'Snowdrift in left foreground
CIRCLE (0, 500), 300, 14, , , .2
PAINT (0, 479), 14
CIRCLE (30, 518), 300, 7, , , .2
PAINT (0, 479), 7
'Pale lavender reflections on the ice
FOR Reps = 1 TO 3000
x = FIX(RND * 640)
y = FIX(RND * 80) + 421
IF POINT(x, y) = 1 THEN
PSET (x, y), 11
ISpeck = ISpeck + 1
IceSpecks(ISpeck).x = x 'Store coordinates for later
IceSpecks(ISpeck).y = y ' " " " "
END IF
NEXT Reps
'ERASE OPENING MESSAGE
'The title "S N O W F A L L" is printed in color 2, and I am about to
'draw a pine tree in that color. If I don't change the color from lavender
'to midnight blue, you will see the pine tree being drawn in lavender.
LOCATE 15, 32
PRINT " "
LOCATE 13, 32
PRINT " "
PALETTE 2, 786432 'Change color 2 to midnight blue to mask drawing process
'Ultimately, this color will be set to dark green.
'LARGE FOREGROUND PINE TREE AT RIGHT OF SCREEN
'Draw/paint shadow under pine tree
CIRCLE (612, 422), 70, 1, , , .03
PAINT (612, 422), 1
PSET (594, 207), 2 'Locate cursor and set pen color to draw right side of tree
DRAW "M+3,+ 10M-2,-1M+4,+12M-1,-1M+3,+10M-2,-2M+9,+12M-5,-3"
DRAW "M+4,+ 10M-5,-1M+8,+12M-2,-1M+7,+10M-1,-2M+8,+12M-5,-5"
DRAW "M+3,+ 10M-4,-1M+7,+12M-3,-1M+8,+10M-2,-2M+9,+12M-5,-4"
DRAW "M+6,+ 10M-4,-1M+6,+12M-2,-1M+6,+10M-2,-2M+11,+12M-5,-4"
PSET (594, 207), 2 'Relocate cursor to top of tree to draw left side of tree
DRAW "M-3,+ 10M+2,-1M-4,+12M+1,-1M-3,+10M+2,-2M-9,+12M+5,-3"
DRAW "M-4,+ 10M+5,-1M-8,+12M+2,-1M-7,+10M+1,-2M-8,+12M+5,-5"
DRAW "M-3,+ 10M+4,-1M+10,-4M-2,+2M-7,+12M+3,-1M-8,+10M+2,-2M-9,+12M+5,-4"
DRAW "M-6,+ 10M+8,-5M-6,+12M+2,-1M-6,+10M+2,-2M-11,+12M+10,-2"
DRAW "M-3,+ 10M+2,-1M-14,+12M+10,-3M-3,+10M+2,-2M-9,+12M+5,-3"
DRAW "M-4,+ 10M+5,-1M-8,+12M+2,-1M-7,+10M+1,-2"
'Draw bottom of tree
DRAW "M-5,+5M+14,+3M-3,+3M+8,-2M+10,-4M-3,+4M+10,-2M-2,+4M+20,-2M-4,+2M+40,0"
DRAW "M-2,-2M+10,+2M-4,-3M+12,+2M-3,-2M+14,+1"
'Paint pine tree
PAINT (590, 240), 2
'Pine tree foliage shadowing
RANDOMIZE 42
FOR Reps = 1 TO 160
x = INT(RND * 100) + 539
y = INT(RND * 228) + 180
Radius = INT(RND * 20) + 1
IF POINT(x, y) = 2 THEN CIRCLE (x, y), Radius, 10, 4.3, 5.2
IF POINT(x, y) = 2 THEN CIRCLE (x, y), Radius + 1, 10, 4.4, 5.1
IF POINT(x, y) = 2 THEN CIRCLE (x, y), Radius + 2, 10, 4.5, 5
IF POINT(x, y) = 2 THEN CIRCLE (x, y), Radius + 3, 10, 4.6, 4.9
NEXT Reps
'Thin out shadows
FOR Reps = 1 TO 5000
x = INT(RND * 60) + 566
y = INT(RND * 220) + 200
IF POINT(x, y) = 10 THEN PSET (x, y), 2
NEXT Reps
LINE (590, 330)-(600, 340), 2, BF
'Some warm yellow textural specks on pine tree
FOR Reps = 1 TO 100
x = INT(RND * 120) + 520
y = INT(RND * 280) + 200
IF POINT(x, y) = 2 THEN
PSET (x, y), 6
PSpeck = PSpeck + 1
PineSpecks(PSpeck).x = x 'Store coordinates for later
PineSpecks(PSpeck).y = y ' " " " "
END IF
NEXT Reps
'Reflection of pine in ice
LINE (639, 462)-(540, 462), 2
DRAW "M+16,+8M-8,0M+9,+10"
PAINT (600, 470), 2
'Thin out reflection of pine tree to maintain ice illusion
FOR x = 509 TO 639 STEP 3
LINE (x, 458)-(x + 18, 479), 1 'Diagonal lines the color of the ice
NEXT x 'are drawn through the solid green.
LINE (600, 458)-(639, 458), 7
'Dust pine reflection with ice reflections
FOR Reps = 1 TO 74
x = INT(RND * 130) + 509
y = INT(RND * 21) + 458
IF POINT(x, y) = 1 OR POINT(x, y) = 2 THEN
PSET (x, y), 11
ISpeck = ISpeck + 1
IceSpecks(ISpeck).x = x 'These coordinates added to array using
IceSpecks(ISpeck).y = y 'ISpeck whose existing value is incremented.
END IF
NEXT Reps
'INITIALIZE VALUES
'Values used for depositing snow in the background tree lines
WoodSnow = 11
PineSnow = 10
ON TIMER(1) GOSUB UPDATES 'This causes the program to branch to the Updates
'sub routine every second.
TIMER ON 'Start timer to activate "ON TIMER" statement.
'THE SNOWFALL ITSELF COMMENCES
'Establish random starting coordinates for snowflakes as well as determine
'the background colors they are about to be drawn over in order to restore
'the background when the snowflakes are erased. Each snowflake represents
'1 pixel (picture element) in a screen grid 640 wide (x) by 480 deep (y).
'As the values are generated, they are stored in the Flakes array.
FOR n = 1 TO 120 'Total number of snowflakes
Flakes(n).x = FIX(RND * 640) 'Generates x coordinate from 0 to 639.
IF n > 30 THEN
Flakes(n).y = FIX(RND * 480) 'Foreground snow: y from 0 to 479.
ELSE
Flakes(n).y = FIX(RND * 400) 'Background snow: y from 0 to 399
END IF
Flakes(n).BkGrnd = POINT(Flakes(n).x, Flakes(n).y)
NEXT n
'SET SPECIALIZED PALETTE COLORS
'PALETTE USING ColorARRAY&(16)
RESTORE PaletteDATA
OUT &H3C8, 0
FOR n = 1 TO 48
READ Intensity
Intensity = Intensity - 10
IF Intensity < 0 THEN Intensity = 0
OUT &H3C9, Intensity
NEXT n
OUT &H3C8, 15
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
'MAIN LOOP BEGINS HERE AND WILL RUN UNTIL A KEY IS PRESSED--------------------
DO
FOR n = 1 TO 120
'Erase former snowflake position using color of background it overdrew.
IF Flakes(n).y < 120 AND Message = 0 THEN 'If not Xmas (see * below)
PSET (Flakes(n).x, Flakes(n).y), 0
ELSE
PSET (Flakes(n).x, Flakes(n).y), Flakes(n).BkGrnd
END IF
GOSUB DropFlake 'Go to subroutine to establish next position
'---------------------------------------------------------------------
'* For every day of the year but Christmas day, there is nothing above
'120y in the way of background design, hence we can draw foreground
'flakes in the quieter, more believable color 7 (light blue) and erase
'them with color 0 (midnight blue) without fear of obliterating any
'(ahem), postcard-quality images. This saves us time by not having to
'test for yet another snowflake color. On Christmas day, however, we
'have a "MERRY CHRISTMAS" message hovering in the night sky which, I
'am certain, would appreciate being treated as valid background detail.
'As a result, the quieter, untested-for color 7 is traded for the
'"testable" color 15 on this special occasion, and the background
'restored with the precise color of the message rather than the easy,
'automatic "0". What tells us there is need for this, is the "Message"
'flag, set by the Updates sub-routine whenever "Merry Christmas" is
'displayed.
'It would be possible to create a special Christmas-day-only test
'for color 7 snowflakes, of course, but as it happens, the brighter
'snowflakes look completely natural up there with the Christmas star
'shining on them. (Hey, - sometimes the good guys get a break).
'---------------------------------------------------------------------
'Draw snowflake at new position established by sub routine DropFlake:
IF n >= 30 AND Flakes(n).y < 120 THEN 'Foreground flakes above 120y
IF Message = 0 THEN 'If it ain't Christmas
PSET (Flakes(n).x, Flakes(n).y), 7 '<--- make 'em light blue
ELSE
PSET (Flakes(n).x, Flakes(n).y), 15 '<----Otherwise, white.
END IF
ELSEIF n >= 30 AND Flakes(n).y >= 120 THEN 'Foreground flakes 120+ (y)
PSET (Flakes(n).x, Flakes(n).y), 15 '<--- white
ELSE 'Background flakes
IF Flakes(n).BkGrnd = 2 THEN 'Background flakes don't fall in
'front of the pine tree, so...
PSET (Flakes(n).x, Flakes(n).y), 2 'color them pine color.
ELSE
Sparkle = FIX(RND * 100) 'One chance in a hundred of sparkling
IF Sparkle = 0 THEN
PSET (Flakes(n).x, Flakes(n).y), 15 '<--- Sparkling flake
ELSE
PSET (Flakes(n).x, Flakes(n).y), 11 '<--- Regular flake
END IF
END IF
END IF
NEXT n
'EVEN LOOPS: Snow is randomly deposited on the background trees by
'testing the area for color 8 (hardwood tree color) and for color 10
'(background pines).
'The tree pixels (if found) are colored for the first 20,000 iterations
'of the main loop in color 11 for hardwoods (a pale lavender snow
'color) and in color 10 for pines (the same color as they already are).
'Beyond 20,000 iterations, the color for the hardwoods is switched to
'7 (pale blue), and for the pines, 11 (pale lavender).
'As a result, the background area is gradually covered with snow, but
'in a manner which makes the overall effect believable to the eye.
'ODD LOOPS: Snow is added at random to the frozen pond and pine tree
'in the foreground. These help to eliminate "banding" by combining
'with the "falling" snowflakes that settle (snowflakes fall in increments
'of 3, 5 and 8 pixels and will form lines of the same spacing).
'Beyond 20,000 iterations, the main loop counter "Snow" is reset
'to zero but the colors are not altered further.
'(The reason I didn't use the "snowfall" to place snow in the background
'is that it would look unnatural for an apparent foreground snowflake
'to come to rest in an extreme background location. Moreover, the
'frequency of that occurrence would spoil the illusion of perspective,
'as would the brighter colors).
Snow = Snow + 1 'Snow is a loop counter which controls
'the color of snow deposited in the background.
IF Snow > 19999 THEN
PineSnow = 11
WoodSnow = 7
Snow = 0
END IF
IF Snow MOD 2 = 0 THEN 'Only iterations evenly divisible by 2
IF Snow MOD 4 = 0 THEN 'Loops evenly divisible by 2 and 4
SnowX = INT(RND * 575) + 1 'Area defined: hardwood trees
SnowY = INT(RND * 80) + 321
IF POINT(SnowX, SnowY) = 8 THEN PSET (SnowX, SnowY), WoodSnow
ELSE 'Leftovers evenly divisible by 2
SnowX = INT(RND * 575) + 1
SnowY = INT(RND * 120) + 280 'Area defined: pine row
IF POINT(SnowX, SnowY) = 10 THEN PSET (SnowX, SnowY), PineSnow
END IF
ELSE '(If Snow MOD 2)
'Added snow flakes on ice and large pine
'tree to "homogenize" snow dispersal
IcePineX = FIX(RND * 640)
IcePineY = INT(RND * 274) + 206 'Define area below top of pine tree
IF POINT(IcePineX, IcePineY) = 1 OR POINT(IcePineX, IcePineY) = 2 THEN
PSET (IcePineX, IcePineY), 14
END IF
END IF
_DELAY .08
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
LOOP UNTIL INKEY$ <> ""
'MAIN LOOP ENDS---------------------------------------------------------------
TIMER OFF 'TIMER SWITCHED OFF (Just good manners)
SYSTEM 'RETURN CONTROL TO THE ENVIRONMENT FROM WHICH THE PROGRAM WAS RUN
END 'A BELT and SUSPENDERS
'*********************** SUB ROUTINE SECTION BEGINS **************************
DropFlake:
'Sub routine which establishes downward movement of the snowflakes and
'determines where and whether foreground snowflakes remain on the tree or
'the ice. If they do manage to reach the bottom of the screen (or the
'bottom of the tree line for background flakes) or come to rest on tree or
'ice, they are re-started at the top of the screen with a new x coordinate.
IF Flakes(n).y < 474 THEN 'IF FLAKE NOT AT BOTTOM OF SCREEN THEN...
'(Take a deep breath, -it's a long way
'to the "ELSE"
'y coordinate established
Flakes(n).y = Flakes(n).y + Flakes(n).Speed
'x coordinate established
Drift = FIX(RND * 3) - 1 'Direction of drift generated (-1 to +1)
Flakes(n).x = Flakes(n).x + Drift
'Descent speed retarded by negative/positive Drift
IF Drift <> 0 THEN Flakes(n).y = Flakes(n).y - 1
'Because of the necessity of storing the background color of the
'pixel that the snowflake is about to be drawn on (for purposes of
'erasing the snowflake with the obliterated color), it is necessary
'to first make certain that the pixel being moved to is not itself
'a snowflake, otherwise a "trail" of snowflakes can result. Since
'snowflakes drawn in color 15 (white) are possible to test for
'(The other "white" is in fact color 14), finding them is simple.
'The background snowflake color (pale lavender: 11) is also used
'in the background drawing (Oh, for 17 colors) so sorting that out
'requires a default method.
'At this point, coordinates have been set, but the snowflake has
'not yet been drawn, so we can use these coordinates for the tests:
IF POINT(Flakes(n).x, Flakes(n).y) <> 15 AND POINT(Flakes(n).x, Flakes(n).y) <> 11 THEN
'If the pixel being moved to is NOT a snowflake, then
'assign the color of that pixel to the current flake's BkGrnd
Flakes(n).BkGrnd = POINT(Flakes(n).x, Flakes(n).y)
ELSE 'If it IS a snowflake
FOR Scan = 1 TO 120 'scan all snowflakes in the array
IF Scan = n THEN Scan = Scan + 1 'skipping the current snowflake.
IF Scan = 121 THEN EXIT FOR 'If Scan = 121 that means that
'the current snowflake was number
'120. We could just let it pass,
'but asking about element 121 in
'a 120 element array would gen-
'erate an error message. (No
'matter, it means it wasn't a
'snowflake, anyway).
'However, - with each scanned flake, we test as follows:
'When the scanned flakes' coordinates match the current snowflake's
'destination pixel, then we assign the scanned snowflake's BkGrnd
'color to the current snowflake's. To wit:
IF Flakes(n).x = Flakes(Scan).x AND Flakes(n).y = Flakes(Scan).y THEN
Flakes(n).BkGrnd = Flakes(Scan).BkGrnd
GOTO Continue 'No need to check further so move on.
END IF
NEXT Scan
'If the program has gotten to this point, it means it was testing
'for color 11 that was NOT a snowflake, hence:
Flakes(n).BkGrnd = 11
END IF
Continue:
'Background snowflakes complete their descent at bottom of tree line
IF n <= 30 AND Flakes(n).y > 399 THEN
Flakes(n).y = 0
Flakes(n).x = FIX(RND * 640)
Flakes(n).BkGrnd = 0
END IF
'HOW THE SNOW DOTH SETTLE UPON THE BRANCH...
'If the background color is either pine tree: 2, or ice: 1, then the
'snowflake is given a 1 in 12 chance of landing. If it does land,
'the flake is drawn in at the spot of landing (for the first two
'hours, plus or minus 1 to 4 pixels to further avoid "banding") and
'then sent to the top of the screen. To wit:
IF n >= 30 AND (Flakes(n).BkGrnd = 2 OR Flakes(n).BkGrnd = 1) THEN
FlakeRnd = INT(RND * 12) + 1
IF FlakeRnd = 12 THEN 'Boxcars!
IF Ticks& < 7200 THEN
FlakeSpot = FIX(RND * 9) - 4 'Number from -4 to +4
ELSE
FlakeSpot = 0
END IF
'Flakes are drawn in 14:white
'to distinguish them from falling flakes.
IF Flakes(n).BkGrnd = 1 THEN
IF TreeShadow = 1 AND Flakes(n).y < 425 AND Flakes(n).y > 413 AND Flakes(n).x > 512 THEN
'TreeShadow leaves the bottom shadow lines untouched
PSET (Flakes(n).x, Flakes(n).y), 13
ELSE
PSET (Flakes(n).x, Flakes(n).y + FlakeSpot), 14
END IF
ELSE
PSET (Flakes(n).x, Flakes(n).y + FlakeSpot), 14
END IF
'Flakes are then reset at the top of the screen
Flakes(n).y = 0
Flakes(n).x = FIX(RND * 640) 'Generates number from 0 to 639
Flakes(n).BkGrnd = 0
END IF
END IF
'Remember I told you to take a deep breath?
'FINALLY, THE ELSE!: Otherwise, a foreground flake has reached the bottom
ELSE
Flakes(n).y = 0
Flakes(n).x = FIX(RND * 640) '0 - 639
Flakes(n).BkGrnd = 0
END IF
RETURN
Pinetree:
'Sub routine draws pine trees at specified location.
'Since there are bound to be alot of pine tree shapes in the
'area to interfere with the paint process (coloring of pixels
'will stop when the painting color encounters a line drawn in
'its own color), the outline is first drawn in a color that
'has not been used in the area (0) and then painted to that
'line. This clears the tree shape of ALL color. The outline
'of the tree is then redrawn in the tree color and painted.
PSET (PineX, PineY), 0 'Set cursor position from GOSUB; pen color 0.
DRAW "M-12,+36M+4,-4M-10,+30M+1,-1M-10,+30R54M-10,-30M+2,+2M-10,-24"
DRAW "M+3,+3M-4,-3M+6,+5M-12,-36M+2,+2M-4,-9"
PAINT (PineX, PineY + 20), 0 'Paint in background color (erase area)
'The following four code lines are an exact duplicate of the preceding
'four, except that the color has been changed.
PSET (PineX, PineY), 10 'Reset cursor using tree color and redraw outline
DRAW "M-12,+36M+4,-4M-10,+30M+1,-1M-10,+30R54M-10,-30M+2,+2M-10,-24"
DRAW "M+3,+3M-4,-3M+6,+5M-12,-36M+2,+2M-4,-9"
PAINT (PineX, PineY + 20), 10 'Paint in tree color
RETURN
UpDATES:
'Sub routine that causes antenna lights to flash, erases specks, and on
'December 25th of the current year, give a Christmas message.
Ticks& = Ticks& + 1 'Seconds counter
IF Ticks& MOD 2 = 0 THEN 'If Ticks& is evenly divisible by 2, then...
PSET (436, 203), 3
PSET (436, 204), 3 'Antenna lights on
PSET (436, 213), 3
PSET (436, 214), 3
ELSE 'otherwise,
PSET (436, 203), 0
PSET (436, 204), 0 'Antenna lights off
PSET (436, 213), 0
PSET (436, 214), 0
END IF
'The following three Block IF's erase the "specks" mentioned near
'the start of the program.
IF Ticks& = 7200 THEN 'Two hours after program starts running...
FOR Speckle = 1 TO 1100 '<------.
PSET (TreeSpecks(Speckle).x, TreeSpecks(Speckle).y), 10 '
NEXT Speckle '
END IF '
'
IF Ticks& = 7201 THEN '
FOR Speckle = 1101 TO 2146 'This larger array done in two steps <--'
PSET (TreeSpecks(Speckle).x, TreeSpecks(Speckle).y), 10
NEXT Speckle
END IF
IF Ticks& = 7202 THEN
FOR Ice = 1 TO 1191
PSET (IceSpecks(Ice).x, IceSpecks(Ice).y), 1
NEXT Ice
END IF
IF Ticks& = 7203 THEN
FOR Cone = 1 TO 42
PSET (PineSpecks(Cone).x, PineSpecks(Cone).y), 2
NEXT Cone
END IF
'The shadow of the large pine tree is drawn in color 1, a color which
'attracts snow. After 2 hours, the flag "TreeShadow" is set so that
'the remaining shadow is left undisturbed (Oh, for 18 colors!)
IF Ticks& = 12000 THEN TreeShadow = 1
RETURN
PaletteDATA:
DATA 8,8,20,16,25,30,8,17,8,63,8,8,26,21,27,8,63,8,63,56,34,52,57,63,29
DATA 25,25,16,13,20,8,12,8,40,40,54,20,28,63,8,8,23,63,63,63,63,63,63
صفحه اصلی
انجمن
جستجو
فهرست اعضا
افزونه های فایرفاکس
» 
تشکر شده توسط :