QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on August 12, 2019, 02:27:16 pm

Title: Snow
Post by: SierraKen on August 12, 2019, 02:27:16 pm

I made this funky snowing program today that when they land on the hill, they slide down the hill a bit. lol I tried it with a ton of DIM commands, like the Starfields, but it used too much memory I think and slowed down after a few seconds. That's when I had the snow pile up on the mountain. This time there's no DIM commands and nothing piles up. Just something goofy. lol

Code: QB64: [Select]

1.  
2. CLS
3. SCREEN _NEWIMAGE(800, 600, 32)
4. amount = 20
5. s = .5
6. GOSUB make:
7.  
8. DO
9.  
10.     FOR t = 1 TO amount
11.         a$ = INKEY$
12.         IF a$ = CHR$(27) THEN END
13.         y = y + dy * s
14.         IF y > _HEIGHT THEN GOSUB make:
15.         IF POINT(x, y) = _RGB32(0, 255, 0) THEN
16.             dy = 1
17.             xx = x
18.             yy = y
19.             szz = sz
20.             GOSUB make:
21.         END IF
22.         CIRCLE (x, y), sz, _RGB32(255, 255, 255)
23.         IF sz < 1 THEN GOTO nopaint:
24.         PAINT (x, y), _RGB32(255, 255, 255)
25.         nopaint:
26.     NEXT t
27.     LINE (0, 0)-(800, 600), _RGB32(0, 0, 0, 30), BF
28.     _DISPLAY
29.  
30.     'Hill
31.     CIRCLE (400, 800), 600, _RGB32(0, 255, 0)
32.     PAINT (400, 590), _RGB32(0, 255, 0)
33.     FOR ttt = 1 TO 2000
34.         _LIMIT 20000
35.         RANDOMIZE TIMER
36.         l = (RND * .5) + -.25
37.         xx = xx + l
38.         RANDOMIZE TIMER
39.         l2 = (RND * .05)
40.         yy = yy + l2
41.         CIRCLE (xx, yy), szz, _RGB32(255, 255, 255)
42.         IF szz < 1 THEN GOTO nopaint2:
43.         PAINT (xx, yy), _RGB32(255, 255, 255)
44.         nopaint2:
45.     NEXT ttt
46. LOOP
47.  
48. make:
49. RANDOMIZE TIMER
50. dy = INT(RND * 10) + 4
51. RANDOMIZE TIMER
52. x = (RND * 800)
53. sz = (RND * 2)
54. y = 0
55. RETURN
56.  
57.  

Title: Re: Snow
Post by: bplus on August 12, 2019, 04:26:01 pm

Yeah, nice snow worms!

Title: Re: Snow
Post by: Petr on August 12, 2019, 05:08:03 pm

My snow:

Code: QB64: [Select]

