Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Fraktal, optimierte Version

Uploader:Mitgliedpsygate
Datum/Zeit:11.03.2006 09:15:31

option explicit
'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

'-------------------------------------------------------------------------------
'Makros:
#Define div2(a) (a SHR 1)
#Define div4(a) (a SHR 4)

'-------------------------------------------------------------------------------
'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-div2(xmax))/magnify,(ym-div2(ymax))/magnify,julmod)
    key=inkey$
    select case key
    case "m"
        julmod=1:mandelbrot
    case "n"
        julmod=0:mandelbrot
    case "h"
        steps+=1:cls:mandelbrot:julia((xm-div2(xmax))/magnify,(ym-div2(ymax))/magnify,julmod)
    case "f"
        if steps-1>0 then steps-=1:cls:mandelbrot:julia((xm-div2(xmax))/magnify,(ym-div2(ymax))/magnify,julmod)
    case "b"
        num+=1:path="fraktal"+str$(num)+".bmp":bsave path,0
    case "a"
        screenunlock:system
    case "c"
        fade=not fade:tist=timer
    case "r"
        if tist >0 then tist=tist-0.1
    case "s"
        tist=tist+0.1
    end select
    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
                    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
                    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-div2(xmax))/magnify
            q=-(n-div2(ymax))/magnify
            x=0
            y=0
            for i=1 to its
                u=x*x-y*y+p*mandfact
                v=2*x*y+q*mandfact

                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