the old mandelbrot fractal

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

the old mandelbrot fractal

Postby D.J.Peters » Jul 23, 2005 6:56

Code: Select all

' you can change it
Const scr_width  As Integer = 320 '320 640 800 ...
Const scr_height As Integer = 240 '200 480 600 ...
const fullscreen as Integer =   1 ' 0/1
Const max_itera  As Integer = 128 '64 - 256

' please don't change
Const w_last     As Integer = scr_width  - 1
Const h_last     As Integer = scr_height - 1
Const q4         As Integer = 4
Const steps      As Double  = 20
Dim As Integer anim,itera,cfade,frames,fps,help
Dim As Double two,r,rstep,i,istep,ioffset,roffset
Dim As Double r_max,r_min,i_max,i_min,rdiff,idiff,zoom
Dim As Double roffsetsoll,ioffsetsoll,zoomsoll
Dim As Double roffsetdiff,ioffsetdiff,zoomdiff
Dim As Double roffsetstep,ioffsetstep,zoomstep
Dim As Integer x2y2,col1,col2,flag,t1,t2
Dim As Integer xm,ym,l,a,x,y,work_page,visible_page = 1
Dim As Byte Ptr video_page
Dim As String k
Dim As Single rc,gc,bc,w

rdiff=3.4*scr_width/scr_height
idiff=3.4
two  =2.0
zoom =1
anim =1
cfade=1
help =1
if fullscreen then
  screenres scr_width,scr_height,,,1
  setmouse 0,0,0
else
  screenres scr_width,scr_height
end if

For l=1 To 255
  rc=Sin(w)*0.5+0.5
  gc=Cos(w*1.25)*0.5+0.5
  bc=Sin(w*1.5)*0.5+0.5
  Palette l,rc*255,gc*255,bc*255
  w=w+0.1
Next
t1=timer
'open "waypoints.txt" for append as #2
While a<>27 '[esq]=end
 
  rstep=rdiff*zoom/scr_width
  istep=idiff*zoom/scr_height
  r_min=roffset-(rdiff*zoom*0.5)
  i_min=ioffset-(idiff*zoom*0.5)
 
  video_page=screenptr
  screenlock
    asm mov edi,[video_page]
    i=i_min   
    For y=0 To h_last
      r=r_min
      For x=0 To w_last
        asm
        Xor ecx,ecx
        fld qword Ptr [r]
        fld qword Ptr [i]
        fldz
        fldz
        fld qword Ptr [two]
        fldz               
        fldz                'y,x,2,y2,x2,i,r
asm_iterastep:
        fld st(2)           '2,y,x,2,y2,x2,i,r
        fmul st(0),st(1)    '2*y
        fmul st(0),st(2)    '2*y*x
        fadd st(0),st(6)    '2*y*x+i
        fxch st(1)          'y,2*y*x*i,x,2,y2,x2,i,r
        fstp st(0)          'y,x,2,y2,x2,i,r
       
        fld st(4)           'x2    ,y,x,2,y2,x2,i,r
        fsub st(0),st(4)    'x2y2  ,y,x,2,y2,x2,i,r
        fadd st(0),st(7)    'x2y2r ,y,x,2,y2,x2,i,r
        fxch st(2)          'x,y,x2y2r,2,x2,i,r
        fstp st(0)          'y,x,2,y2,x2,i,r
       
        fld st(1)           'x,y,x,2,y2,x2,i,r
        fmul st(0)          'xx,y,x,2,y2,x2,i,r
        fxch st(5)          'x2,y,x,2,y2,xx,i,r
        fstp st(0)          'y,x,2,y2,x2,i,r
               
        fld st(0)           'y  ,y,x,2,y2,x2,i,r
        fmul st(0)          'y*y,y,x,2,y2,x2,i,r
        fxch st(4)          '
        fstp st(0)          'y,x,2,y2,x2,i,r
       
        inc ecx
        cmp ecx,max_itera
        jge asm_nomandel
               
        fld st(3)             'y2,y,x,2,y2,x2,i,r
        fadd st(0),st(5)
        fistp dword Ptr [x2y2]'y,x,2,y2,x2,i,r
        mov eax,dword Ptr [x2y2]
        cmp eax,q4 'then goto ismandel
        jg asm_ismandel
        jmp asm_iterastep