1. TYPE Snow
2.     X AS LONG
3.     Y AS LONG
4.     dx AS SINGLE
5.     dy AS SINGLE
6. END TYPE
7.  
8. DIM SHARED S(1 TO 2000) AS Snow
9.  
10. SCREEN _NEWIMAGE(800, 600, 32)
11. SaveScreen = _NEWIMAGE(800, 600, 32)
12. 'creating one image with snow (is more fastest as if is every one draw to screen)
13. S& = _NEWIMAGE(50, 50, 32)
14. This = _DEST
15. _DEST S&
16. CLS
17. CIRCLE (25, 25), 5, &HFFFFFFFF
18. PAINT (25, 25), &HFFFFFFFF, &HFFFFFFFF
19. _DEST This
20. _CLEARCOLOR &HFF000000, S& 'clear black color in image with snow
21. CLS 'set alpha on my screen to 255
22. 'create hill on my screen:
23. CIRCLE (400, 900), 500
24. PAINT (400, 500), &HFF0FFFFF, &HFFFFFFFF
25.  
26.  
27. 'load shifts to array
28. DIM sh AS LONG
29. FOR sh = 1 TO UBOUND(s)
30.     S(sh).dx = 1 + RND * 3
31.     S(sh).dy = 1 + RND * 10
32.     IF RND * 5 > 2 THEN m = -1 ELSE m = 1
33.     S(sh).X = m * RND * 800
34.     S(sh).Y = RND * 40
35. NEXT sh
36.  
37.  
38. 'save current screen
39. _PUTIMAGE , This, SaveScreen
40. 'my loop
41. DO
42.     _PUTIMAGE , SaveScreen, This
43.     i& = 0
44.     iend& = UBOUND(s)
45.     DO UNTIL i& = iend&
46.         i& = i& + 1
47.         S(i&).X = S(i&).X + S(i&).dx
48.         S(i&).Y = S(i&).Y + S(i&).dy
49.         IF S(i&).Y > 600 THEN Restart i& 'is snow am bottom? Return it back.
50.  
51.         'hill colission detection:
52.         xy& = ((S(i&).X + 25 - 400) ^ 2) + ((S(i&).Y + 25 - 900) ^ 2) 'Pythagorean theorem, snow patircle - hill center
53.         _PUTIMAGE (S(i&).X, S(i&).Y), S& 'place snow particle
54.         IF 500 ^ 2 >= xy& THEN
55.             _PUTIMAGE (S(i&).X, S(i&).Y), S&, SaveScreen 'place snow particle to virtual screen for restoring image
56.             Restart i&
57.         END IF
58.     LOOP
59.     _DISPLAY
60.     _LIMIT 20
61. LOOP
62.  
63. SUB Restart (I AS LONG)
64.     S(I).dx = 1 + RND * 3
65.     S(I).dy = 1 + RND * 10
66.     IF RND * 5 > 2 THEN m = -1 ELSE m = 1
67.     S(I).X = m * RND * 800
68.     S(I).Y = RND * 40
69. END SUB
70.  

Title: Re: Snow
Post by: SierraKen on August 12, 2019, 05:53:20 pm

Pretty cool Petr!

Title: Re: Snow
Post by: bplus on August 12, 2019, 09:18:54 pm

I couldn't resist:

Code: QB64: [Select]

1. _TITLE "B+ NE Ohio Snow: you have got to keep an eye on the level of snow fall!"
2. 'B+ 2019-08-12 ha! I started with Petr's and changed just about everything!
3. TYPE Snow
4.     X AS LONG
5.     Y AS LONG
6.     dx AS SINGLE
7.     dy AS SINGLE
8. END TYPE
9. nflakes = 1000
10. DIM SHARED S(nflakes) AS Snow
11. SCREEN _NEWIMAGE(800, 600, 32)
12. _SCREENMOVE 300, 40
13. FOR i = 0 TO nflakes
14.     IF RND < .5 THEN r = -1 ELSE r = 1
15.     S(i).dx = r * (1 + RND * 3)
16.     S(i).dy = 1 + RND * 10
17.     S(i).X = RND * _WIDTH
18.     S(i).Y = RND * _HEIGHT * .9
19. NEXT
20. SCREEN _NEWIMAGE(800, 600, 32)
21. horizon = _HEIGHT * .9
22. DO
23.     CLS
24.     FOR i = 0 TO _HEIGHT
25.         LINE (0, i)-STEP(_WIDTH, 0), _RGB32(i / _HEIGHT * 50, 0, i / _HEIGHT * 120)
26.     NEXT
27.     d = _HEIGHT - horizon
28.     c = 1
29.     FOR i = horizon TO _HEIGHT
30.         c = c + 1
31.         LINE (0, i)-(_WIDTH, i), _RGB32(128 + c / d * 128, 128 + c / d * 128, 128 + c / d * 128), BF
32.     NEXT
33.     horizon = horizon - .3
34.     FOR i = 0 TO nflakes
35.         CIRCLE (S(i).X, S(i).Y), 1
36.         S(i).X = S(i).X + S(i).dx
37.         S(i).Y = S(i).Y + S(i).dy
38.         IF S(i).X < -25 OR S(i).X > _WIDTH + 25 THEN newFlake i
39.         IF S(i).Y > _HEIGHT THEN newFlake i
40.     NEXT
41.     _DISPLAY
42.     _LIMIT 10
43. LOOP
44.  
45. SUB newFlake (i)
46.     IF RND < .5 THEN r = -1 ELSE r = 1
47.     S(i).dx = r * (1 + RND * 3)
48.     S(i).dy = 1 + RND * 10
49.     S(i).X = RND * (_width + 100) - 50
50.     S(i).Y = -100 * RND
51. END SUB
52.  

