Black Spleenwort Fractal

[GWS]

Hi,

Here's an interesting fractal converted to decent Basic language from gobbledegook C .. 

It's a fairly complex image, yet the data needed to generate it is minimal.

By generating 100,000 random numbers, it sets a pixel at x,y co-ordinates obtained from the data stored in arrays a[] to f[].

The probability array acts as a weighting so that certain arrays are selected more often than others.

The Black Spleenwort fern is a real plant - so it's strange that such a complex shape can be expressed in a handful of numbers.

It's also interesting to note, that though the algorithm works by a series of random numbers, the resulting image is the same every time ..

Anyway, here's the code ..

Code Select Expand


' Creative Basic
' Black Spleenwort Fractal
' GWS 2013

autodefine = "off"

def w:window
def wstyle,i,j,k,run:int
def xscale,yscale,xoffset,yoffset:int
def px,py,p[4]:int

def a[4],b[4],c[4],d[4],e[4],f[4],x,y,newx:float

def Title$:string

wstyle = @minbox

' open a window ..
window w,-600,0,600,500,wstyle,0,"Creative Basic",messages
setwindowcolor w,rgb(238,232,170)
centerwindow w

control w,"B,Exit,(600-70)/2,410,70,30,0,1"

setfont w, "Arial",20,700,@sfitalic
frontpen w,rgb(10,80,255)
Title$ = "Black Spleenwort Fern Fractal"
move w,100,20
print w,Title$

a[0] = 0,0.20,-0.15,0.85
b[0] = 0,-0.26,0.28,0.04
c[0] = 0,0.23,0.26,-0.04
d[0] = 0.16,0.22,0.24,0.85
e[0] = 0,0,0,0
f[0] = 0,1.6,0.44,1.6
p[0] = 328,2621,4925,32767

xscale = 32
yscale = 32
xoffset = 300
yoffset = 40

x = 0: y = 0

for i = 1 to 100000

j = rnd(32767)

select 1
case (j < p[0])
k = 0
case (j < p[1])
k = 1
case (j < p[2])
k = 2
default
k = 3
endselect

newx = a[k] * x + b[k] * y + e[k]
y = c[k] * x + d[k] * y + f[k]
x = newx
px = x * xscale + xoffset
py = 350 - y * yscale + yoffset

if (px >= 0) & (px < 640) & (py >= 0) & (py < 400)
pset w,px,py,rgb(0,50,10)
endif

next i

run = 1

WAITUNTIL run = 0
CLOSEWINDOW w
END

SUB messages
select @class
case @idclosewindow
run = 0
case @idcontrol
select @controlID
case 1
run = 0
endselect
endselect
RETURN



Sorry the code indenting seems to go to pot while copying to the insert code block .. 

All the best,

Graham

[LarryMc]

Neat, as always.