asm_nomandel:
        Xor cx,cx
asm_ismandel:
        'Shl cl,1
        mov Byte Ptr [edi],cl
       
asm_xstep:
        inc edi
       
        fstp st(0)  'x,2,y2,x2,i,r
        fstp st(0)  '2,y2,x2,i,r
        fstp st(0)  'y2,x2,i,r
        fstp st(0)  'x2,i,r
        fstp st(0)  'i,r
        fstp st(0)  'r
        fadd qword Ptr [rstep]
        fstp qword Ptr [r] 'fpu stack empty
        end asm 
      Next
      asm
      fld  qword Ptr [istep]
      fadd qword Ptr [i]
      fstp qword Ptr [i] 'fpu stack empty
      end asm
    Next
   
    if anim=0 then
      line (scr_width\2-5,scr_height\2  )-step(10,0),255
      line (scr_width\2  ,scr_height\2-5)-step(0,10),255
    end if
    if help then
      locate 1,1:color 0,0
      draw string (0, 0),"[h]           on/off helpscreen"
      draw string (0,10),"[c]           on/off colorfade"
      draw string (0,20),"[a]           on/off animation"
      draw string (0,30),"[+][-]        zoom in/out"
      draw string (0,40),"[left][right] move left/right"
      draw string (0,50),"[up]  [down]  move up  /down"
      if fps then
        draw string (0,70),"frames per second:" & fps
      end if
    end if
  screenunlock
 
  frames+=1
  if frames>=50 then
    t2=timer
    if (t2-t1)>=3.0 then
      fps=frames/(t2-t1)
      if fullscreen=0 then
        windowtitle "FPS=" & fps
      end if
      t1=t2:frames=0
    end if
  end if

  k=Inkey:l=Len(k)
  If l Then
    a=Asc(Mid(k,l,1))
    Select Case a
'     Case 13  ' [return] save curent waypoint
'        print #2,"data ";roffset;",";ioffset;",";zoom
      Case 97  ' [a] togle animation on/off
        anim=anim Xor 1
      Case 99  ' [c] togle colorfade on/off
        cfade=cfade Xor 1
      Case 104 ' [h] togle help instruction on/off
        help=help Xor 1

      ' cursor move [left][rigth][up][down]
      Case 72
        ioffset-=istep*2
      Case 80
        ioffset+=istep*2
      Case 75
        roffset-=rstep*2
      Case 77
        roffset+=rstep*2

      ' [+][-] zomm in/out
      Case 45 'zoom out
        zoom+=rstep*8
      Case 43 'zoom in
        zoom-=rstep*8
       
    End Select
  End If
  If anim Then
    If flag=0 Then
      Read roffsetsoll,ioffsetsoll,zoomsoll
      If roffsetsoll=-1.0 And ioffsetsoll=-1.0 And zoomsoll=-1.0 Then
        Restore
        Read roffsetsoll,ioffsetsoll,zoomsoll
      End If
      roffsetdiff=(roffset-roffsetsoll)/100.0
      ioffsetdiff=(ioffset-ioffsetsoll)/100.0
      zoomdiff=(zoom-zoomsoll)/100.0
      flag=100
    End If
    roffset-=roffsetdiff
    ioffset-=ioffsetdiff
    zoom-=zoomdiff
    flag-=1
  End If
  If cfade Then
    Palette Get 1,col1
    For l=1 To 254
      Palette Get l+1,col2
      Palette l,col2
    Next
    Palette 255,col1
  End If
Wend
' close waypoint file
'close #2

End