Title: Re: Snow
Post by: SierraKen on August 12, 2019, 10:14:00 pm

LOL good job B+. I waited until the snow engulfed my entire screen. LOL

Title: Re: Snow
Post by: johnno56 on August 12, 2019, 10:26:00 pm

Bplus,

Couldn't resist either...

Modified your version with fewer flakes and different sizes...

Make me cold just looking at it... Brrr...

J

Code: QB64: [Select]

1. _TITLE "B+ NE Ohio Snow: you have got to keep an eye on the level of snow fall!"
2. 'B+ 2019-08-12 ha! I started with Petr's and changed just about everything!
3. TYPE Snow
4.     X AS LONG
5.     Y AS LONG
6.     dx AS SINGLE
7.     dy AS SINGLE
8.     size AS SINGLE
9. END TYPE
10. nflakes = 500
11. DIM SHARED S(nflakes) AS Snow
12. SCREEN _NEWIMAGE(800, 600, 32)
13. _SCREENMOVE 300, 40
14. FOR i = 0 TO nflakes
15.     IF RND < .5 THEN r = -1 ELSE r = 1
16.     S(i).dx = r * (1 + RND * 3)
17.     S(i).dy = 1 + RND * 10
18.     S(i).X = RND * _WIDTH
19.     S(i).Y = RND * _HEIGHT * .9
20.     S(i).size = RND * 3
21. NEXT
22. SCREEN _NEWIMAGE(800, 600, 32)
23. horizon = _HEIGHT * .9
24. DO
25.     CLS
26.     FOR i = 0 TO _HEIGHT
27.         LINE (0, i)-STEP(_WIDTH, 0), _RGB32(i / _HEIGHT * 50, 0, i / _HEIGHT * 120)
28.     NEXT
29.     d = _HEIGHT - horizon
30.     c = 1
31.     FOR i = horizon TO _HEIGHT
32.         c = c + 1
33.         LINE (0, i)-(_WIDTH, i), _RGB32(128 + c / d * 128, 128 + c / d * 128, 128 + c / d * 128), BF
34.     NEXT
35.     horizon = horizon - .3
36.     FOR i = 0 TO nflakes
37.         IF S(i).size > 1 THEN
38.             CIRCLE (S(i).X, S(i).Y), S(i).size
39.             PAINT (S(i).X, S(i).Y)
40.         ELSE
41.             CIRCLE (S(i).X, S(i).Y), S(i).size
42.         END IF
43.         S(i).X = S(i).X + S(i).dx
44.         S(i).Y = S(i).Y + S(i).dy
45.         IF S(i).X < -25 OR S(i).X > _WIDTH + 25 THEN newFlake i
46.         IF S(i).Y > _HEIGHT THEN newFlake i
47.     NEXT
48.     _DISPLAY
49.     _LIMIT 10
50. LOOP
51.  
52. SUB newFlake (i)
53.     IF RND < .5 THEN r = -1 ELSE r = 1
54.     S(i).dx = r * (1 + RND * 3)
55.     S(i).dy = 1 + RND * 10
56.     S(i).X = RND * (_WIDTH + 100) - 50
57.     S(i).Y = -100 * RND
58.     S(i).size = RND * 3
59. END SUB
60.  
61.  
62.  

Title: Re: Snow
Post by: bplus on August 12, 2019, 10:37:35 pm

Nice one Johnno!

Title: Re: Snow
Post by: Petr on August 13, 2019, 04:02:25 am

Small upgrade, inspired by BPlus:

Code: QB64: [Select]

