Lemon explorer

[_vince]

Implementation of http://paulbourke.net/fractals/lemon/

Code: QB64: [Select]

1. defint a-z
2.  
3. const sw = 640
4. const sh = 480
5.  
6. dim shared mx,my,mbl,mbr,mw
7.  
8. dim u as double, v as double
9. dim uu as double, vv as double
10. dim uuu as double, vvv as double
11. dim xx as double, yy as double
12. dim x0 as double, y0 as double
13. dim z as double, zz as double
14. z = 0.01
15. zz = 0.1
16.  
17. dim p1 as long
18. p1 = _newimage(sw, sh, 32)
19. screen _newimage(sw, sh, 32)
20.  
21. redraw = -1
22. iter = 100
23.  
24. do
25.         mw = 0
26.         getMouse
27.  
28.         if redraw then
29.                 line(0,0)-(sw,sh),_rgb(0,0,0),bf
30.                 for y = 0 to sh-1
31.                 for x = 0 to sw-1
32.  
33.                         xx = (x - sw/2)*z + x0
34.                         yy = (y - sh/2)*z + y0
35.                         u = yy
36.                         v = xx
37.                         j=0
38.                         for i = 0 to iter
39.                                 cmul uuu,vvv,u,v,u,v
40.                                 cmul uu,vv,uuu,vvv,yy,xx
41.                                 cmul uu,vv,uu,vv,uuu+1,vvv
42.                                 uuu=uuu-1
43.                                 cmul uuu,vvv,uuu,vvv,uuu,vvv
44.                                 cdiv uu,vv,uu,vv,uuu,vvv
45.  
46.                                 if uu*uu + vv*vv > 10^10 then
47.                                         i = iter
48.                                         exit for
49.                                 end if
50.                                 if abs(u-uu)<0.00001 and abs(v-vv)<0.00001 then
51.                                         j = j + 1
52.                                 else
53.                                         j = 0
54.                                 end if
55.                                 if j > 4 then exit for
56.  
57.                                 u = uu
58.                                 v = vv
59.                         next
60.                         if i < iter then
61.                                 c = 255-10*i
62.                                 pset(x, y), _rgb(c,c,c)
63.                         end if
64.                 next
65.                 next
66.  
67.                 'locate 1,1
68.                 'print "iter =";iter
69.  
70.                 _dest p1
71.                 _putimage , 0
72.                 _dest 0
73.  
74.                 _putimage , p1
75.                 _autodisplay
76.  
77.                 redraw = 0
78.         end if
79.  
80.         if mw < 0 then
81.                 zz = zz + 0.01
82.         elseif mw > 0 then
83.                 if zz > 0.01 then zz = zz - 0.01
84.         end if
85.  
86.         'draw box
87.         if omx <> mx or omy <> my or mw <> 0 then
88.                 _putimage , p1
89.                 line (mx - (sw*zz/2), my - (sh*zz/2))-step(sw*zz,sh*zz),_rgb(255,255,255),b
90.                 _autodisplay
91.  
92.                 omx = mx
93.                 omy = my
94.         end if
95.  
96.         if mbl then
97.                 do
98.                         getMouse
99.                 loop while mbl
100.  
101.                 x0 = x0 + (mx - sw/2)*z
102.                 y0 = y0 - (sh/2 - my)*z
103.                 z = z*zz
104.                 redraw = -1
105.         elseif mbr then
106.                 do
107.                         getMouse
108.                 loop while mbr
109.  
110.                 x0 = x0 + (mx - sw/2)*z
111.                 y0 = y0 - (sh/2 - my)*z
112.                 z = z/zz
113.                 redraw = -1
114.         end if
115.  
116.         k = _keyhit
117.         if k = 43 then
118.                 iter = iter + 50
119.                 redraw = -1
120.         elseif k = 45 then
121.                 if iter > 50 then iter = iter - 50
122.                 redraw = -1
123.         end if
124.  
125. loop until k = 27
126. system
127.  
128. sub getMouse ()
129.         do
130.                 mx = _mousex
131.                 my = _mousey
132.                 mbl = _mousebutton(1)
133.                 mbr = _mousebutton(2)
134.                 mw = mw + _mousewheel
135.         loop while _mouseinput
136. end sub
137.  
138. sub cmul (u as double, v as double, x as double, y as double, a as double, b as double)
139.         uu# = x*a - y*b
140.         vv# = x*b + y*a
141.         u = uu#
142.         v = vv#
143. end sub
144.  
145. sub cdiv (u as double, v as double, x as double, y as double, a as double, b as double)
146.         d# = a*a + b*b
147.         uu# = (x*a + y*b)/d#
148.         vv# = (y*a - x*b)/d#
149.         u = uu#
150.         v = vv#
151. end sub
152.  

