Simpler Fraktalcode (aber schnell)

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

M0rgenstern

Betreff: Simpler Fraktalcode (aber schnell)

 BeitragDo, Jan 07, 2010 21:26
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab vor kurzem im Zuge des infoUNterrichtes ein kleines Fraktalprogramm geschrieben.
Ist nichts besonderes, sieht nur schön aus.
Vielleicht versuch ich mich demnächst mal an einer Animation.

Das besondere an dem Code:
Rect war mir zu langsam. Also hab ich aus Line eine Funktion gebastelt, die Rect ersetzt.
Das war mir immernoch zu langsam, also habe ich mit Plot eine Funktion gebastelt, die Linien zeichnet.
Jetzt ist es um einiges schneller (Ihr könnt ja mal den Unterschied testen).

Das ganze ist rekursiv gelöst (logisch bei Fraktalen).

Hier der Code:
Code: [AUSKLAPPEN]
AppTitle "Fraktale"

Graphics 800,600,32,2

SetBuffer BackBuffer()

SeedRnd MilliSecs()



Cls
Fraktal1(20, 20, (GraphicsWidth()-20), (GraphicsHeight()-20))
Flip 0

WaitKey


Function Fraktal1(x1, y1, x2, y2) ;Hier die FUnktion für die Fraktale.
   Local x_Mitte, y_Mitte
   
   x_Mitte = Int((x1+x2)/2)
   y_Mitte = Int((y1+y2)/2)
   
   RectFake(x1, y1, x2, y2)
   
   
   RectFake(x1, y_Mitte, x_Mitte, y2)
   RectFuellen(x1, y_Mitte+1, x_Mitte, y2)
   
   
   If (x1 < x_Mitte-2) And (x_Mitte < x2-2) And (y1 < y_Mitte-2) And (y_Mitte < y2-2)  Then ;Damit sie sich nicht unendlich oft aufruft
      
      Fraktal1(x1, y1, x_Mitte, y_Mitte)
      Fraktal1(x_Mitte, y1, x2, y_Mitte)
      Fraktal1(x_Mitte, y_Mitte, x2, y2)
      
   EndIf
   
End Function


Function RectFake(x1, y1, x2, y2) ;Diese Funktion zeichnet ein Rechteck durch Linien --> schneller
   
   Color 250, 250, 250
   
   ;Line x1, y1, x2, y1 ;Der obere Teil
   FakeLine(x1, y1, x2, y1) ;Der obere Teil
   
   ;Line x2, y1, x2, y2 ;Der rechte Teil
   FakeLine(x2, y1, x2, y2) ;Der rechte Teil
   
   ;Line x1, y2, x2, y2 ;der untere Teil
   FakeLine(x1, y2, x2, y2) ;der untere Teil
   
   ;Line x1, y1, x1, y2 ;Der linke Teil
   FakeLine(x1, y1, x1, y2) ;Der linke Teil
   
End Function



Function RectFuellen(x1, y1, x2, y2) ;Damit das ganze schön bunt wird.
   
   Color 200, 50, 50
   
   ;Line(x1+1, y1, x2-1, y1)
   FakeLine(x1+1, y1, x2-1, y1)
   
   If y1 < y2- 4 Then
      
      y1 = y1 + 4
      RectFuellen(x1, y1, x2, y2)
      
   EndIf
   
End Function


Function FakeLine(x1, y1, xend, yend) ;Diese Funktion zeichent eine Linie aus Punkten. Das macht das ganze schneller
   
   Repeat
      
      Plot x1, y1
      
      If (x1 < xend) Then x1 = x1 + 1
      If (x1 > xend) Then x1 = x1 - 1
      If (y1 < yend) Then y1 = y1 + 1
      If (y1 > yend) Then y1 = y1 - 1
      
   Until (x1 = xend) And (y1 = yend)

End Function
;~IDEal Editor Parameters:
;~C#Blitz3D


Anhang: Wenn man in der FUnktion "RectFuellen" in der IFAbfrage die 4 beidemale durch eine kleinere Zahl ersetzt, dann werden die Rechtecke "flächiger" ausgefüllt.
Ersetzt man sie durch eine größere, dann erreicht man den umgekehrten Effekt.


Lg, M0rgenstern


Edit:
Würde mich natürlich über Kommentare freuen.

EDIT2:

Hier der neue Code, der sich sogar bewegt.
Ist jetzt auch mit Writepixelfast.

Code: [AUSKLAPPEN]
AppTitle "Fraktale"

Graphics 800,600,32,2