Data -1.429768163191177, 0, 0.05827402421943742
Data -1.429916265921348, 0, 2.547174155824884e-06
Data -1.447242800619238,-0.02075477953116167, 0.01853105315282292
Data -1.448491719244281,-0.01683185615982145, 0.000218250277751366
Data -1.448494962416383,-0.01685102895821514, 1.271832197158205e-05
Data -1.448540366825824,-0.01684899402669969, 1.271832197158205e-05
Data -1.448540211341738,-0.01684882329907699, 1.049950669433006e-07
Data -1.448540221908983,-0.01684881859373112, 6.686868933306398e-09
Data -1.448540221650768,-0.01684881825349504, 6.075644447976854e-10
Data -1.448540221693981,-0.01684881825349504, 8.876504632190959e-11
Data -1.448540222056144,-0.01684881831740589, 8.876504632190959e-11
Data -1.448540222056144,-0.01684881831740589, 0.0048015208111237
Data -1.447315834249308,-0.006093411700488804, 0.0048015208111237
Data -1.447575410718678,-0.006302817927879772, 0.0004362629737311815
Data -1.447546060932151,-0.006275194599384553, 0.0001150972020634162
Data -1.447549946836704,-0.006278851921316968, 1.142913103880331e-05
Data -1.447549953773961,-0.006278904154782063, 2.720492973799422e-08
Data -1.447549953773961,-0.006278904154782063, 0.0959551631790438
Data -1.847203208414673,-0.006278904154782063, 0.0959551631790438
Data -1.860985543961812, 5.730536102542537e-05, 0.02472605136870849
Data -1.861382365188764, 0.0001280447521777783, 7.575700083603683e-07
Data -1.861382300909908, 0.000128060841636056, 6.787177454139503e-10
Data -1.861382300909908, 0.000128060841636056, 1.80301591945143
Data  0.1309502900839218, 1.298299522846665, 1.80301591945143
Data -0.1984145909714904, 1.100352449330687, 0.001352409399890011
Data -0.1987733287401083, 1.100407573501614, 8.613151707517529e-05
Data -0.1987927587686087, 1.100406817836918, 1.88916174031882e-06
Data -0.1987926341447898, 1.100406706717228, 7.716645119686126e-08
Data -0.1987926374785418, 1.100406704868181, 2.620466114794424e-10
Data -0.1987926374785418, 1.100406704868181, 0.002943719650420304
Data -0.2065493387573994, 1.106765139313087, 0.002943719650420304
Data -0.206697724315536, 1.106402031123765, 0.0003491424897332628
Data -0.2067125121193846, 1.106368035391356, 1.193999868780553e-05
Data -0.2067148243436442, 1.106365903599446, 9.856968272467161e-08
Data -0.2067148338391115, 1.106365912536355, 1.396392244558323e-08
Data -0.2067148338391115, 1.106365912816002, 6.570202991474562e-10
Data -0.2067148338855405, 1.106365912816002, 4.997933986013956e-11
Data -0.2067148338502975, 1.106365912809265, 4.565903560075121e-12
Data -0.2067148338219658, 1.106365912799768, 4.565903560075121e-12
Data -0.2067148338219658, 1.106365912799768, 1.329455317510298e-07
Data -0.2067143705067878, 1.106365997884909, 1.329455317510298e-07
Data -0.2067143793444081, 1.10636599573528, 3.1423647016843e-11
Data -0.2067143793495975, 1.106365995736637, 3.391748679138347e-12
Data -0.2067143793494169, 1.106365995736712, 2.360785268886536e-13
Data -0.2067143793494169, 1.106365995736712, 8.62035957278071e-08
Data -0.2067139910022188, 1.106366050907014, 8.12035957278071e-08
Data -0.0, 1.106366050907014, 10.0
Data -0.2067139910022188, 0.0, 20.0
Data  0.0, 0.0, 1.0
Data -1.0,-1.0,-1.0
Last edited by D.J.Peters on Sep 20, 2007 20:39, edited 6 times in total.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Jul 23, 2005 7:24

