QB64.org Forum

Active Forums => Programs => Topic started by: bplus on October 29, 2019, 05:37:57 pm

Title: Spiral Colored Balls
Post by: bplus on October 29, 2019, 05:37:57 pm

Happy Diwali, time to give your CPU a workout ;-))

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Spiral Colored Balls" 'B+ 2019-10-29 mod from
3. ' 2019-10-29 mod be able to draw these balls anywhere
4. ' Rotate colors on a sphere.txt for JB v2.0 bplus 2018-04-16
5. ' from (extremely simplified) Double spiral.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-28
6.  
7. CONST xmax = 1200, ymax = 700, pi = _PI, nBalls = 5, ww = 3.14159 / 2, gravity = 2
8. TYPE ball
9.     x AS SINGLE
10.     y AS SINGLE
11.     a AS SINGLE
12.     dx AS SINGLE
13.     dy AS SINGLE
14.     sc AS SINGLE
15.     pr AS SINGLE
16.     pg AS SINGLE
17.     pb AS SINGLE
18.     pn AS SINGLE
19. END TYPE
20.  
21. DIM SHARED b(1 TO nBalls) AS ball
22.  
23. SCREEN _NEWIMAGE(xmax, ymax, 32)
24. _SCREENMOVE 100, 20 'this fits my screen yours may be different
25. RANDOMIZE TIMER
26.  
27. DIM i AS INTEGER, j AS INTEGER, b AS INTEGER, power, sky AS LONG
28.  
29. FOR i = 1 TO nBalls
30.     newBall i
31. NEXT
32. sky = _NEWIMAGE(xmax, ymax, 32)
33. _DEST sky&
34. FOR i = 0 TO ymax
35.     LINE (0, i)-(xmax, i), _RGB32(100 + i / ymax * 40, 100 + i / ymax * 50, 160 + i / ymax * 95)
36. NEXT
37. _DEST 0
38. WHILE _KEYDOWN(27) = 0
39.     _PUTIMAGE , sky&, 0
40.     FOR i = 1 TO nBalls
41.         'ready for collision
42.         b(i).a = _ATAN2(b(i).dy, b(i).dx)
43.         power = (b(i).dx ^ 2 + b(i).dy ^ 2) ^ .5
44.         FOR j = i + 1 TO nBalls
45.             IF SQR((b(i).x - b(j).x) ^ 2 + (b(i).y - b(j).y) ^ 2) < 200 * (b(i).sc + b(j).sc) THEN
46.                 b(i).a = _ATAN2(b(i).y - b(j).y, b(i).x - b(j).x)
47.                 b(j).a = _ATAN2(b(j).y - b(i).y, b(j).x - b(i).x)
48.                 EXIT FOR
49.             END IF
50.         NEXT
51.         b(i).dx = power * COS(b(i).a)
52.         b(i).dy = power * SIN(b(i).a)
53.         b(i).dy = b(i).dy + gravity
54.         b(i).x = b(i).x + b(i).dx
55.         b(i).y = b(i).y + b(i).dy '+ 2 * gravity
56.         IF b(i).x < -200 * b(i).sc OR b(i).x > xmax + 200 * b(i).sc THEN
57.             newBall i
58.         END IF
59.         IF b(i).y + 220 * b(i).sc > ymax THEN
60.             b(i).y = ymax - 220 * b(i).sc
61.             b(i).dy = b(i).dy * -.8
62.             IF b(i).dx = 0 THEN b(i).dx = rdir ELSE b(i).dx = b(i).dx * 1.03
63.         END IF
64.         drawBall i
65.     NEXT
66.     _DISPLAY
67. WEND
68.  
69. SUB drawBall (i)
70.     DIM w, r, e, tmp, p, x, y, lc AS LONG
71.     w = ww 'fix
72.     FOR r = 190 TO 0 STEP -.25
73.         e = w - pi / 4 / (490 - 300)
74.         tmp = e: e = w: w = tmp
75.         FOR p = 0 TO pi STEP pi / 144
76.             e = INT((COS(w) * 380) / 2)
77.             x = b(i).x + e * b(i).sc * COS(p * 2)
78.             y = b(i).y - 90 * b(i).sc + e * b(i).sc * SIN(p * 2) + r * b(i).sc
79.             lc = lc + 1
80.             IF lc MOD 25 = 0 THEN
81.                 fcirc x, y, 6 * b(i).sc, plasma~&(i)
82.             END IF
83.         NEXT
84.     NEXT
85.  
86. END SUB
87.  
88. SUB newBall (i)
89.     b(i).x = RND * xmax - 40 + 20
90.     b(i).y = RND * -200
91.     b(i).dx = rand(1, 3) * rdir
92.     b(i).dy = rand(-5, 5)
93.     b(i).sc = rand(2, 5) / 10
94.     setRGB i
95. END SUB
96.  
97. SUB setRGB (i)
98.     b(i).pr = RND ^ 3: b(i).pg = RND ^ 3: b(i).pb = RND ^ 3: b(i).pn = 1
99. END SUB
100.  
101. FUNCTION plasma~& (i)
102.     b(i).pn = b(i).pn + .05
103.     plasma~& = _RGBA32(127 + 127 * SIN(b(i).pr * b(i).pn), 127 + 127 * SIN(b(i).pg * b(i).pn), 127 + 127 * SIN(b(i).pb * b(i).pn), 255)
104. END SUB
105.  
106. FUNCTION rand (lo, hi)
107.     rand = (RND * (hi - lo + 1)) \ 1 + lo
108. END FUNCTION
109.  
110. FUNCTION rdir ()
111.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
112. END FUNCTION
113.  
114. 'from Steve Gold standard
115. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
116.     DIM Radius AS INTEGER, RadiusError AS INTEGER
117.     DIM X AS INTEGER, Y AS INTEGER
118.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
119.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
120.     LINE (CX - X, CY)-(CX + X, CY), C, BF
121.     WHILE X > Y
122.         RadiusError = RadiusError + Y * 2 + 1
123.         IF RadiusError >= 0 THEN
124.             IF X <> Y + 1 THEN
125.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
126.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
127.             END IF
128.             X = X - 1
129.             RadiusError = RadiusError - X * 2
130.         END IF
131.         Y = Y + 1
132.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
133.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
134.     WEND
135. END SUB
136.  
137.  

