QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on February 29, 2020, 08:14:23 pm

Title: Mandelbrot generator
Post by: Richard Frost on February 29, 2020, 08:14:23 pm

1) Why is this "fuzzy" despite using double precision floats?
2) Why can't I save actual colors?  (SaveImage modified from a sub I got here)

Code: QB64: [Select]

1. _TITLE "Mandelbrots"
2.  
3. ' Keys detected while image generating - no need to wait to end
4.  
5. ' arrow keys - move image
6. ' +/- zoom in/out
7. ' c to change colors
8. ' o for master set
9. ' z color band
10. ' s save image
11. ' spacebar start new
12.  
13. DEFINT A-Z
14. COMMON SHARED xm, ym
15. DIM SHARED cp&(256), c(2), d(2)
16. GOSUB init
17. it1& = 100: it2& = 100
18. DO
19.     begin:
20.     it0& = it1&
21.     GOSUB GenNums
22.     it0& = it2&
23.     b2:
24.     IF restart = 0 THEN GOSUB ChangeColors
25.     restart = 0
26.     CLS
27.     lr = 0: ud = 0
28.     FOR y = 0 TO ym
29.         FOR x = 0 TO xm
30.             GOSUB set
31.         NEXT x
32.         GOSUB Scan
33.         IF restart THEN GOTO b2
34.         IF i$ = " " THEN GOTO begin
35.         IF i$ = "c" THEN GOTO b2
36.         IF i$ = "z" THEN sp = sp XOR 1: GOTO b2
37.     NEXT y
38.     GOSUB ShowPoint
39.     DO: _LIMIT 10
40.         GOSUB Scan
41.         IF restart THEN GOTO b2
42.         IF i$ = "c" THEN GOTO b2
43.         IF i$ = "s" THEN GOSUB SaveIt
44.         IF i$ = "z" THEN sp = sp XOR 1: GOTO b2
45.     LOOP UNTIL (i$ = CHR$(13)) OR (i$ = CHR$(32))
46. LOOP
47. ' ------------------------------------------------------------------------------------------------------------
48. Scan:
49. i$ = INKEY$
50. IF LEN(i$) = 1 THEN
51.     IF i$ = CHR$(27) THEN SYSTEM
52.     IF INSTR("+-", i$) THEN
53.         xm## = (x1## + x2##) / 2
54.         ym## = (y1## + y2##) / 2
55.         xd## = ABS(x2## - x1##)
56.         yd## = ABS(y2## - y1##)
57.         IF i$ = "-" THEN
58.             x1## = xm## - xd##: x2## = xm## + xd##
59.             y1## = ym## - yd##: y2## = ym## + yd##
60.         ELSE
61.             WINDOW SCREEN(x1##, y1##)-(x2##, y2##)
62.             x1## = xm## - xd## / 8: x2## = xm## + xd## / 8
63.             y1## = ym## - yd## / 8: y2## = ym## + yd## / 8
64.             LINE (x1##, y1##)-(x2##, y2##), _RGB(255, 255, 255), B
65.             WINDOW
66.             w! = TIMER + 2
67.             DO: _LIMIT 10
68.                 i$ = INKEY$
69.             LOOP UNTIL (TIMER > w!) OR (LEN(i$) > 0)
70.             IF i$ = CHR$(27) THEN END
71.         END IF
72.         xd## = (x2## - x1##) / xm
73.         yd## = (y2## - y1##) / ym
74.         restart = 1
75.     END IF
76.     IF i$ = "o" THEN
77.         x1## = mx1!
78.         x2## = mx2!
79.         y1## = my1!
80.         y2## = my2!
81.         xd## = (x2## - x1##) / xm
82.         yd## = (y2## - y1##) / ym
83.         restart = 1
84.     END IF
85. END IF
86. IF LEN(i$) = 2 THEN
87.     k = ASC(RIGHT$(i$, 1))
88.     lr = (k = 77) - (k = 75) '                   left/right arrows
89.     ud = (k = 80) - (k = 72) '                   up and down arrow
90.     IF lr OR ud THEN
91.         x1## = x1## + xd## / 10 * lr * xm
92.         y1## = y1## + yd## / 10 * ud * ym
93.         restart = 1
94.     END IF
95. END IF
96. RETURN
97. ' ------------------------------------------------------------------------------------------------------------
98. GenNums:
99. x1## = mx1! + RND * (mx2! - mx1!)
100. y1## = my1! + RND * (my2! - my1!)
101. q = RND * 999 + 100
102. x2## = x1## + (1 / q)
103. y2## = y1## + (1 / q)
104. xd## = (x2## - x1##) / xm
105. yd## = (y2## - y1##) / ym
106. y = 400: oc = -1: nc = 0
107. FOR z = -320 TO 320 STEP 20
108.     x = 640 + z
109.     GOSUB set
110.     GOSUB Scan
111.     IF c <> oc THEN oc = c: nc = nc + 1
112. NEXT z
113. IF nc < 10 THEN GOTO GenNums '                   must detect 10 color changes to exit
114. RETURN
115. ' ------------------------------------------------------------------------------------------------------------
116. init:
117. mx1! = -2
118. mx2! = .6
119. my1! = -1.25
120. my2! = 1.25
121. xm = 1280: ym = 800
122. RANDOMIZE TIMER
123. SCREEN _NEWIMAGE(xm, ym, 256)
124. GOSUB ChangeColors
125. _FULLSCREEN
126. _MOUSEHIDE
127. RETURN
128. ' ------------------------------------------------------------------------------------------------------------
129. set:
130. MandelX## = x1## + x * xd##
131. MandelY## = y1## + y * yd##
132. Real## = 0
133. Imag## = 0
134. Size## = -1
135. iter& = it0&
136. $CHECKING:OFF
137. DO
138.     iter& = iter& - 1
139.     hold## = Imag##
140.     Imag## = Real## * Imag## * 2 + MandelY##
141.     Real## = Real## * Real## - hold## * hold## + MandelX##
142.     Size## = (Real## * Real## + Imag## * Imag##) - 99
143. LOOP UNTIL (iter& = 0) OR (Size## >= 0)
144. $CHECKING:ON
145. c = (iter& MOD 255) + 1
146. IF iter& = 0 THEN c = 0
147. PSET (x, y), cp&(c)
148. RETURN
149. ' ------------------------------------------------------------------------------------------------------------
150. ChangeColors:
151. CLS
152. IF sp THEN nn = 2 ELSE nn = 20
153. FOR i = 0 TO 2
154.     c(i) = RND * 250 + 2
155.     d(i) = RND * nn + 1
156. NEXT i
157. FOR i = 1 TO 255
158.     FOR j = 0 TO 2
159.         c(j) = c(j) + d(j)
160.         IF (c(j) < 0) OR (c(j) > 255) THEN
161.             d(j) = -d(j)
162.             c(j) = c(j) + d(j)
163.         END IF
164.     NEXT j
165.     cp&(i) = _RGB32(c(0), c(1), c(2))
166. NEXT i
167. RETURN
168. ' ------------------------------------------------------------------------------------------------------------
169. SaveIt:
170. image = image + 1
171. f$ = "fra" + RIGHT$("00000" + LTRIM$(STR$(image)), 5) + ".bmp"
172. IF _FILEEXISTS(f$) THEN GOTO SaveIt
173. SaveImage f$
174. SOUND 3000, 1
175. RETURN
176. ' ------------------------------------------------------------------------------------------------------------
177. ShowPoint:
178. qq = 8
179. xm = xm / qq: ym = ym / qq
180. sx1## = x1##: sx2## = x2##: sy1## = y1##: sy2## = y2##: sxd## = xd##: syd## = yd##
181. xm## = (x1## + x2##) / 2
182. ym## = (y1## + y2##) / 2
183. x1## = -2
184. x2## = .6
185. y1## = -1.25
186. y2## = 1.25
187. xd## = (x2## - x1##) / xm
188. yd## = (y2## - y1##) / ym
189. it0& = it1&
190. FOR y = 0 TO ym
191.     FOR x = 0 TO xm
192.         GOSUB set
193.     NEXT x
194. NEXT y
195. it0& = it2&
196. LINE (0, 0)-(xm, ym), _RGB(255, 255, 255), B
197. WINDOW SCREEN(x1##, y1##)-(x2##, y2##)
198. tx = PMAP(xm##, 0) \ qq
199. ty = PMAP(ym##, 1) \ qq
200. WINDOW
201. LINE (tx - 4, ty - 4)-(tx + 4, ty + 4), _RGB(255, 255, 255), B
202. xm = 1280: ym = 800 '
203. x1## = sx1##: x2## = sx2##: y1## = sy1##: y2## = sy2##: xd## = sxd##: yd## = syd##
204. RETURN
205. ' -----------------------------------------------------------------------------------------------------------------
206. SUB SaveImage (f$)
207.     b$ = "BM????_RGF????" + MKL$(40) + MKL$(xm) + MKL$(ym) + MKI$(1) + MKI$(8) + MKL$(0) + "????" + STRING$(16, 0)
208.     FOR i = 0 TO 255
209.         c& = cp&(i) '                                                save a little typing for next line
210.         b$ = b$ + CHR$(_BLUE32(c&)) + CHR$(_GREEN32(c&)) + CHR$(_RED32(c&)) + CHR$(0) 'spacer byte
211.     NEXT
212.     MID$(b$, 11, 4) = MKL$(LEN(b$)) '                                image pixel data offset (BMP header)
213.     FOR py = ym - 1 TO 0 STEP -1
214.         z$ = ""
215.         FOR px = 0 TO xm - 1
216.             c& = POINT(px, py)
217.             IF if_I_had_a_brain THEN '                               attempt to save ACTUAL colors (doesn't work!)
218.                 FOR i = 0 TO 255
219.                     IF c& = cp&(i) THEN hit = i: EXIT FOR
220.                 NEXT i
221.                 z$ = z$ + CHR$(hit)
222.             ELSE
223.                 z$ = z$ + CHR$(ABS(c&) MOD 256)
224.             END IF
225.         NEXT px
226.         d$ = d$ + z$
227.     NEXT py
228.     MID$(b$, 35, 4) = MKL$(LEN(d$)) '                                image size (BMP header)
229.     b$ = b$ + d$ '                                                   total file data bytes to create file
230.     MID$(b$, 3, 4) = MKL$(LEN(b$)) '                                 size of data file (BMP header)
231.     f& = FREEFILE
232.     OPEN f$ FOR OUTPUT AS #f&: CLOSE #f& '                           erases an existing file
233.     OPEN f$ FOR BINARY AS #f&
234.     PUT #f&, , b$
235.     CLOSE #f&
236. END SUB
237.  

Title: Re: Mandelbrot generator
Post by: bplus on February 29, 2020, 09:02:46 pm

Quote

1) Why is this "fuzzy" despite using double precision floats?

Are the WINDOW width, height commands you are using for zooming staying proportional to the actual screen width and height? The thumbnail map is definitely getting stretched along x axis compared to y.

BTW it's a pretty nice program.

Title: Re: Mandelbrot generator
Post by: _vince on March 02, 2020, 12:43:06 am

here is mine, it is mouse driven: left, right mouse zoom in out, +/- increase decrease iterations, scrollwheel change zoom window

Code: [Select]

defint a-z

const sw = 640
const sh = 480

dim shared mx,my,mbl,mbr,mw

dim u as double, v as double
dim uu as double, vv as double
dim xx as double, yy as double
dim x0 as double, y0 as double
dim z as double, zz as double
z = 0.01
zz = 0.1

dim p1 as long
p1 = _newimage(sw, sh, 32)
screen _newimage(sw, sh, 32)

redraw = -1
iter = 100

dim c(100) as long, cc as long

for i=0 to iter-1
        if i < iter/6 then
                r = 155
                g = (i mod (iter/6))*(255/(iter/6))
                b = 0
        elseif i < 2*iter/6 then
                r = 155 - (i mod (iter/6))*(255/(iter/6))
                g = 155
                b = 0
        elseif i < 3*iter/6 then
                r = 0
                g = 155
                b = (i mod (iter/6))*(255/(iter/6))
        elseif i < 4*iter/6 then
                r = 0
                g = 155 - (i mod (iter/6))*(255/(iter/6))
                b = 155
        elseif i < 5*iter/6 then
                r = (i mod (iter/6))*(255/(iter/6))
                g = 0
                b = 155
        else
                r = 155
                g = 0
                b = 155 - (i mod (iter/6))*(255/(iter/6))
        end if
        c(i) = _rgb(r, g, b)
next

do
        mw = 0
        getmouse

        if redraw then
                for y = 0 to sh-1
                for x = 0 to sw-1
                        u = 0
                        v = 0

                        xx = (x - sw/2)*z + x0
                        yy = (y - sh/2)*z + y0
                        for i = 0 to iter
                                '''mandelbrot
                                u = u
                                v = v
                                uu = u*u - v*v + xx
                                vv = 2*u*v + yy
                                '''

                                '''burning ship
                                'u = abs(u)
                                'v = abs(v)
                                'uu = u*u - v*v + xx
                                'vv = 2*u*v + yy
                                '''

                                '''tricorn
                                'u = u
                                'v = -v
                                'uu = u*u - v*v + xx
                                'vv = 2*u*v + yy
                                '''

                                '''tetration
                                'u = u
                                'v = v
                                'cexp uu, vv, u, v, u, v
                                'cexp uu, vv, uu, vv, xx, yy
                                '''

                                u = uu
                                v = vv

                                if (u*u + v*v) > 4 then exit for
                        next
                        if i > iter then
                                pset(x, y), _rgb(0,0,0)
                        else
                                pset(x, y), c(i mod 100)
                        end if
                next
                next

                'locate 1,1
                'print "iter =";iter
                _title str$(iter)

                _dest p1
                _putimage , 0
                _dest 0

                _putimage , p1
                _autodisplay

                redraw = 0
        end if

        if mw < 0 then
                zz = zz + 0.01
        elseif mw > 0 then
                if zz > 0.01 then zz = zz - 0.01
        end if

        'draw box
        if omx <> mx or omy <> my or mw <> 0 then
                _putimage , p1
                line (mx - (sw*zz/2), my - (sh*zz/2))-step(sw*zz,sh*zz),_rgb(255,255,255),b
                _autodisplay

                omx = mx
                omy = my
        end if

        if mbl then
                do
                        getMouse
                loop while mbl

                x0 = x0 + (mx - sw/2)*z
                y0 = y0 - (sh/2 - my)*z
                z = z*zz
                redraw = -1
        elseif mbr then
                do
                        getMouse
                loop while mbr

                x0 = x0 + (mx - sw/2)*z
                y0 = y0 - (sh/2 - my)*z
                z = z/zz
                redraw = -1
        end if

        k = _keyhit
        if k = 43 then
                iter = iter + 50
                redraw = -1
        elseif k = 45 then
                if iter > 50 then iter = iter - 50
                redraw = -1
        end if

loop until k = 27
system

sub getmouse ()
        do
                mx = _mousex
                my = _mousey
                mbl = _mousebutton(1)
                mbr = _mousebutton(2)
                mw = mw + _mousewheel
        loop while _mouseinput
end sub

'u + iv = (x + iy) ^ (a + ib)
sub cexp (u as double, v as double, x as double, y as double, a as double, b as double)
        dim mag as double, arg as double
        dim lnz as double, argz as double

        lnz = 0.5*log((x*x + y*y)+0.00001)
        argz = _atan2(y, x)

        mag = exp(a*lnz - b*argz)
        arg = a*argz + b*lnz

        u = mag * cos(arg)
        v = mag * sin(arg)
end sub


Title: Re: Mandelbrot generator
Post by: Richard Frost on March 02, 2020, 01:19:22 am

Adding "/ 1.6" to line 103 makes it proportional, and it's still fuzzy.  I didn't change the code here. 

Thanks for the idea.  I sure don't have a clue.

Title: Re: Mandelbrot generator
Post by: Richard Frost on March 02, 2020, 02:47:07 am

A super fast and option laden Mandelbrot generator that Vince suggested to
me (Kalle's) is also fuzzy, even after drastically upping the iterations.

Yet I see lots of images online that are NOT fuzzy. 

So it appears there's nothing wrong my code.  It's the whole approach!

There must be a better way, and Vince seems to have it.  His is much less fuzzy.
I think it's his color selection.  Fewer, yet smarter?   Haven't figured it out yet.

Likely the Kalle program's defaults do not give good results....

Title: Re: Mandelbrot generator
Post by: _vince on March 02, 2020, 09:58:18 am

Here's that program i brought up in chat: https://mathr.co.uk/kf/kf.html (https://mathr.co.uk/kf/kf.html), it is the best program for exploring the mandelbrot set. It is amazing because you can zoom in practically forever. With the superficial method, you will eventually run out of floating point precision requiring the use of a arbitrary precision routines or library (GMP, etc) but it would be too slow to do for every point. So the program uses a technique to calculate just one arbitrary precision point and series approximates the rest of the screen, more on this: https://mathr.co.uk/mandelbrot/perturbation.pdf (https://mathr.co.uk/mandelbrot/perturbation.pdf).

I guess the reason it looks 'fuzzy' is because it will do a sort of rough 'digital zoom' to keep up with your zooming before it fills it in with detail, mine will render it entirely for every zoom.

Edit: I've noticed disabling _FULLSCREEN makes it look right, not "fuzzy"

Title: Re: Mandelbrot generator
Post by: bplus on March 02, 2020, 11:17:16 pm

Oh man it was on _FULLSCREEN? I looked for that, yeah much better without!

Text Only | Text with Attachments