[Ashish]

This is amazing! Good work Vince!

[Ashish]

Hi. I made some changes in your code to look colorful.

Code: QB64: [Select]

1. 'originally by Vince
2. 'Edited by Ashish
3.  
4. DEFINT A-Z
5.  
6. CONST sw = 640
7. CONST sh = 480
8.  
9. DIM SHARED mx, my, mbl, mbr, mw
10.  
11. DIM u AS DOUBLE, v AS DOUBLE
12. DIM uu AS DOUBLE, vv AS DOUBLE
13. DIM uuu AS DOUBLE, vvv AS DOUBLE
14. DIM xx AS DOUBLE, yy AS DOUBLE
15. DIM x0 AS DOUBLE, y0 AS DOUBLE
16. DIM z AS DOUBLE, zz AS DOUBLE
17. z = 0.01
18. zz = 0.1
19.  
20. DIM p1 AS LONG
21. p1 = _NEWIMAGE(sw, sh, 32)
22. SCREEN _NEWIMAGE(sw, sh, 32)
23.  
24. redraw = -1
25. iter = 100
26.  
27. DO
28.     mw = 0
29.     getMouse
30.  
31.     IF redraw THEN
32.         LINE (0, 0)-(sw, sh), _RGB(0, 0, 0), BF
33.         FOR y = 0 TO sh - 1
34.             FOR x = 0 TO sw - 1
35.  
36.                 xx = (x - sw / 2) * z + x0
37.                 yy = (y - sh / 2) * z + y0
38.                 u = yy
39.                 v = xx
40.                 j = 0
41.                 FOR i = 0 TO iter
42.                     cmul uuu, vvv, u, v, u, v
43.                     cmul uu, vv, uuu, vvv, yy, xx
44.                     cmul uu, vv, uu, vv, uuu + 1, vvv
45.                     uuu = uuu - 1
46.                     cmul uuu, vvv, uuu, vvv, uuu, vvv
47.                     cdiv uu, vv, uu, vv, uuu, vvv
48.  
49.                     IF uu * uu + vv * vv > 10 ^ 10 THEN
50.                         i = iter
51.                         EXIT FOR
52.                     END IF
53.                     IF ABS(u - uu) < 0.00001 AND ABS(v - vv) < 0.00001 THEN
54.                         j = j + 1
55.                     ELSE
56.                         j = 0
57.                     END IF
58.                     IF j > 4 THEN EXIT FOR
59.  
60.                     u = uu
61.                     v = vv
62.                 NEXT
63.                 IF i < iter THEN
64.                     c = 360 - 10 * i
65.                     PSET (x, y), hsb(c, 200, 128, 255)
66.                 END IF
67.             NEXT
68.         NEXT
69.  
70.         'locate 1,1
71.         'print "iter =";iter
72.  
73.         _DEST p1
74.         _PUTIMAGE , 0
75.         _DEST 0
76.  
77.         _PUTIMAGE , p1
78.         _AUTODISPLAY
79.  
80.         redraw = 0
81.     END IF
82.  
83.     IF mw < 0 THEN
84.         zz = zz + 0.01
85.     ELSEIF mw > 0 THEN
86.         IF zz > 0.01 THEN zz = zz - 0.01
87.     END IF
88.  
89.     'draw box
90.     IF omx <> mx OR omy <> my OR mw <> 0 THEN
91.         _PUTIMAGE , p1
92.         LINE (mx - (sw * zz / 2), my - (sh * zz / 2))-STEP(sw * zz, sh * zz), _RGB(255, 255, 255), B
93.         _AUTODISPLAY
94.  
95.         omx = mx
96.         omy = my
97.     END IF
98.  
99.     IF mbl THEN
100.         DO
101.             getMouse
102.         LOOP WHILE mbl
103.  
104.         x0 = x0 + (mx - sw / 2) * z
105.         y0 = y0 - (sh / 2 - my) * z
106.         z = z * zz
107.         redraw = -1
108.     ELSEIF mbr THEN
109.         DO
110.             getMouse
111.         LOOP WHILE mbr
112.  
113.         x0 = x0 + (mx - sw / 2) * z
114.         y0 = y0 - (sh / 2 - my) * z
115.         z = z / zz
116.         redraw = -1
117.     END IF
118.  
119.     k = _KEYHIT
120.     IF k = 43 THEN
121.         iter = iter + 50
122.         redraw = -1
123.     ELSEIF k = 45 THEN
124.         IF iter > 50 THEN iter = iter - 50
125.         redraw = -1
126.     END IF
127.  
128. LOOP UNTIL k = 27
129. SYSTEM
130.  
131. SUB getMouse ()
132.     DO
133.         mx = _MOUSEX
134.         my = _MOUSEY
135.         mbl = _MOUSEBUTTON(1)
136.         mbr = _MOUSEBUTTON(2)
137.         mw = mw + _MOUSEWHEEL
138.     LOOP WHILE _MOUSEINPUT
139. END SUB
140.  
141. SUB cmul (u AS DOUBLE, v AS DOUBLE, x AS DOUBLE, y AS DOUBLE, a AS DOUBLE, b AS DOUBLE)
142.     uu# = x * a - y * b
143.     vv# = x * b + y * a
144.     u = uu#
145.     v = vv#
146. END SUB
147.  
148. SUB cdiv (u AS DOUBLE, v AS DOUBLE, x AS DOUBLE, y AS DOUBLE, a AS DOUBLE, b AS DOUBLE)
149.     d# = a * a + b * b
150.     uu# = (x * a + y * b) / d#
151.     vv# = (y * a - x * b) / d#
152.     u = uu#
153.     v = vv#
154. END SUB
155.  
156.  
157. 'from p5js.bas
158. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
159.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
160.  
161.     H = map(__H, 0, 255, 0, 360)
162.     S = map(__S, 0, 255, 0, 1)
163.     B = map(__B, 0, 255, 0, 1)
164.  
165.     IF S = 0 THEN
166.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
167.         EXIT FUNCTION
168.     END IF
169.  
170.     DIM fmx AS _FLOAT, fmn AS _FLOAT
171.     DIM fmd AS _FLOAT, iSextant AS INTEGER
172.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
173.  
174.     IF B > .5 THEN
175.         fmx = B - (B * S) + S
176.         fmn = B + (B * S) - S
177.     ELSE
178.         fmx = B + (B * S)
179.         fmn = B - (B * S)
180.     END IF
181.  
182.     iSextant = INT(H / 60)
183.  
184.     IF H >= 300 THEN
185.         H = H - 360
186.     END IF
187.  
188.     H = H / 60
189.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
190.  
191.     IF iSextant MOD 2 = 0 THEN
192.         fmd = (H * (fmx - fmn)) + fmn
193.     ELSE
194.         fmd = fmn - (H * (fmx - fmn))
195.     END IF
196.  
197.     imx = _ROUND(fmx * 255)
198.     imd = _ROUND(fmd * 255)
199.     imn = _ROUND(fmn * 255)
200.  
201.     SELECT CASE INT(iSextant)
202.         CASE 1
203.             hsb~& = _RGBA32(imd, imx, imn, A)
204.         CASE 2
205.             hsb~& = _RGBA32(imn, imx, imd, A)
206.         CASE 3
207.             hsb~& = _RGBA32(imn, imd, imx, A)
208.         CASE 4
209.             hsb~& = _RGBA32(imd, imn, imx, A)
210.         CASE 5
211.             hsb~& = _RGBA32(imx, imn, imd, A)
212.         CASE ELSE
213.             hsb~& = _RGBA32(imx, imd, imn, A)
214.     END SELECT
215.  
216. END FUNCTION
217.  
218. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
219.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
220. END FUNCTION
221.  
222.  