1. TYPE Snow
2.     X AS LONG
3.     Y AS LONG
4.     dx AS SINGLE
5.     dy AS SINGLE
6.     oy AS LONG
7. END TYPE
8.  
9. DIM SHARED S(1 TO 2000) AS Snow
10.  
11. SCREEN _NEWIMAGE(800, 600, 32)
12. SaveScreen = _NEWIMAGE(800, 600, 32)
13. 'creating one image with snow (is more fastest as if is every one draw to screen)
14. S& = _NEWIMAGE(50, 50, 32)
15. This = _DEST
16. _DEST S&
17. CLS
18. CIRCLE (25, 25), 5, &HFFFFFFFF
19. PAINT (25, 25), &HFFFFFFFF, &HFFFFFFFF
20. _DEST This
21. _CLEARCOLOR &HFF000000, S& 'clear black color in image with snow
22. CLS 'set alpha on my screen to 255
23. 'create hill on my screen:
24. CIRCLE (400, 900), 500
25. PAINT (400, 500), &HFF0FFFFF, &HFFFFFFFF
26.  
27.  
28. 'load shifts to array
29. DIM sh AS LONG
30. FOR sh = 1 TO UBOUND(s)
31.     S(sh).dx = 1 + RND * 3
32.     S(sh).dy = 1 + RND * 10
33.     IF RND * 5 > 2 THEN m = -1 ELSE m = 1
34.     S(sh).X = m * RND * 800
35.     S(sh).Y = RND * 40
36. NEXT sh
37.  
38.  
39. 'save current screen
40. _PUTIMAGE , This, SaveScreen
41. 'my loop
42. DO
43.     _PUTIMAGE , SaveScreen, This
44.     i& = 0
45.     iend& = UBOUND(s)
46.     DO UNTIL i& = iend&
47.         i& = i& + 1
48.         S(i&).X = S(i&).X + S(i&).dx
49.         S(i&).Y = S(i&).Y + S(i&).dy + S(i&).oy
50.         IF S(i&).Y > 600 THEN Restart i& 'is snow am bottom? Return it back.
51.  
52.         'hill colission detection:
53.         xy& = ((S(i&).X + 25 - 400) ^ 2) + ((S(i&).Y + 25 + S(i&).oy - 900) ^ 2) 'Pythagorean theorem, snow patircle - hill center
54.         _PUTIMAGE (S(i&).X, S(i&).Y), S& 'place snow particle
55.         IF 500 ^ 2 >= xy& THEN
56.             _PUTIMAGE (S(i&).X, S(i&).Y), S&, SaveScreen 'place snow particle to virtual screen for restoring image
57.             S(i&).oy = S(i&).oy + 2
58.             Restart i&
59.         END IF
60.     LOOP
61.     _DISPLAY
62.     _LIMIT 20
63. LOOP
64.  
65. SUB Restart (I AS LONG)
66.     S(I).dx = 1 + RND * 3
67.     S(I).dy = 1 + RND * 10
68.     IF RND * 5 > 2 THEN m = -1 ELSE m = 1
69.     S(I).X = m * RND * 800
70.     S(I).Y = RND * 40
71. END SUB
72.  

:)

Title: Re: Snow
Post by: bplus on August 13, 2019, 10:56:51 am

Small upgrade inspired by all!

Code: QB64: [Select]

