Cube Plasma

[bplus]

Hi Petr,

Don't worry, it's nice demo I can see why you want to show it off.

[Ashish]

I don't know how a 3D plasma actually look like.
Maybe it looks like this -

Code: QB64: [Select]

1. '3D plasma, coded by Ashish  14 June, 2018
2. 'Twitter : @KingOfCoders
3. 'http://lodev.org/cgtutor/plasma.html
4.  
5. _TITLE "3D Plasma"
6. SCREEN _NEWIMAGE(600, 600, 32)
7.  
8.  
9. DECLARE LIBRARY
10.     'for camera
11.     SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
12. END DECLARE
13.  
14. DIM SHARED mapSize
15. mapSize = 200
16. DIM SHARED glAllow AS _BYTE, textureImage&(258), tmp_buffer_image&
17. DIM SHARED tmp_height_map&, height_map_buffer AS _MEM 'New height maps
18.  
19. tmp_buffer_image& = _NEWIMAGE(mapSize, mapSize, 32)
20. tmp_height_map& = _NEWIMAGE(mapSize, mapSize, 32) 'this image will be treated as height map
21. height_map_buffer = _MEMIMAGE(tmp_height_map&) 'the data in above image will access by this _MEM buffer
22.  
23.  
24. _DEST tmp_buffer_image&
25. 'storing calculation in memory for faster rendering
26. DIM sin1(_WIDTH - 1, _HEIGHT - 1), sin2(_WIDTH - 1, _HEIGHT - 1), sin3(_WIDTH - 1, _HEIGHT - 1)
27. FOR y = 0 TO _HEIGHT - 1
28.     FOR x = 0 TO _WIDTH - 1
29.         sin1(x, y) = SIN(SQR(x ^ 2 + y ^ 2) * .09)
30.         sin2(x, y) = SIN(y * .03)
31.         sin3(x, y) = COS(((_WIDTH / 2 - x) ^ 2 + (_HEIGHT / 2 - y) ^ 2) ^ .5 * .07)
32. NEXT x, y
33.  
34. DO
35.     _DEST 0
36.     CLS
37.     PRINT "Generating Textures "; f; "/"; UBOUND(textureImage&) - 1
38.     f = f + 1
39.     FOR y = 0 TO _HEIGHT(tmp_buffer_image&) - 1
40.         FOR x = 0 TO _WIDTH(tmp_buffer_image&) - 1
41.             col = sin1(x, y) * 64 + sin2(x, y) * 64 + sin3(x, y) * 64 + 255 + f
42.             col2 = col MOD 255
43.             _DEST tmp_buffer_image&
44.             PSET (x, y), hsb(col2, 255, 128, 255)
45.     NEXT x, y
46.     textureImage&(f) = _COPYIMAGE(tmp_buffer_image&)
47. LOOP UNTIL f > UBOUND(textureImage&) - 1
48. _DEST 0
49. _FREEIMAGE tmp_buffer_image&
50.  
51.  
52. _GLRENDER _ONTOP
53.  
54. _DEST tmp_height_map&
55. glAllow = -1
56. DO
57.     f = f + 1
58.     FOR y = 0 TO _HEIGHT - 1
59.         FOR x = 0 TO _WIDTH - 1
60.             col = sin1(x, y) * 64 + sin2(x, y) * 64 + sin3(x, y) * 64 + 255 + f
61.             col = SIN(col * .01) * 64 + 128
62.             PSET (x, y), _RGB(col, col, col)
63.     NEXT x, y
64. LOOP
65.  
66. SUB _GL ()
67.     STATIC cubeTexture&(257), glSetup
68.     STATIC aspect#, frame
69.  
70.  
71.     IF NOT glAllow THEN EXIT SUB
72.  
73.     IF NOT glSetup THEN
74.         glSetup = -1
75.         _glViewport 0, 0, _WIDTH, _HEIGHT
76.         'Convert all images to GL textures
77.         FOR i = 1 TO UBOUND(textureImage&) - 1
78.             _glGenTextures 1, _OFFSET(cubeTexture&(i))
79.             DIM m AS _MEM
80.             m = _MEMIMAGE(textureImage&(i))
81.  
82.             _glBindTexture _GL_TEXTURE_2D, cubeTexture&(i)
83.             _glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _WIDTH(textureImage&(i)), _HEIGHT(textureImage&(i)), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
84.  
85.             _MEMFREE m
86.  
87.             _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR
88.             _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST
89.             _FREEIMAGE textureImage&(i)
90.         NEXT
91.         aspect# = _WIDTH / _HEIGHT
92.     END IF
93.  
94.     _glEnable _GL_TEXTURE_2D
95.     _glEnable _GL_DEPTH_TEST
96.  
97.     _glMatrixMode _GL_PROJECTION
98.     _glLoadIdentity
99.     _gluPerspective 45.0, aspect#, 1, 100
100.  
101.     _glMatrixMode _GL_MODELVIEW
102.     _glLoadIdentity
103.  
104.     _glShadeModel _GL_SMOOTH
105.  
106.     gluLookAt 0, 0, 4, 0, 0, 0, 0, 1, 0
107.  
108.     i = (frame MOD (UBOUND(textureImage&) - 1)) + 1
109.  
110.     'select our texture
111.     _glBindTexture _GL_TEXTURE_2D, cubeTexture&(i)
112.  
113.     'rotation
114.     _glRotatef -45, 1, 0, 0
115.  
116.     drawPlane 2, 2, .05, height_map_buffer
117.  
118.     frame = frame + 1
119. END SUB
120.  
121. SUB drawPlane (w, h, detail, height_map AS _MEM)
122.  
123.     'texture coordinates
124.     tx1 = 0: ty1 = 0
125.     tx2 = 0: ty2 = 0
126.  
127.     depth1 = 0 'used for depth effect by using height maps
128.     depth2 = 0
129.  
130.     hx1% = 0: hy1% = 0
131.     hx2% = 0: hy2% = 0
132.     _glBegin _GL_TRIANGLE_STRIP
133.     FOR y = -h / 2 TO h / 2 - detail STEP detail
134.         FOR x = -w / 2 TO w / 2 - detail STEP detail
135.             tx1 = map(x, -w / 2, w / 2, 0, 1)
136.             ty1 = map(y, -h / 2, h / 2, 1, 0)
137.             ty2 = map(y + detail, -h / 2, h / 2, 1, 0)
138.  
139.             hx1% = map(tx1, 0, 1, 1, mapSize - 1)
140.             hy1% = map(ty1, 0, 1, mapSize - 1, 1)
141.             hy2% = map(ty2, 0, 1, mapSize - 1, 1)
142.  
143.             depth1 = _MEMGET(height_map, height_map.OFFSET + memImageIndex(hx1%, hy1%, mapSize), _UNSIGNED _BYTE) / 400
144.             depth2 = _MEMGET(height_map, height_map.OFFSET + memImageIndex(hx1%, hy2%, mapSize), _UNSIGNED _BYTE) / 400
145.  
146.             _glTexCoord2f tx1, ty1
147.             _glVertex3f x, y, depth1
148.             _glTexCoord2f tx1, ty2
149.             _glVertex3f x, y + detail, depth2
150.         NEXT x
151.     NEXT y
152.  
153.     _glEnd
154.  
155. END SUB
156.  
157. FUNCTION memImageIndex& (x, y, w)
158.     memImageIndex& = (x + y * w) * 4
159. END FUNCTION
160.  
161.  
162. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
163.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
164. END FUNCTION
165.  
166. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
167. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
168.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
169.  
170.     H = map(__H, 0, 255, 0, 360)
171.     S = map(__S, 0, 255, 0, 1)
172.     B = map(__B, 0, 255, 0, 1)
173.  
174.     IF S = 0 THEN
175.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
176.         EXIT FUNCTION
177.     END IF
178.  
179.     DIM fmx AS _FLOAT, fmn AS _FLOAT
180.     DIM fmd AS _FLOAT, iSextant AS INTEGER
181.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
182.  
183.     IF B > .5 THEN
184.         fmx = B - (B * S) + S
185.         fmn = B + (B * S) - S
186.     ELSE
187.         fmx = B + (B * S)
188.         fmn = B - (B * S)
189.     END IF
190.  
191.     iSextant = INT(H / 60)
192.  
193.     IF H >= 300 THEN
194.         H = H - 360
195.     END IF
196.  
197.     H = H / 60
198.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
199.  
200.     IF iSextant MOD 2 = 0 THEN
201.         fmd = (H * (fmx - fmn)) + fmn
202.     ELSE
203.         fmd = fmn - (H * (fmx - fmn))
204.     END IF
205.  
206.     imx = _ROUND(fmx * 255)
207.     imd = _ROUND(fmd * 255)
208.     imn = _ROUND(fmn * 255)
209.  
210.     SELECT CASE INT(iSextant)
211.         CASE 1
212.             hsb~& = _RGBA32(imd, imx, imn, A)
213.         CASE 2
214.             hsb~& = _RGBA32(imn, imx, imd, A)
215.         CASE 3
216.             hsb~& = _RGBA32(imn, imd, imx, A)
217.         CASE 4
218.             hsb~& = _RGBA32(imd, imn, imx, A)
219.         CASE 5
220.             hsb~& = _RGBA32(imx, imn, imd, A)
221.         CASE ELSE
222.             hsb~& = _RGBA32(imx, imd, imn, A)
223.     END SELECT
224.  
225. END FUNCTION
226.  
227.  