Update: I changed the alpha to full opacity but you all might like to try this alpha level too:

Code: QB64: [Select]

1. FUNCTION plasma~& (i)
2. FUNCTION plasma~& (i)
3.     b(i).pn = b(i).pn + .05
4.     plasma~& = _RGBA32(127 + 127 * SIN(b(i).pr * b(i).pn), 127 + 127 * SIN(b(i).pg * b(i).pn), 127 + 127 * SIN(b(i).pb * b(i).pn), 40)
5.     'plasma~& = _RGBA32(127 + 127 * SIN(b(i).pr * b(i).pn), 127 + 127 * SIN(b(i).pg * b(i).pn), 127 + 127 * SIN(b(i).pb * b(i).pn), 255)
6. END SUB
7.  
8.  

Title: Re: Spiral Colored Balls
Post by: SierraKen on October 29, 2019, 09:01:36 pm

LOL way cool! Awesome designs. That kind of graphics would be amazing if someone could make a Pinball game with QB64. I've never seen one I think. But the geometry would be a bit hard for me.

Title: Re: Spiral Colored Balls
Post by: bplus on October 29, 2019, 11:41:26 pm

Thanks Ken

You know I debated myself doing it this way or the way above (which should probably NOT use alpha either):

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Spiral Colored Balls 2" 'B+ 2019-10-29 mod from
3. ' 2019-10-29 post 2nd way to display balls
4. ' 2019-10-29 mod be able to draw these balls anywhere
5. ' Rotate colors on a sphere.txt for JB v2.0 bplus 2018-04-16
6. ' from (extremely simplified) Double spiral.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-28
7.  
8. CONST xmax = 1200, ymax = 700, pi = _PI, nBalls = 5, ww = 3.14159 / 2, gravity = 2
9. TYPE ball
10.     x AS SINGLE
11.     y AS SINGLE
12.     a AS SINGLE
13.     dx AS SINGLE
14.     dy AS SINGLE
15.     sc AS SINGLE
16.     pr AS SINGLE
17.     pg AS SINGLE
18.     pb AS SINGLE
19.     pn AS SINGLE
20. END TYPE
21.  
22. DIM SHARED b(1 TO nBalls) AS ball
23.  
24. SCREEN _NEWIMAGE(xmax, ymax, 32)
25. _SCREENMOVE 100, 20 'this fits my screen yours may be different
26. RANDOMIZE TIMER
27.  
28. DIM i AS INTEGER, j AS INTEGER, b AS INTEGER, power, sky AS LONG
29.  
30. FOR i = 1 TO nBalls
31.     newBall i
32. NEXT
33. sky = _NEWIMAGE(xmax, ymax, 32)
34. _DEST sky&
35. FOR i = 0 TO ymax
36.     LINE (0, i)-(xmax, i), _RGB32(100 + i / ymax * 40, 100 + i / ymax * 50, 160 + i / ymax * 95)
37. NEXT
38. _DEST 0
39. WHILE _KEYDOWN(27) = 0
40.     _PUTIMAGE , sky&, 0
41.     FOR i = 1 TO nBalls
42.         'ready for collision
43.         b(i).a = _ATAN2(b(i).dy, b(i).dx)
44.         power = (b(i).dx ^ 2 + b(i).dy ^ 2) ^ .5
45.         FOR j = i + 1 TO nBalls
46.             IF SQR((b(i).x - b(j).x) ^ 2 + (b(i).y - b(j).y) ^ 2) < 200 * (b(i).sc + b(j).sc) THEN
47.                 b(i).a = _ATAN2(b(i).y - b(j).y, b(i).x - b(j).x)
48.                 b(j).a = _ATAN2(b(j).y - b(i).y, b(j).x - b(i).x)
49.                 EXIT FOR
50.             END IF
51.         NEXT
52.         b(i).dx = power * COS(b(i).a)
53.         b(i).dy = power * SIN(b(i).a)
54.         b(i).dy = b(i).dy + gravity
55.         b(i).x = b(i).x + b(i).dx
56.         b(i).y = b(i).y + b(i).dy '+ 2 * gravity
57.         IF b(i).x < -200 * b(i).sc OR b(i).x > xmax + 200 * b(i).sc THEN
58.             newBall i
59.         END IF
60.         IF b(i).y + 220 * b(i).sc > ymax THEN
61.             b(i).y = ymax - 220 * b(i).sc
62.             b(i).dy = b(i).dy * -.8
63.             IF b(i).dx = 0 THEN b(i).dx = rdir ELSE b(i).dx = b(i).dx * 1.03
64.         END IF
65.         drawBall i
66.     NEXT
67.     _DISPLAY
68. WEND
69.  
70. SUB drawBall (i)
71.     DIM w, r, e, tmp, p, x, y, lc AS LONG
72.     w = ww 'fix
73.     FOR r = 190 TO 0 STEP -.25
74.         e = w - pi / 4 / (490 - 300)
75.         tmp = e: e = w: w = tmp
76.         FOR p = 0 TO pi STEP pi / 144
77.             e = INT((COS(w) * 380) / 2)
78.             x = b(i).x + e * b(i).sc * COS(p * 2)
79.             y = b(i).y - 90 * b(i).sc + e * b(i).sc * SIN(p * 2) + r * b(i).sc
80.             lc = lc + 1
81.             IF lc MOD 40 = 0 THEN
82.                 fcirc x, y, 6 * b(i).sc, plasma~&(i)
83.             END IF
84.         NEXT
85.     NEXT
86.  
87. END SUB
88.  
89. SUB newBall (i)
90.     b(i).x = RND * xmax - 40 + 20
91.     b(i).y = RND * -200
92.     b(i).dx = rand(1, 3) * rdir
93.     b(i).dy = rand(-5, 5)
94.     b(i).sc = rand(2, 5) / 10
95.     setRGB i
96. END SUB
97.  
98. SUB setRGB (i)
99.     b(i).pr = RND ^ 3: b(i).pg = RND ^ 3: b(i).pb = RND ^ 3: b(i).pn = 1
100. END SUB
101.  
102. FUNCTION plasma~& (i)
103.     b(i).pn = b(i).pn + .05
104.     plasma~& = _RGBA32(127 + 127 * SIN(b(i).pr * b(i).pn), 127 + 127 * SIN(b(i).pg * b(i).pn), 127 + 127 * SIN(b(i).pb * b(i).pn), 255)
105. END SUB
106.  
107. FUNCTION rand (lo, hi)
108.     rand = (RND * (hi - lo + 1)) \ 1 + lo
109. END FUNCTION
110.  
111. FUNCTION rdir ()
112.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
113. END FUNCTION
114.  
115. 'from Steve Gold standard
116. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
117.     DIM Radius AS INTEGER, RadiusError AS INTEGER
118.     DIM X AS INTEGER, Y AS INTEGER
119.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
120.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
121.     LINE (CX - X, CY)-(CX + X, CY), C, BF
122.     WHILE X > Y
123.         RadiusError = RadiusError + Y * 2 + 1
124.         IF RadiusError >= 0 THEN
125.             IF X <> Y + 1 THEN
126.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
127.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
128.             END IF
129.             X = X - 1
130.             RadiusError = RadiusError - X * 2
131.         END IF
132.         Y = Y + 1
133.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
134.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
135.     WEND
136. END SUB
137.  
138.  

So you all could see more how these balls are constructed.

Which do you all like more?

Title: Re: Spiral Colored Balls
Post by: bplus on October 30, 2019, 12:02:04 am

Might be fun if the balls had some spin as they bounce Plus the little balls shouldn't be able to have so much force to push the big balls around so much.

Oh yeah and the speed, wonder if it could be revved up? So could do 25 or so balls.

Oh! Dewali day was Sunday, already too late. ;(

Title: Re: Spiral Colored Balls
Post by: codeguy on October 30, 2019, 03:59:08 am

That was cool! Nice job with that B+!

Title: Re: Spiral Colored Balls
Post by: johnno56 on October 30, 2019, 08:22:13 am

Aww man... Here I am thinking that all my optical receptors had been destroyed from some of your 'colourful' examples from the past, then these champions pop up on the screen, and found the last surviving sensors and blew 'them' out of the water as well.... Brilliant examples none the less.... and my seeing-eye dog agrees... lol

Title: Re: Spiral Colored Balls
Post by: Ashish on October 30, 2019, 10:42:06 am

Wow! Bplus! Its beautiful! Love it!

Text Only | Text with Attachments