1. _TITLE "Snow by Ken, Petr, Bplus and Johnno "
2. TYPE Snow
3.     X AS LONG
4.     Y AS LONG
5.     dx AS SINGLE
6.     dy AS SINGLE
7.     sz AS INTEGER
8.     oy AS LONG
9. END TYPE
10.  
11. DIM SHARED S(1 TO 2000) AS Snow
12.  
13. SCREEN _NEWIMAGE(800, 720, 32)
14. _SCREENMOVE 300, 10
15.  
16. 'create hill on my screen:
17. FOR i = 0 TO _HEIGHT
18.     LINE (0, i)-STEP(_WIDTH, 0), _RGBA32(i / _HEIGHT * 120 + 40, 0, i / _HEIGHT * 180 + 40, 180)
19. NEXT
20. fcirc 400, _HEIGHT + 300, 500, &HFFBBCCDD
21. SaveScreen = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
22. 'save current screen
23. _PUTIMAGE , 0, SaveScreen
24.  
25. 'load shifts to array
26. DIM sh AS LONG
27. FOR sh = 1 TO UBOUND(s)
28.     S(sh).dx = 1 + RND * 3
29.     S(sh).dy = 1 + RND * 10
30.     IF RND * 5 > 2 THEN m = -1 ELSE m = 1
31.     S(sh).X = m * RND * 800
32.     S(sh).Y = RND * _HEIGHT
33.     IF sh < 1500 THEN
34.         S(sh).sz = 1
35.     ELSEIF sh < 1750 THEN
36.         S(sh).sz = 2
37.     ELSEIF sh < 1875 THEN
38.         S(sh).sz = 3
39.     ELSEIF sh < 1970 THEN
40.         S(sh).sz = 4
41.     ELSE
42.         S(sh).sz = 5
43.     END IF
44.     xy& = ((S(sh).X - 400) ^ 2) + ((S(sh).Y + S(sh).oy - (_HEIGHT + 300)) ^ 2) 'Pythagorean theorem, snow patircle - hill center
45.     IF 500 ^ 2 >= xy& THEN
46.         Restart sh
47.     END IF
48. NEXT sh
49.  
50. 'my loop
51. DO
52.     _PUTIMAGE , SaveScreen, 0
53.     i& = 0
54.     iend& = UBOUND(s)
55.     DO UNTIL i& = iend&
56.         i& = i& + 1
57.         S(i&).X = S(i&).X + S(i&).dx
58.         S(i&).Y = S(i&).Y + S(i&).dy + S(i&).oy
59.         IF S(i&).Y > _HEIGHT THEN Restart i& 'is snow am bottom? Return it back.
60.  
61.         'hill colission detection:
62.         xy& = ((S(i&).X - 400) ^ 2) + ((S(i&).Y + S(i&).oy - (_HEIGHT + 300)) ^ 2) 'Pythagorean theorem, snow patircle - hill center
63.         fcirc S(i&).X, S(i&).Y, S(i&).sz, &HFFFFFFFF
64.         IF S(i&).sz > 1 THEN PAINT (S(i&).X, S(i&).Y)
65.         IF 500 ^ 2 >= xy& THEN
66.             _DEST SaveScreen
67.             fcirc S(i&).X, S(i&).Y, S(i&).sz, &HFFFFFFFF
68.             _DEST 0
69.             S(i&).oy = S(i&).oy + 2
70.             Restart i&
71.         END IF
72.     LOOP
73.     _DISPLAY
74.     _LIMIT 20
75. LOOP
76.  
77. SUB Restart (I AS LONG)
78.     S(I).dx = 1 + RND * 3
79.     S(I).dy = 1 + RND * 10
80.     IF RND * 5 > 2 THEN m = -1 ELSE m = 1
81.     S(I).X = m * RND * 800
82.     S(I).Y = -RND * 100
83. END SUB
84.  
85. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
86.     DIM Radius AS INTEGER, RadiusError AS INTEGER
87.     DIM X AS INTEGER, Y AS INTEGER
88.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
89.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
90.     LINE (CX - X, CY)-(CX + X, CY), C, BF
91.     WHILE X > Y
92.         RadiusError = RadiusError + Y * 2 + 1
93.         IF RadiusError >= 0 THEN
94.             IF X <> Y + 1 THEN
95.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
96.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
97.             END IF
98.             X = X - 1
99.             RadiusError = RadiusError - X * 2
100.         END IF
101.         Y = Y + 1
102.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
103.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
104.     WEND
105. END SUB
106.  

Title: Re: Snow
Post by: johnno56 on August 13, 2019, 11:29:08 am

Nice improvement... I only have one question. Where did you find the image of the top of my head? lol

Title: Re: Snow
Post by: SierraKen on August 13, 2019, 12:39:16 pm

That's awesome B+! I will have to study it soon to see how it doesn't slow down.

Title: Re: Snow
Post by: Jack002 on August 16, 2019, 10:52:48 am

Very cool animation! I love it. So all you guys collaborated to make this? Super. I love it. Team players on the forum. forum made programs. What a great idea.

Title: Re: Snow
Post by: bplus on August 16, 2019, 12:50:48 pm

Quote from: Jack002 on August 16, 2019, 10:52:48 am

Very cool animation! I love it. So all you guys collaborated to make this? Super. I love it. Team players on the forum. forum made programs. What a great idea.

+1

Text Only | Text with Attachments