SetBuffer BackBuffer()

SeedRnd MilliSecs()
Global RGB
Global Up = 1
Global Groesse = 0
Global Timer = CreateTimer(60)
Global Zaehler = 1



Repeat
   WaitTimer(Timer)
   Cls
;LockBuffer BackBuffer()
If Up = 1 Then
   Zaehler = Zaehler + 1
   Fraktal1(10-Groesse, 10-Groesse, (GraphicsWidth()-10)+Groesse, (GraphicsHeight()-10)+Groesse)
EndIf
Text 10, 10, Groesse

;UnlockBuffer BackBuffer()
Flip 0

Until KeyDown(1)
WaitKey


Function Fraktal1(x1, y1, x2, y2) ;Hier die FUnktion für die Fraktale.
   Local x_Mitte, y_Mitte
   
   x_Mitte = Int((x1+x2)/2)
   y_Mitte = Int((y1+y2)/2)
   
   If ((x1 >= 0) And (y1 >= 0) And (x2 <= GraphicsWidth()) And (y2 <= GraphicsHeight())) Then   
      RectFake(x1, y1, x2, y2)
      
      RectFake(x1, y_Mitte, x_Mitte, y2)
      
      RectFuellen(x1, y_Mitte+1, x_Mitte, y2)
   EndIf   
      
   
   If (x1 < x_Mitte-2) And (x_Mitte < x2-2) And (y1 < y_Mitte-2) And (y_Mitte < y2-2)  Then ;Damit sie sich nicht unendlich oft aufruft
      Up = 0
      
      Fraktal1(x1, y1, x_Mitte, y_Mitte)
      
      Fraktal1(x_Mitte, y1, x2, y_Mitte)
      Fraktal1(x_Mitte, y_Mitte, x2, y2)
      
      
      
   Else
      Up = 1
      If Zaehler >= 2 Then
         Zaehler = 1
         If Groesse <= 400 Then
            Groesse = Groesse + 5
         ElseIf Groesse > 400 And Groesse <= 1200 Then
            Groesse = Groesse + 10
         ElseIf Groesse > 1200 And Groesse <= 2800 Then
            Groesse = Groesse + 25
         ElseIf Groesse > 2800 And Groesse <= 11000 Then
            Groesse = 0
            
         EndIf
      EndIf
   EndIf
   
   
End Function


Function RectFake(x1, y1, x2, y2) ;Diese Funktion zeichnet ein Rechteck durch Linien --> schneller
   
   Color 250, 250, 250
   RGB = 0*$1000000 + 250*$10000 + 250*$100 + 250
   
   ;Line x1, y1, x2, y1 ;Der obere Teil
   FakeLine(x1, y1, x2, y1) ;Der obere Teil
   
   ;Line x2, y1, x2, y2 ;Der rechte Teil
   FakeLine(x2, y1, x2, y2) ;Der rechte Teil
   
   ;Line x1, y2, x2, y2 ;der untere Teil
   FakeLine(x1, y2, x2, y2) ;der untere Teil
   
   ;Line x1, y1, x1, y2 ;Der linke Teil
   FakeLine(x1, y1, x1, y2) ;Der linke Teil
   
End Function



Function RectFuellen(x1, y1, x2, y2) ;Damit das ganze schön bunt wird.
   
   Color 200, 50, 50
   RGB = 0*$1000000 + 200*$10000 + 50*$100 + 50
   
   ;Line(x1+1, y1, x2-1, y1)
   FakeLine(x1+1, y1, x2-1, y1)
   
   If y1 < y2- 4 Then
      
      y1 = y1 + 4
      RectFuellen(x1, y1, x2, y2)
      
   EndIf
   
End Function


Function FakeLine(x1, y1, xend, yend) ;Diese Funktion zeichent eine Linie aus Punkten. Das macht das ganze schneller
   
   LockBuffer BackBuffer()
   Repeat
      
      ;Plot x1, y1
      WritePixelFast x1, y1, RGB, 0
      
      If (x1 < xend) Then x1 = x1 + 1
      If (x1 > xend) Then x1 = x1 - 1
      If (y1 < yend) Then y1 = y1 + 1
      If (y1 > yend) Then y1 = y1 - 1
      
   Until (x1 = xend) And (y1 = yend)
   UnlockBuffer BackBuffer()

End Function


Lg, M0rgenstern
  • Zuletzt bearbeitet von M0rgenstern am Fr, Jan 08, 2010 16:48, insgesamt einmal bearbeitet

Nicdel

 BeitragDo, Jan 07, 2010 22:52
