Spherical Rainbow!

[Ashish]

Hi everyone! Yet, another cool OpenGL demo... I try to create a rainbow with the strips of sphere. Thanks to @STxAxTIC for helping in sphere rendering..
Enjoy the program. ;)

Code: QB64: [Select]

1. 'By Ashish
2. '26 Feb, 2020
3. 'Thanks to STxAxTIC for helping in sphere rendering
4. _title "Spherical Rainbow"
5. screen _newimage(600,600,32)
6.  
7. dim shared allowGL
8. allowGL = 1
9. do
10.  
11.         _limit 40
12. loop
13.  
14. sub _gl() static
15.         if allowGL=0 then exit sub
16.         if glInit = 0 then
17.                 _glViewport 0,0,_width,_height
18.                 aspect#= _width/_height
19.                 r = 1
20.                
21.                 glInit = 1
22.         end if
23.         _glEnable _GL_DEPTH_TEST
24.        
25.         _glMatrixMode _GL_PROJECTION
26.         _glLoadIdentity
27.         _gluPerspective 50,aspect#,0.1,10.0
28.        
29.         _glMatrixMode _GL_MODELVIEW
30.         _glLoadIdentity
31.         _glRotatef c*60,1,1,1
32.         c=c+0.01
33.        
34.         s = 0.07
35.         a = 0
36.         for theta = 0 to _pi step s
37.                 a~& = hsb(map(theta,0,_pi,0,255),255,128,255)
38.                 _glColor3f _red(a~&)/255, _green(a~&)/255, _blue(a~&)/255
39.                 _glBegin _gl_triangle_strip
40.                 for phi = 0 to _pi(2)+s step s
41.                         x0 = r*sin(theta)*cos(phi)
42.                         y0 = r*sin(theta)*sin(phi)
43.                         z0 = r*cos(theta)
44.                        
45.                         x1 = r*sin(theta+s)*cos(phi)
46.                         y1 = r*sin(theta+s)*sin(phi)
47.                         z1 = r*cos(theta+s)
48.                        
49.                         _glVertex3f x0,y0,z0
50.                         _glVertex3f x1,y1,z1
51.                 next
52.                 _glEnd
53.                 a=a+1
54.         next
55.        
56.         _glFlush
57. end sub
58.  
59. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
60.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
61. END FUNCTION
62.  
63. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
64. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
65.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
66.  
67.     H = map(__H, 0, 255, 0, 360)
68.     S = map(__S, 0, 255, 0, 1)
69.     B = map(__B, 0, 255, 0, 1)
70.  
71.     IF S = 0 THEN
72.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
73.         EXIT FUNCTION
74.     END IF
75.  
76.     DIM fmx AS _FLOAT, fmn AS _FLOAT
77.     DIM fmd AS _FLOAT, iSextant AS INTEGER
78.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
79.  
80.     IF B > .5 THEN
81.         fmx = B - (B * S) + S
82.         fmn = B + (B * S) - S
83.     ELSE
84.         fmx = B + (B * S)
85.         fmn = B - (B * S)
86.     END IF
87.  
88.     iSextant = INT(H / 60)
89.  
90.     IF H >= 300 THEN
91.         H = H - 360
92.     END IF
93.  
94.     H = H / 60
95.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
96.  
97.     IF iSextant MOD 2 = 0 THEN
98.         fmd = (H * (fmx - fmn)) + fmn
99.     ELSE
100.         fmd = fmn - (H * (fmx - fmn))
101.     END IF
102.  
103.     imx = _ROUND(fmx * 255)
104.     imd = _ROUND(fmd * 255)
105.     imn = _ROUND(fmn * 255)
106.  
107.     SELECT CASE INT(iSextant)
108.         CASE 1
109.             hsb~& = _RGBA32(imd, imx, imn, A)
110.         CASE 2
111.             hsb~& = _RGBA32(imn, imx, imd, A)
112.         CASE 3
113.             hsb~& = _RGBA32(imn, imd, imx, A)
114.         CASE 4
115.             hsb~& = _RGBA32(imd, imn, imx, A)
116.         CASE 5
117.             hsb~& = _RGBA32(imx, imn, imd, A)
118.         CASE ELSE
119.             hsb~& = _RGBA32(imx, imd, imn, A)
120.     END SELECT
121.  
122. END FUNCTION
123.  
124.