Burning Ship Fractal

[GWS]

Hi folks,

I came across this interesting fractal while Net browsing - I'd not heard of it before ..

So I thought I'd implement it as an alternative to the standard Mandelbrot.

If you imagine the whole picture as a big ship, and look to the rear left - there is a smaller 'ship' - click on this a few times to see the 'burning ship' effect.

Some folk have made works of art out of this routine by focussing on the colours generated and smoothing them.  Still, it's a nice result ..

Here's the program:

Code Select Expand



' Emergence Basic
' GWS Oct 2008

' The Burning Ship Fractal using DirextX 2D
' Click on the fractal to enlarge the pattern at that point.
' Click Normal to return to the standard display.

autodefine "OFF"

window w
int i,y,px,wstyle,run
int ImageWidth,ImageHeight,paint
int mx,my,test1,test2,test3,clickcount
float Z_re2,Z_im2,Z_re,Z_im,c_re,c_im
float Rfac,Ifac,scale
float Rmin,Rmax,Imin,Imax,Re,Im
pointer sprite1,spriten,spritex

ImageWidth = 1024
ImageHeight = 768

run = 1

' open the window off-screen initially to avoid flicker ..
wstyle = @NOAUTODRAW
openwindow w,-ImageWidth,0,ImageWidth,ImageHeight,wstyle,0,"Burning Ship",&handler
' create a DirectX screen (no allowance is made for the user not having DirectX - just go for it) ...
attachscreen(w,ImageWidth,ImageHeight,TRUE)

' working sprite to draw on - and to refresh from if the window needs re-painting ..
sprite1 = CREATESPRITE(ImageWidth,ImageHeight,1,1)

' create simulated flat buttons ..
' Button to return to the normal fractal display ..
spriten = CREATESPRITE(70,25,1,1)
spritetobuffer spriten
DRAWFILLEDRECT 0, 0, 70, 25, RGB(0,0,110),SpriteBuffer

' Button to Exit the program .. 
spritex = CREATESPRITE(70,25,1,1)
spritetobuffer spritex
DRAWFILLEDRECT 0, 0, 70, 25, RGB(0,0,110),SpriteBuffer

scale = 1.0
clickcount = 0

Rmin = -2.5
Rmax = 1.5
Imin = -1.0
Imax = 2.0

Rfac = (Rmax - Rmin)/(ImageWidth - 1)
Ifac = (Imax - Imin)/(ImageHeight - 1)

fillscreen RGB(0,0,50), BackBuffer

flip

gosub NewPattern

drawsprite sprite1

frontpen backbuffer,RGB(255,255,255)
drawmode backBuffer,@TRANSPARENT
setfont backBuffer,"Arial",10,700
move backBuffer,50,20
print backBuffer,"Click on the Fractal to enlarge a section."

frontpen BackBuffer,RGB(150,150,255)
backpen BackBuffer, RGB(50,50,100)
setfont BackBuffer,"Times Roman",11,700

SpriteDrawMode spriten, @TRANS
DrawSpriteXY spriten,50,560
writetext 60, 562, "Normal"

SpriteDrawMode spritex, @TRANS
DrawSpriteXY spritex,900,560
writetext 920, 562, "Exit"

flip

waituntil run = 0

FREESPRITE sprite1
FREESPRITE spriten
FREESPRITE spritex

closescreen
closewindow w

end

sub handler
select @MESSAGE
case @IDCLOSEWINDOW
    run = 0
case @IDCREATE
paint = 0
centerwindow w
case @IDLBUTTONDN
' test for a button clicked ..
mx = @MOUSEX
my = @MOUSEY

' test for Exit button clicked ..
test1 = mx > 895 and mx < 970
test2 = my > 535 and my < 565
test3 = mousedown(1)
if (test1 and test2 and test3)
run = 0
return
endif

' test for Normal button clicked ..
test1 = mx > 50 and mx < 120
test2 = my > 535 and my < 560
test3 = mousedown(1)
if (test1 and test2 and test3)

' set to display normal mandlebrot ..
clickcount = 0
Scale = 1.0
Rmin = -2.5
Rmax = 1.5
Imin = -1.0
Imax = 2.0

gosub Redraw

return
endif

' click was not on a button so ..
' the click was to select and enlarge the selected point ..
clickcount = clickcount + 1
' magnify by 5 at each click ..
Scale = clickcount * 5

' calculate the Real and Imaginary values corresponding to the point clicked ..
Re = Rmin + @mousex * Rfac
Im = Imax - @mousey * Ifac

' plot from the selected Re +/- 1.5 , and from Im -/+ 1.2
Rmin = Re - 1.5 / Scale
Rmax = Re + 1.5 / Scale
Imin = Im - 1.2 / Scale
Imax = Im + 1.2 / Scale

' recalculate the Re and Im factors for the current scale ..
gosub Redraw

case @IDPAINT
if paint = 0
paint = 1
else
drawspritexy sprite1,0,0
DrawSpriteXY spriten,50,560
DrawSpriteXY spritex,660,560
setfont BackBuffer,"Times Roman",12,600
writetext 920, 562, "Exit"
writetext 60, 562, "Normal"
flip
endif
endselect
return
endsub

sub NewPattern

float xm
int NIter
' routine to generate a new pattern ..

SpriteToBuffer(sprite1)
Fillscreen RGB(0,0,50), SpriteBuffer

LOCKBUFFER SpriteBuffer

for y = 0 to ImageHeight - 1

c_im = Imax - y * Ifac

for px = 0 to ImageWidth - 1

c_re = Rmin + px * Rfac
Z_re = c_re
Z_im = c_im

' increase the number of iterations as the scale increases ..
NIter = 20 * Scale ^ 0.5
for i = 1 to NIter

xm = i ^ 1.85
Z_re2 = Z_re * Z_re
Z_im2 = Z_im * Z_im

if (Z_re2 + Z_im2 > 5)
WritePixelFast px,y,rgb(50+xm,20+xm,155+xm),SpriteBuffer
goto break
endif

Z_im = 2 * abs(Z_re * Z_im) - c_im
Z_re = Z_re2 - Z_im2 + c_re

next i

label break

next px
next y

UNLOCKBUFFER SpriteBuffer

return
endsub

sub Redraw
' redraw the pattern after a change ..
Rfac = (Rmax -Rmin)/(ImageWidth - 1)
Ifac = (Imax -Imin)/(ImageHeight - 1)

gosub NewPattern

drawsprite sprite1

SpriteDrawMode spriten, @TRANS
DrawSpriteXY spriten,50,560
writetext 60, 562, "Normal"

SpriteDrawMode spritex, @TRANS
DrawSpriteXY spritex,900,560
WRITETEXT 920, 562, "Exit"

frontpen backbuffer,RGB(255,255,255)
drawmode backBuffer,@TRANSPARENT
setfont backBuffer,"Arial",10,600
move backBuffer,50,20
print backBuffer,"Click on the Fractal to enlarge a section."

flip

return
endsub





best wishes,

Graham

[Rock Ridge Farm (Larry)]

Interesting

Larry Sikes
http://rockridgefarm.com
Corvettes, Tractors and Guns