Antworten mit Zitat
Benutzer-Profile anzeigen
Sieht nett aus, das mit Plot ist aber Schwachsinn (WritePixelFast wäre einiges schneller). Deine Methode braucht 842 ms, mit Line und Lockbuffer sind es nur 34 ms.
Desktop: Intel Pentium 4 2650 Mhz, 2 GB RAM, ATI Radeon HD 3850 512 MB, Windows XP
Notebook: Intel Core i7 720 QM 1.6 Ghz, 4 GB DDR3 RAM, nVidia 230M GT, Windows 7
  • Zuletzt bearbeitet von Nicdel am Fr, Jan 08, 2010 15:38, insgesamt einmal bearbeitet

M0rgenstern

 BeitragFr, Jan 08, 2010 15:35
Antworten mit Zitat
Benutzer-Profile anzeigen
Also, ich habs mit WritepixelFast versucht.
Aber irgendwie war ich zu blöd dafür.
Ich wusste nicht, was ich als Farbwert eingeben soll.
Das was in der Hilfe stand hab ich nicht richtig verstanden.
Ansonsten hätt ichs damit gemacht.
Dass es damit schneller ist, weiß ich ja. Embarassed Embarassed


Lg, m0rgenstern
 

Froggy

 BeitragFr, Jan 08, 2010 16:58
Antworten mit Zitat
Benutzer-Profile anzeigen
Benutze die Formel:

rgb = r*$10000 + g*$100 + b

wobei rgb der Farbwert ist, den du bei Writepixelfast einsetzen must und r, g, b die Farbwerte rot, grün, blau wie bei Color.

Am einfachsten, du machst die Funktion:

Code: [AUSKLAPPEN]
function rgb(r,g,b)
return r*$10000 + g*$100 + b
end function


und schreibst writepixelfast x,y,rgb(r,g,b)

M0rgenstern

 BeitragFr, Jan 08, 2010 17:06
Antworten mit Zitat
Benutzer-Profile anzeigen
Ist schon eingefügt.

Aber vielen Dank. Very Happy

Eingeproggt

 BeitragFr, Jan 08, 2010 17:51
Antworten mit Zitat
Benutzer-Profile anzeigen
Na bitte, hast es ja geschafft mit WritePixelFast Wink
Als allerletzte Verbesserung kannst du jetzt Color rausnehmen, den Befehl brauchst du nicht wenn du kein Text, Line, Rect oder Plot verwendest.
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9

ozzi789

Betreff: Optimieren

 BeitragFr, Jan 08, 2010 19:19
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi, war mal so frech und hab etwas daran rumgebastelt, mein PC benötigt jetzt nur noch etwa 6 ms (siehe sig @home)

Drückt die Leertaste und freut euch Wink

Edit: Schwankt nun zwischen 3-5 ms Very Happy
Da will ma einer sagen BB wäre nicht schnell Twisted Evil

Code: [AUSKLAPPEN]
Graphics 800,600,24,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Global RGB= 0*$1000000 + 250*$10000 + 250*$100 + 250
Global RGB2= 0*$1000000 + 200*$10000 + 50*$100 + 50
Global Up = 1
Global mg
Global Groesse = 0
Global Zaehler = 1



Repeat

   
   If KeyHit(57) psyco=psyco+1
   If psyco>2 Then  psyco=0
   
   Select psyco
      Case 0
         Cls
      Case 1
         Cls
         RGB2= 0*$1000000 + Rand(1,255)*$10000 + Rand(1,255)*$100 + Rand(1,255)
         RGB= 0*$1000000 + Rand(1,255)*$10000 +Rand(1,255)*$100 + Rand(1,255)
      Case 2
         RGB2= 0*$1000000 + Rand(1,255)*$10000 + Rand(1,255)*$100 + Rand(1,255)
         RGB= 0*$1000000 + Rand(1,255)*$10000 +Rand(1,255)*$100 + Rand(1,255)
   End Select
   
   
   LockBuffer BackBuffer()
   
   t1=MilliSecs()
   groesse=groesse+1
   Fraktal1(10-Groesse, 10-Groesse, (790)+Groesse, (590)+Groesse)
   t2=MilliSecs()
   
   UnlockBuffer BackBuffer()
   
   t3=t2-t1
   
   t=t+1
   If t=10
      AppTitle "Time 2 Render: "+t3+ " Psyco Mode is: "+psyco
      t=0
   EndIf
   
   Flip
Until KeyDown(1)
End