[bplus]

Another great effect!

Ashish, you changed your avatar!

[Ashish]

Another great effect!

Ashish, you changed your avatar!

Thanks bplus! Yeah, I changed my avatar. Is my new avatar is not looking good? If yes, I will bring back my old avatar.

[bplus]

It is fine example of infinity! I wish I could see a bigger version. Did you make it?

[Ashish]

It is fine example of infinity! I wish I could see a bigger version. Did you make it?

Nope! I'm not a good artist. This image is from here - http://tharyn.me/wp-content/uploads/2013/12/Infinity_Symbol.jpg

[bplus]

I try:

Code: QB64: [Select]

1. _TITLE "Infinity B+ started 2018-06-14 mod of Vince Hour Glass"
2. CONST xmax = 800
3. CONST ymax = 600
4.  
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 360, 60
7. pi = _ACOS(-1)
8. p2 = pi * 2
9. WHILE 1
10.     b = b + .01
11.     IF b > p2 THEN b = 0
12.     FOR r = 40 TO 1 STEP -1
13.         COLOR _RGB(r * (6 * SIN(b)), r * 6 * (1 - SIN(b)), 0)
14.         fcirc 400 + 300 * COS(b), 300 + 150 * SIN(2 * b), r
15.     NEXT
16.     _DISPLAY
17. WEND
18.  
19. 'Steve McNeil's  copied from his forum  note: Radius is too common a name ;-)
20. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
21.     DIM subRadius AS LONG, RadiusError AS LONG
22.     DIM X AS LONG, Y AS LONG
23.  
24.     subRadius = ABS(R)
25.     RadiusError = -subRadius
26.     X = subRadius
27.     Y = 0
28.  
29.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
30.  
31.     ' Draw the middle span here so we don't draw it twice in the main loop,
32.     ' which would be a problem with blending turned on ;-)
33.     LINE (CX - X, CY)-(CX + X, CY), , BF
34.  
35.     WHILE X > Y
36.         RadiusError = RadiusError + Y * 2 + 1
37.         IF RadiusError >= 0 THEN
38.             IF X <> Y + 1 THEN
39.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
40.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
41.             END IF
42.             X = X - 1
43.             RadiusError = RadiusError - X * 2
44.         END IF
45.         Y = Y + 1
46.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
47.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
48.     WEND
49. END SUB
50.  
51.  

