Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Fraktale Kalkulation 1.1
| Uploader: |  psygate |
| Datum/Zeit: | 10.03.2006 20:28:45 |
option explicit
randomize timer
on error goto erroc
'Juliamengenu. Mandelbrot Berechnung by psygate
'Copright 2006
'-------------------------------------------------------------------------------
'types:
'-------------------------------------------------------------------------------
'Dimensions:
dim as double m,n,p,q,i,x,y,u,v,z,a,tist,fade
dim shared as string key,path
dim shared as integer steps=1,num,xmax,ymax,cycle,t,pal(256),col1,col2,l,per
dim as integer xm,ym,julmod,button
const its=1000
const mandfact=1
const magnify=120
const switch=0.1
tist=timer+switch
FADE=1
'-------------------------------------------------------------------------------
'Declarations:
declare sub julia(x0 as double,y0 as double, julmod as integer)
declare sub mandelbrot()
'-------------------------------------------------------------------------------
'Main:
screenres 1024,768,,,1
screeninfo xmax,ymax
screenlock
'for t=0 to 256
' pal(t)=rgb(255,255,255)\256*t
'next t
mandelbrot
screenunlock
while key<>"a"
if fade=1 then
if timer>tist then
screenlock
for l=0 to 255
palette get 1,col1
palette get l+1,col2
palette l,col2
palette 255,col1
next l
screenunlock
' per+=1
' path="Mandelbrotcalc"+str$(per)+".bmp"
' if per<257 then bsave path,0
tist=timer+switch
end if
end if
getmouse xm,ym,,button
screenlock
if button=1 then julia((xm-xmax/2)/magnify,(ym-ymax/2)/magnify,julmod)
key=inkey$
if key="m" then julmod=1:mandelbrot
if key="n" then julmod=0:mandelbrot
if key="h" then steps+=1:cls:mandelbrot:julia((xm-xmax/2)/magnify,(ym-ymax/2)/magnify,julmod)
if key="f" and steps-1>0 then steps-=1:cls:mandelbrot:julia((xm-xmax/2)/magnify,(ym-ymax/2)/magnify,julmod)
if key="b" then num+=1:path="fraktal"+str$(num)+".bmp":bsave path,0
if key="a" then screenunlock:system
if key="c" then fade=not fade:tist=timer
if key="r" and tist >0 then tist=tist-0.1
if key="s" then tist=tist+0.1
button=0
key=""
screenunlock
wend
system
'-------------------------------------------------------------------------------
'Subs; Functions:
sub julia(x0 as double,y0 as double,julmod as integer)
dim as double nx,ny,x,y,xn,yn,dx,dy,n,d,xb,yb,mb,l=2
dim as integer q,p,col1,col2
if julmod=0 then
for nx=0 to xmax-1 step 4
for ny=0 to ymax-1 step 4
x=4/ymax*(nx-xmax\4/2)
y=-4/ymax*(ny-ymax\4/2)
for n=1 to its
xn=x*x-y*y+x0*mandfact
yn=2*x*y+y0*mandfact
' asm
' fld qword ptr [x]
' fmul qword ptr [x]
' fstp qword ptr [xb]
' fld qword ptr [y]
' fmul qword ptr [y]
' fstp qword ptr [yb]
' fld qword ptr [x0]
' fmul qword ptr [mandfact]
' fstp qword ptr [mb]
' fld qword ptr [xb]
' fsub qword ptr [yb]
' fadd qword ptr [mb]
' fstp qword ptr [yn]
' fld qword ptr [l]
' fmul qword ptr [x]
' fmul qword ptr [y]
' fstp qword ptr [mb]
' fld qword ptr [y0]
' fmul qword ptr [mandfact]
' fadd qword ptr [mb]
' fstp qword ptr [yn]
' end asm
dx=xn-x
dy=yn-y
d=xn*xn+yn*yn
x=xn
y=yn
if d>2 then goto blank
next n
blank:
' pset(3*xmax/4+nx/4,ymax/4*3+(ny/ymax)*ymax/4),n
pset(3*xmax/4+nx/4,3*y/4+ny/4),n
next ny
next nx
elseif julmod=1 then
cls
for nx=0 to xmax step steps
for ny=0 to ymax\2 step steps
x=4/ymax*(nx-xmax\4/2)
y=-4/ymax*(ny-ymax\4/2)
for n=1 to its
xn=x*x-y*y+x0*mandfact
yn=2*x*y+y0*mandfact
' asm
' fld qword ptr [x]
' fmul qword ptr [x]
' fstp qword ptr [xb]
' fld qword ptr [y]
' fmul qword ptr [y]
' fstp qword ptr [yb]
' fld qword ptr [x0]
' fmul qword ptr [mandfact]
' fstp qword ptr [mb]
' fld qword ptr [xb]
' fsub qword ptr [yb]
' fadd qword ptr [mb]
' fstp qword ptr [yn]
' fld qword ptr [l]
' fmul qword ptr [x]
' fmul qword ptr [y]
' fstp qword ptr [mb]
' fld qword ptr [y0]
' fmul qword ptr [mandfact]
' fadd qword ptr [mb]
' fstp qword ptr [yn]
' end asm
dx=xn-x
dy=yn-y
d=xn*xn+yn*yn
x=xn
y=yn
if d>2 then goto blanker
next n
blanker:
' pset(3*xmax/4+nx/4,ymax/4*3+(ny/ymax)*ymax/4),n
pset(nx,ny),n
pset(xmax-nx,ymax-ny),n
next ny
next nx
' for q=1 to xmax step 2
' for p=1 to ymax step 2
' col1=point(x-1,y)
' col2=point(x+1,y)
' pset(q,p),col1\2+col2\2
' col1=point(x-2,y+1)
' col2=point(x-2,y+1)
' pset(q+1,p+1),col1\2+col2\2
' next p
' next q
end if
end sub
sub mandelbrot
dim as double m,n,p,q,i,x,y,u,v,z,a,l,xb,yb,mb
l=2
for m=1 to xmax step steps
for n=1 to ymax\2 step steps
p=(m-xmax/2)/magnify
q=-(n-ymax/2)/magnify
x=0
y=0
for i=1 to its
u=x*x-y*y+p*mandfact
v=2*x*y+q*mandfact
' asm
' fld qword ptr [x]
' fmul qword ptr [x]
' fstp qword ptr [xb]
' fld qword ptr [y]
' fmul qword ptr [y]
' fstp qword ptr [yb]
' fld qword ptr [p]
' fmul qword ptr [mandfact]
' fstp qword ptr [mb]
' fld qword ptr [xb]
' fsub qword ptr [yb]
' fadd qword ptr [mb]
' fstp qword ptr [u]
' fld qword ptr [l]
' fmul qword ptr [x]
' fmul qword ptr [y]
' fstp qword ptr [xb]
' fld qword ptr [q]
' fmul qword ptr [mandfact]
' fadd qword ptr [xb]
' fstp qword ptr [v]
' end asm
if u*u+v*v>4 then goto ender
x=u
y=v
next i
ender:
pset(m,n),i
pset(m,ymax-n),i
next n
next m
end sub
'-------------------------------------------------------------------------------
'on error:
system
erroc:
screen 12
print "Sorry, an error killed the program."
sleep 5,1
system
systemer:
screenunlock
system