Function Fraktal1(x1, y1, x2, y2) ;Hier die Funktion für die Fraktale.
   Local x_Mitte, y_Mitte
   x_Mitte = ((x1+x2)/2)
   y_Mitte = ((y1+y2)/2)
   If ((x1 >= 0) And (y1 >= 0) And (x2 <= 800) And (y2 <= 600)) Then
      RectFake(x1, y1, x2, y2)
      RectFake(x1, y_Mitte, x_Mitte, y2)
      RectFuellen(x1, y_Mitte+1, x_Mitte, y2)
   EndIf
   
   If (x1 < x_Mitte-2) And (x_Mitte < x2-2) And (y1 < y_Mitte-2) And (y_Mitte < y2-2) Then ;Damit sie sich nicht unendlich oft aufruft
      Up = 0
      Fraktal1(x1, y1, x_Mitte, y_Mitte)
      Fraktal1(x_Mitte, y1, x2, y_Mitte)
      Fraktal1(x_Mitte, y_Mitte, x2, y2)
   Else
      Up = 1
      If Zaehler >= 2 Then
      Zaehler = 1
      If Groesse <= 400 Then
      Groesse = Groesse + 5
      ElseIf Groesse > 400 And Groesse <= 1200 Then
      Groesse = Groesse + 10
      ElseIf Groesse > 1200 And Groesse <= 2800 Then
      Groesse = Groesse + 25
      ElseIf Groesse > 2800 And Groesse <= 11000 Then
      Groesse = 0
      EndIf
      EndIf
   EndIf
End Function


Function RectFake(x1, y1, x2, y2) ;Diese Funktion zeichnet ein Rechteck durch Linien --> schneller
   mg=1
   FakeLine(x1, y1, x2, y1) ;Der obere Teil
   FakeLine(x2, y1, x2, y2) ;Der rechte Teil
   FakeLine(x1, y2, x2, y2) ;der untere Teil
   FakeLine(x1, y1, x1, y2) ;Der linke Teil
End Function



Function RectFuellen(x1, y1, x2, y2) ;Damit das ganze schön bunt wird.
   mg=2
   FakeLine(x1+1, y1, x2-1, y1)
   If y1 < y2- 4 Then
      y1 = y1 + 4
      RectFuellen(x1, y1, x2, y2)
   EndIf
End Function


Function FakeLine(x1, y1, xend, yend) ;Diese Funktion zeichent eine Linie aus Punkten. Das macht das ganze schneller

;LockBuffer BackBuffer()
Repeat

If mg=1 WritePixelFast x1, y1, RGB, 0
If mg=2 WritePixelFast x1, y1, RGB2, 0

If (x1 < xend) Then x1 = x1 + 1
If (x1 > xend) Then x1 = x1 - 1
If (y1 < yend) Then y1 = y1 + 1
If (y1 > yend) Then y1 = y1 - 1

Until (x1 = xend) And (y1 = yend)

;UnlockBuffer BackBuffer()



End Function   
0x2B || ! 0x2B
C# | C++13 | Java 7 | PHP 5

Eingeproggt

 BeitragFr, Jan 08, 2010 23:09
Antworten mit Zitat
Benutzer-Profile anzeigen
ozzi... ich will ja nix sagen aber bei deiner Version kommt schneller n MAV als man überhaupt checkt was da gemacht wird...
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9
 

Lion

 BeitragSa, Jan 09, 2010 1:58
Antworten mit Zitat
Benutzer-Profile anzeigen
Code: [AUSKLAPPEN]
Graphics 800,600,24,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Global RGB= 0*$1000000 + 250*$10000 + 250*$100 + 250
Global RGB2= 0*$1000000 + 200*$10000 + 50*$100 + 50
Global Up = 1
Global mg
Global Groesse = 0
Global Zaehler = 1



Repeat
   
   
   If KeyHit(57) psyco=psyco+1
      If psyco>2 Then  psyco=0
      
      Select psyco
         Case 0
            Cls
         Case 1
            Cls
            RGB2= 0*$1000000 + Rand(1,255)*$10000 + Rand(1,255)*$100 + Rand(1,255)
            RGB= 0*$1000000 + Rand(1,255)*$10000 +Rand(1,255)*$100 + Rand(1,255)
         Case 2
            RGB2= 0*$1000000 + Rand(1,255)*$10000 + Rand(1,255)*$100 + Rand(1,255)
            RGB= 0*$1000000 + Rand(1,255)*$10000 +Rand(1,255)*$100 + Rand(1,255)
      End Select
      
      
      LockBuffer BackBuffer()
      
      t1=MilliSecs()
      groesse=groesse+1
      Fraktal1(10-Groesse, 10-Groesse, (790)+Groesse, (590)+Groesse)
      t2=MilliSecs()
      
      UnlockBuffer BackBuffer()
      
      t3=t2-t1
      
      t=t+1
      If t=10
         AppTitle "Time 2 Render: "+t3+ " Psyco Mode is: "+psyco
         t=0
      EndIf
      
      Flip
   Until KeyDown(1)
   End
   
   
