Something with particles

[FellippeHeitor]

Here's something with particles.

Code: QB64: [Select]

1. TYPE VERTEX
2.     x AS SINGLE
3.     y AS SINGLE
4.     xv AS SINGLE
5.     xa AS SINGLE
6.     yv AS SINGLE
7.     ya AS SINGLE
8.     life AS SINGLE
9.     stepToTake AS INTEGER
10. END TYPE
11.  
12. DIM particle(1000) AS VERTEX, m AS INTEGER
13. DIM SHARED click AS VERTEX
14.  
15. SCREEN _NEWIMAGE(800, 600, 32)
16. _FONT 8
17. _PRINTMODE _KEEPBACKGROUND
18. RANDOMIZE TIMER
19.  
20. DO
21.     WHILE _MOUSEINPUT: WEND
22.  
23.     IF _MOUSEBUTTON(1) THEN
24.         click.x = _MOUSEX
25.         click.y = _MOUSEY
26.     END IF
27.  
28.     CLS
29.     show particle()
30.     _DISPLAY
31.     _LIMIT 60
32. LOOP
33.  
34. SUB show (particles() AS VERTEX)
35.     DIM i AS LONG, this AS VERTEX
36.     DIM r AS SINGLE
37.  
38.     FOR i = 1 TO UBOUND(particles)
39.         this = particles(i)
40.         CircleFill this.x, this.y, map(this.life, 0, 255, 1, 2), _RGB32(255, this.life)
41.         this.life = this.life + this.stepToTake
42.  
43.         this.xv = this.xv + this.xa
44.         this.yv = this.yv + this.ya
45.         this.x = this.x + this.xv
46.         this.y = this.y + this.yv
47.  
48.         IF this.life > 255 THEN
49.             this.stepToTake = this.stepToTake * -1
50.         ELSEIF this.life <= 0 THEN
51.             this.x = RND * _WIDTH
52.             this.y = RND * _HEIGHT
53.             this.xv = 0
54.             this.yv = 0
55.             this.xa = 0
56.             this.ya = 0
57.             this.stepToTake = RND * 3
58.         END IF
59.  
60.         CIRCLE (_MOUSEX, _MOUSEY), 30, _RGB32(255, 139, 0)
61.  
62.         IF click.x > 0 AND click.y > 0 AND dist(click.x, click.y, this.x, this.y) < 15 THEN
63.             r = RND * 5
64.             this.xa = COS(r)
65.             this.ya = SIN(r)
66.         END IF
67.         particles(i) = this
68.     NEXT
69.  
70.     click.x = 0
71.     click.y = 0
72. END SUB
73.  
74. FUNCTION dist! (x1!, y1!, x2!, y2!)
75.     dist! = _HYPOT((x2! - x1!), (y2! - y1!))
76. END FUNCTION
77.  
78. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
79.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
80. END FUNCTION
81.  
82. SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
83.     x0 = R
84.     y0 = 0
85.     e = 0
86.     DO WHILE y0 < x0
87.         IF e <= 0 THEN
88.             y0 = y0 + 1
89.             LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
90.             LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
91.             e = e + 2 * y0
92.         ELSE
93.             LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
94.             LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
95.             x0 = x0 - 1
96.             e = e - 2 * x0
97.         END IF
98.     LOOP
99.     LINE (x - R, y)-(x + R, y), C, BF
100. END SUB
101.  

@v: if I make e = -R, small circles become squares.

[johnno56]

Line #40 CircleFill this.x, this.y, map(this.life, 0, 255, 1, 2), _RGB32(255, this.life) is missing the third colour parameter... Threw in a zero just to get it running.... Very cool effect. Are you going to give it a name?

J

[bplus]

Hi Johnno

_RGB32 has been updated to handle more options see reply#8 here:
https://www.qb64.org/forum/index.php?topic=304.msg2558#msg2558

in the case above it is same as _rgba32(255, 255, 255,(and alpha setting) this.life)

[johnno56]

I only put in the zero because the program died because of the wrong number of parameters...

[FellippeHeitor]

My bad. I forgot to mention I used the latest development build.

Instead of adding in a 0, do as bplus indicated:_RGBA32(255, 255, 255, this.life)

[FellippeHeitor]

Very cool effect. Are you going to give it a name?

J

I wish I could remember what I started writing this for... Then naming it would be easier.

Did you guys click around?

[johnno56]

As a rule I do not use development builds. The times that I had, in the majority of cases, they ran fine... I prefer 'fine'. But thank you for pointing the version you are using. Thought I was going nuts... well... more than usual anyway... lol

Clicking around? Pfft... When I see, what looks like ANY kind of 'sight' on the screen, my trigger finger kicks into 'auto gunner' and the rest is as they say, history.... Bwahahaha....

[bplus]

Very cool effect. Are you going to give it a name?

J

I wish I could remember what I started writing this for... Then naming it would be easier.

Did you guys click around?

Yes, I clicked around, I held my mouse button down and swirled it around, and it reminded me of the futility of dusting.

[FellippeHeitor]

That's a good name! The Futility of Star Dusting maybe.

[FellippeHeitor]

As a rule I do not use development builds. The times that I had, in the majority of cases, they ran fine... I prefer 'fine'. But thank you for pointing the version you are using. Thought I was going nuts... well... more than usual anyway... lol

Since qb64 isn't "installed" but rather "unpacked", should you wanna give it a try and help beta test it it'd be a matter of, again, unpacking to a new folder. But to each their own.

Clicking around? Pfft... When I see, what looks like ANY kind of 'sight' on the screen, my trigger finger kicks into 'auto gunner' and the rest is as they say, history.... Bwahahaha....

[johnno56]

"as a rule" was used deliberately. But, after all, aren't rules meant to be bent, broken or destroyed?

"Unpacked" into its own directory. Loaded the 'particles' program and it ran as it should. No errors. Cool.