[Petr]

It's both very nice. I imagined the picture turned 90 degrees :-D and what then reminds it? :-D

[STxAxTIC]

Yeah I think he's ^ right. Turn my head 90 degrees and suddenly my middle school nickname emerges: the Cherry Explorer

[bplus]

There should be a way to preserve detail as focus in more and more (but I am thinking Mandelbrot).

I will look into it. ;)

[Ashish]

It's both very nice. I imagined the picture turned 90 degrees :-D and what then reminds it? :-D

What does it reminds?

[bplus]

Hi Ashish, It reminds me of "Paradise by the Dashboard Light" when I am remembering my adolescent days.

Here is a link to the discussion about keeping up with the detail of Mandelbrot when exploring:
There is nice formula for number of iterations needed:
http://retrogamecoding.org/board/index.php?topic=433.0

Ha! just past the 2nd anniversary of my Mandelbrot Explorer.

Next study to see if this still applies to this explorer.

[_vince]

Here is a link to the discussion about keeping up with the detail of Mandelbrot when exploring:
There is nice formula for number of iterations needed:
http://retrogamecoding.org/board/index.php?topic=433.0

Increasing the number of iterations, defined by variable iter in the code, will expose more detail in the previously black regions.  The number of iterations required to increase the detail depends on the location in the fractal and I don't think that it's a simple function of zoom level.  Eventually you might run out of DOUBLE precision and will have to implement your own higher precision routines (or use an existing library like gmplib).  There are methods to reduce the number of larger precision calculations, this technique is described in the following paper particularly for the mandelbrot set: http://superfractalthing.co.nf/sft_maths.pdf.  You could use the same method for other variants but it might be quite tricky for this case.