Function Fraktal1(x1, y1, x2, y2) ;Hier die Funktion für die Fraktale.
   Local x_Mitte, y_Mitte
   x_Mitte = ((x1+x2)/2)
   y_Mitte = ((y1+y2)/2)
   If ((x1 >= 0) And (y1 >= 0) And (x2 <= 800) And (y2 <= 600)) Then
      RectFake(x1, y1, x2, y2)
      RectFake(x1, y_Mitte, x_Mitte, y2)
      RectFuellen(x1, y_Mitte+1, x_Mitte, y2)
   EndIf
   
   If (x1 < x_Mitte-2) And (x_Mitte < x2-2) And (y1 < y_Mitte-2) And (y_Mitte < y2-2) Then ;Damit sie sich nicht unendlich oft aufruft
      Up = 0
      Fraktal1(x1, y1, x_Mitte, y_Mitte)
      Fraktal1(x_Mitte, y1, x2, y_Mitte)
      Fraktal1(x_Mitte, y_Mitte, x2, y2)
   Else
      Up = 1
      If Zaehler >= 2 Then
         Zaehler = 1
         If Groesse <= 400 Then
            Groesse = Groesse + 5
         ElseIf Groesse > 400 And Groesse <= 1200 Then
            Groesse = Groesse + 10
         ElseIf Groesse > 1200 And Groesse <= 2800 Then
            Groesse = Groesse + 25
         ElseIf Groesse > 2800 And Groesse <= 11000 Then
            Groesse = 0
         EndIf
      EndIf
   EndIf
End Function


Function RectFake(x1, y1, x2, y2) ;Diese Funktion zeichnet ein Rechteck durch Linien --> schneller
   mg=1
   FakeLine(x1, y1, x2, y1) ;Der obere Teil
   FakeLine(x2, y1, x2, y2) ;Der rechte Teil
   FakeLine(x1, y2, x2, y2) ;der untere Teil
   FakeLine(x1, y1, x1, y2) ;Der linke Teil
End Function



Function RectFuellen(x1, y1, x2, y2) ;Damit das ganze schön bunt wird.
   mg=2
   FakeLine(x1+1, y1, x2-1, y1)
   If y1 < y2- 4 Then
      y1 = y1 + 4
      RectFuellen(x1, y1, x2, y2)
   EndIf
End Function


Function FakeLine(x1, y1, xend, yend) ;Diese Funktion zeichent eine Linie aus Punkten. Das macht das ganze schneller
   
;LockBuffer BackBuffer()
   Repeat
      
      If mg=1
         If x1>0 And x1<GraphicsWidth() And y1>0 And y1<GraphicsHeight() Then
            WritePixelFast x1, y1, RGB, 0
         EndIf
      EndIf
      If mg=2
         If x1>0 And x1<GraphicsWidth() And y1>0 And y1<GraphicsHeight() Then
            WritePixelFast x1, y1, RGB2, 0
         EndIf
      EndIf
            
            If (x1 < xend) Then x1 = x1 + 1
            If (x1 > xend) Then x1 = x1 - 1
            If (y1 < yend) Then y1 = y1 + 1
            If (y1 > yend) Then y1 = y1 - 1
            
         Until (x1 = xend) And (y1 = yend)
         
;UnlockBuffer BackBuffer()
         
         
         
End Function


jetzt nicht mehr Wink
Intel Core 2 Quad 4x2.66 ghz - 4gb ddr2 - nvidia GeForce GTX660 2gb
Intel Atom 1x1.83 ghz - 2gb ddr2 - intel GMA 3150 256mb
AMD A10-5750M 4x2.5 ghz - 8 gb ddr4 - AMD R9 M290x

ozzi789

 BeitragSa, Jan 09, 2010 13:25
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich habe es etwa 5 min angehabt, bei mir gabs keine mav, naja wenns jetzt geht is ja gut Wink

Achja:
Immer Graphicswidth()/height aufrufen ist nicht umbedingt schneller als einfach 800 / 600 schreiben
0x2B || ! 0x2B
C# | C++13 | Java 7 | PHP 5

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group