[Ashish]

It's nice bplus. I didn't know that you were talking about this. :)

[_vince]

@bplus, changing the sin multiplier gives it a thinner profile, like 100*sin

Here's the program in freebasic, fyi:

Code: QB64: [Select]

1. #lang "fblite"
2.  
3. defsng a-z
4.  
5. CONST xmax = 800
6. CONST ymax = 600
7.  
8. declare SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
9.  
10. screenres xmax, ymax, 32
11.  
12. pi = ACOS(-1)
13. p2 = pi * 2
14. WHILE 1
15.     b = b + .01
16.     IF b > p2 THEN b = 0
17.     FOR r = 40 TO 1 STEP -1
18.         COLOR rgb(r * (6 * SIN(b)), r * 6 * (1 - SIN(b)), 0)
19.         fcirc 400 + 300 * COS(b), 300 + 100 * SIN(2 * b), int(r)
20.     NEXT
21.         screensync
22. WEND
23.  
24. 'Steve McNeil's  copied from his forum  note: Radius is too common a name ;-)
25. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
26.     DIM subRadius AS LONG, RadiusError AS LONG
27.     DIM X AS LONG, Y AS LONG
28.  
29.     subRadius = ABS(R)
30.     RadiusError = -subRadius
31.     X = subRadius
32.     Y = 0
33.  
34.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
35.  
36.     ' Draw the middle span here so we don't draw it twice in the main loop,
37.     ' which would be a problem with blending turned on ;-)
38.     LINE (CX - X, CY)-(CX + X, CY), , BF
39.  
40.     WHILE X > Y
41.         RadiusError = RadiusError + Y * 2 + 1
42.         IF RadiusError >= 0 THEN
43.             IF X <> Y + 1 THEN
44.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
45.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
46.             END IF
47.             X = X - 1
48.             RadiusError = RadiusError - X * 2
49.         END IF
50.         Y = Y + 1
51.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
52.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
53.     WEND
54. END SUB
55.  