Sorry bad english!

After you have finish.

Code: Select all

[esc] = exit program
[c] = togle colorfade on/off
[space] = togle animation on/off
[+] = zoom in
[-] = zoom out
[left] [up] [right] [down]  = move around


you can save your fly by removing the lines with "'"

first line is
open "waypoint.txt" for append as #2
and the line with
print #2, "Data "; roffset, ioffset, zoom
and the close command
close #2

Turn the animation off with [space] optinal colorfade too [c]
move around and zoom in/out
with [enter]/[return] you store the current position and zoom in the file.
save many waypoints and put the waypoint.txt file in the data section.

the last data line and only one must be an data -1,-1,-1

Have fun i'm too ;-)
Joshy
Last edited by D.J.Peters on Jul 24, 2005 22:45, edited 3 times in total.
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Jul 23, 2005 8:45

really amazing

"only testes on linux" =O!! ROFL
Merri
Posts: 35
Joined: Jun 19, 2005 5:18
Location: Finland
Contact:

Postby Merri » Jul 23, 2005 11:51

Nice. Atleast under Windows there is a problem that one can't close the app by pushing the close button. And yes, it runs under Windows :)
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Jul 23, 2005 14:51

hi with [esc] you can close the window.

joshy
Hexadecimal Dude!
Posts: 360
Joined: Jun 07, 2005 20:59
Location: england, somewhere around the middle
Contact:

Postby Hexadecimal Dude! » Jul 24, 2005 21:29

wow..................

id type more, but that'd waste valuable watching timev :)

o_O

ohhhh

O_o

ahhhh

etc................
jofers
Posts: 1525
Joined: May 27, 2005 17:18
Contact:

Postby jofers » Jul 24, 2005 21:47

What did I do?

Looks nice.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Jul 24, 2005 22:49

jofers wrote:What did I do?...


Nothing it was a mistake because I somewhat wrongly understood. My f*** bad english you know.

Joshy
jofers
Posts: 1525
Joined: May 27, 2005 17:18
Contact:

Postby jofers » Jul 24, 2005 23:52

Your English really isn't bad, you know. I can tell it's not your first language becuase of a few mistakes with odd English rules, but I can understand everything you write and 99% of it sound natural, without know a lick of German (well, I have "guten tag" and "hallo" nailed down pretty solid).
MystikShadows
Posts: 599
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Jul 25, 2005 0:51

Yeah I was gonna tell him that....his english is far from the worse I've seen. not bad at all.

Got a question when I try to compile this it tells me that -lmsvcrt is missing. it tells me that for just about anything I try to compile (I got FB 0.14b) Where do I get msvcrt from? cause I have VB6, VC++ 6 and a couple other things that do install mscvrt.dll....so where does it expect it to be?
DrV
Site Admin
Posts: 2116
Joined: May 27, 2005 18:39
Location: Midwestern USA
Contact:

Postby DrV » Jul 25, 2005 12:40

You have to run install.bat first... :)
Jerry Fielden
Posts: 165
Joined: May 27, 2005 14:14
Location: Marshall, Oklahoma, USA
Contact:

Postby Jerry Fielden » Jul 25, 2005 12:42

Hello Mystik,

When you unzipped into a new directory, did you type Install like you did with 13b?
MystikShadows
Posts: 599
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Jul 25, 2005 12:47

OF course I didn't....LOL....
Refine
Posts: 15
Joined: Jan 02, 2006 21:08

Postby Refine » Jan 13, 2006 9:27

An extremely impressive Mandelbrot program! The speed with which it pans and zooms is amazing!
inded005
Posts: 126
Joined: Jan 04, 2006 5:43
Location: Kingaroy Australia
Contact:

Postby inded005 » Jan 16, 2006 5:02

.....!
holy cow!

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest