Julia Rings by Relsoft

[The Librarian]

Julia Rings

Author: Relsoft
Source: [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] Forum
URL: /forum/index.php?topic=128.0]http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=128.0
Version: QB64
Tags: [fractal] [julia set]

Description:
Automated Julia set explorer.

Source Code:

Code: QB64: [Select]

1. ' The Lord of the Julia Rings
2. ' The Fellowship of the Julia Ring
3. ' Free Basic
4. ' Relsoft
5. ' Rel.BetterWebber.com
6. '
7. ' Converted to QB64 format by Galleon (FB specific code commented)
8.  
9. DEFLNG A-Z
10.  
11. ''$include: 'TinyPTC.bi'
12. ''$include: 'user32.bi'
13.  
14. 'option explicit
15.  
16. CONST SCR_WIDTH = 320 * 2
17. CONST SCR_HEIGHT = 240 * 2
18.  
19. CONST SCR_SIZE = SCR_WIDTH * SCR_HEIGHT
20. CONST SCR_MIDX = SCR_WIDTH \ 2
21. CONST SCR_MIDY = SCR_HEIGHT \ 2
22.  
23. CONST FALSE = 0, TRUE = NOT FALSE
24.  
25. CONST PI = 3.141593
26. CONST MAXITER = 20
27. CONST MAXSIZE = 4
28.  
29. DIM Buffer(SCR_SIZE - 1) AS LONG
30. DIM Lx(SCR_WIDTH - 1) AS SINGLE
31. DIM Ly(SCR_HEIGHT - 1) AS SINGLE
32. DIM sqrt(SCR_SIZE - 1) AS SINGLE
33.  
34. 'if( ptc_open( "FreeBASIC Julia (Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
35. '   end -1
36. 'end if
37.  
38. SCREEN _NEWIMAGE(SCR_WIDTH, SCR_HEIGHT, 32), , 1, 0
39.  
40. DIM px AS LONG, py AS LONG
41. DIM p AS SINGLE, q AS SINGLE
42. DIM xmin AS SINGLE, xmax AS SINGLE, ymin AS SINGLE, ymax AS SINGLE
43. DIM theta AS SINGLE
44. DIM deltax AS SINGLE, deltay AS SINGLE
45. DIM x AS SINGLE, y AS SINGLE
46. DIM xsquare AS SINGLE, ysquare AS SINGLE
47. DIM ytemp AS SINGLE
48. DIM temp1 AS SINGLE, temp2 AS SINGLE
49. DIM i AS LONG, pixel AS LONG
50. DIM t AS _UNSIGNED LONG, frame AS _UNSIGNED LONG
51. DIM ty AS SINGLE
52. DIM r AS LONG, g AS LONG, b AS LONG
53. DIM red AS LONG, grn AS LONG, blu AS LONG
54. DIM tmp AS LONG, i_last AS LONG
55.  
56. DIM cmag AS SINGLE
57. DIM cmagsq AS SINGLE
58. DIM zmag AS SINGLE
59. DIM drad AS SINGLE
60. DIM drad_L AS SINGLE
61. DIM drad_H AS SINGLE
62. DIM ztot AS SINGLE
63. DIM ztoti AS LONG
64.  
65. 'pointers to array "buffer"
66. 'dim p_buffer as long ptr, p_bufferl as long ptr
67.  
68. xmin = -2.0
69. xmax = 2.0
70. ymin = -1.5
71. ymax = 1.5
72.  
73. deltax = (xmax - xmin) / (SCR_WIDTH - 1)
74. deltay = (ymax - ymin) / (SCR_HEIGHT - 1)
75.  
76. FOR i = 0 TO SCR_WIDTH - 1
77.     Lx(i) = xmin + i * deltax
78. NEXT i
79.  
80. FOR i = 0 TO SCR_HEIGHT - 1
81.     Ly(i) = ymax - i * deltay
82. NEXT i
83.  
84. FOR i = 0 TO SCR_SIZE - 1
85.     sqrt(i) = SQR(i)
86. NEXT i
87.  
88. 'dim hwnd as long
89. 'hwnd = GetActiveWindow
90.  
91. DIM stime AS LONG, Fps AS SINGLE, Fps2 AS SINGLE
92.  
93. stime = TIMER
94.  
95. DO
96.  
97.     '    p_buffer = @buffer(0)
98.     '    p_bufferl = @buffer(SCR_SIZE-1)
99.  
100.     frame = (frame + 1) AND &H7FFFFFFF
101.     theta = frame * PI / 180
102.  
103.     p = COS(theta) * SIN(theta * .7)
104.     q = SIN(theta) + SIN(theta)
105.     p = p * .6
106.     q = q * .6
107.  
108.     cmag = SQR(p * p + q * q)
109.     cmagsq = (p * p + q * q)
110.     drad = 0.04
111.     drad_L = (cmag - drad)
112.     drad_L = drad_L * drad_L
113.     drad_H = (cmag + drad)
114.     drad_H = drad_H * drad_H
115.  
116.     FOR py = 0 TO (SCR_HEIGHT \ 2) - 1
117.         ty = Ly(py)
118.         FOR px = 0 TO SCR_WIDTH - 1
119.             x = Lx(px)
120.             y = ty
121.             xsquare = 0
122.             ysquare = 0
123.             ztot = 0
124.             i = 0
125.             WHILE (i < MAXITER) AND ((xsquare + ysquare) < MAXSIZE)
126.                 xsquare = x * x
127.                 ysquare = y * y
128.                 ytemp = x * y * 2
129.                 x = xsquare - ysquare + p
130.                 y = ytemp + q
131.                 zmag = (x * x + y * y)
132.                 IF (zmag < drad_H) AND (zmag > drad_L) AND (i > 0) THEN
133.                     ztot = ztot + (1 - (ABS(zmag - cmagsq) / drad))
134.                     i_last = i
135.                 END IF
136.                 i = i + 1
137.                 IF zmag > 4.0 THEN
138.                     EXIT WHILE
139.                 END IF
140.             WEND
141.  
142.             IF ztot > 0 THEN
143.                 i = CINT(SQR(ztot) * 500)
144.             ELSE
145.                 i = 0
146.             END IF
147.             IF i < 256 THEN
148.                 red = i
149.             ELSE
150.                 red = 255
151.             END IF
152.  
153.             IF i < 512 AND i > 255 THEN
154.                 grn = i - 256
155.             ELSE
156.                 IF i >= 512 THEN
157.                     grn = 255
158.                 ELSE
159.                     grn = 0
160.                 END IF
161.             END IF
162.  
163.             IF i <= 768 AND i > 511 THEN
164.                 blu = i - 512
165.             ELSE
166.                 IF i >= 768 THEN
167.                     blu = 255
168.                 ELSE
169.                     blu = 0
170.                 END IF
171.             END IF
172.  
173.             tmp = INT((red + grn + blu) \ 3)
174.             red = INT((red + grn + tmp) \ 3)
175.             grn = INT((grn + blu + tmp) \ 3)
176.             blu = INT((blu + red + tmp) \ 3)
177.  
178.             SELECT CASE (i_last MOD 3)
179.                 CASE 1
180.                     tmp = red
181.                     red = grn
182.                     grn = blu
183.                     blu = tmp
184.                 CASE 2
185.                     tmp = red
186.                     blu = grn
187.                     red = blu
188.                     grn = tmp
189.             END SELECT
190.  
191.             'pixel = red shl 16 or grn shl 8 or blu
192.             '*p_buffer = pixel
193.             '*p_bufferl = pixel
194.             'p_buffer = p_buffer + Len(long)
195.             'p_bufferl = p_bufferl - Len(long)
196.             pixel = _RGB32(red, grn, blu)
197.             PSET (px, py), pixel
198.             PSET (SCR_WIDTH - 1 - px, SCR_HEIGHT - 1 - py), pixel
199.  
200.         NEXT px
201.     NEXT py
202.  
203.     'calc fps
204.     Fps = Fps + 1
205.     IF stime + 1 < TIMER THEN
206.         Fps2 = Fps
207.         Fps = 0
208.         stime = TIMER
209.     END IF
210.  
211.     '    SetWindowText hwnd, "FreeBasic Julia Rings FPS:" + str$(Fps2)
212.     LOCATE 1, 1: PRINT "QB64 Julia Rings FPS:" + STR$(Fps2)
213.  
214.     'ptc_update @buffer(0)
215.     PCOPY 1, 0
216.  
217. LOOP UNTIL INKEY$ <> ""
218.  
219. 'ptc_close
220.  
221. END
222.