[bplus]

Hi V,

Watch that language! :D

Here is a mod, I do like shape better. Somewhere between 80 and 100...

Code: QB64: [Select]

1. _TITLE "Infinity B+ started 2018-06-15 mod of mod of Vince Hour Glass"
2. CONST xmax = 800
3. CONST ymax = 600
4.  
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 360, 60
7. pi = _ACOS(-1)
8. p2 = pi * 2
9. FOR r = 40 TO 0 STEP -1
10.     COLOR _RGBA32(255 - r * 4, 255 - r * 4, 0, 1)
11.     FOR a = 0 TO p2 STEP .01
12.         fcirc 400 + 300 * COS(a), 300 + 80 * SIN(2 * a), r
13.     NEXT
14. NEXT
15. FOR b = 0 TO p2 STEP .001
16.     b = b + .001
17.     IF b > p2 THEN b = 0
18.     COLOR _RGB(255 * SIN(b), 255 * (1 - SIN(b)), 0)
19.     fcirc 400 + 300 * COS(b), 300 + 80 * SIN(2 * b), r
20. NEXT
21. PRINT "Press any... "
22. SLEEP
23. CLS
24. WHILE 1
25.     b = b + .01
26.     IF b > p2 THEN b = 0
27.     FOR r = 40 TO 1 STEP -1
28.         COLOR _RGB(r * (6 * SIN(b)), r * 6 * (1 - SIN(b)), 0)
29.         fcirc 400 + 300 * COS(b), 300 + 90 * SIN(2 * b), r
30.     NEXT
31.     _DISPLAY
32. WEND
33.  
34. 'Steve McNeil's  copied from his forum  note: Radius is too common a name ;-)
35. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
36.     DIM subRadius AS LONG, RadiusError AS LONG
37.     DIM X AS LONG, Y AS LONG
38.  
39.     subRadius = ABS(R)
40.     RadiusError = -subRadius
41.     X = subRadius
42.     Y = 0
43.  
44.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
45.  
46.     ' Draw the middle span here so we don't draw it twice in the main loop,
47.     ' which would be a problem with blending turned on ;-)
48.     LINE (CX - X, CY)-(CX + X, CY), , BF
49.  
50.     WHILE X > Y
51.         RadiusError = RadiusError + Y * 2 + 1
52.         IF RadiusError >= 0 THEN
53.             IF X <> Y + 1 THEN
54.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
55.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
56.             END IF
57.             X = X - 1
58.             RadiusError = RadiusError - X * 2
59.         END IF
60.         Y = Y + 1
61.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
62.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
63.     WEND
64. END SUB
65.  
66.