Fraktal Kollektion
Übersicht
BlitzBasic Codearchiv
|
JoelBetreff: Fraktal Kollektion |
 Sa, Apr 09, 2011 19:00Antworten mit Zitat 
|
|---|---|---|
|
Ich beschäftigte mich in letzter Zeit etwas mit Fraktalen.
Nun habe ich schon 5 verschiedene Fraktale zusammen. Da ich keine Lust habe das Codearchiv mit 5 einträgen vollzumüllen, packe ich mal alles in einen. Die Codes sind gemischt in BM und B3D 1. Mandelbrot/Apfelmännchen(BM) Tasten A/Y iterationen erhöhen/verringern Rechte Maustaste/Linke Maustaste reinzoomen/rauszoomen Code: [AUSKLAPPEN] SuperStrict
Global Timer:TTimer = CreateTimer(15) Global MaxEbene:Int = 100 Global Color:Float Global ColorFact:Float=255/MaxEbene Global GX:Double=400 Global GY:Double=300 Graphics GX,GY Print 3/GX Local millis:Int=MilliSecs() Global Grosse:Double = 5 / GX Global FracX:Double = GX / 2, DistX:Double Global FracY:Double = GY / 2, DistY:Double Global MitteX:Int = GX / 2, MitteY:Int = GY / 2 Global Update:Int=1 While Not KeyHit(KEY_ESCAPE) Control() If Update = 1 For Local X:Int = 0 Until GX For Local Y:Int = 0 Until GY MandelBrot(0, 0, (X - FracX) * Grosse, (Y - FracY) * Grosse) SetColor((ColorFact * Color) * 1, (ColorFact * Color) * 0, (ColorFact * Color) * 0) Plot X, Y If KeyHit(KEY_SPACE) Then Exit Next Flip 0 Next Update = 0 EndIf'Render WaitTimer(Timer) Wend Function MandelBrot(m:Double,mi:Double,c:Double,ci:Double,Ebene:Int=0) Local m1:Double,mi1:Double Repeat If Ebene=MaxEbene Then Color=0 Return ebene=ebene+1 m1=(m^2-mi^2)-c mi1=2*m*mi+ci m=m1 mi=mi1 Until Sqr(m1^2+mi1^2)=>2 Color=Ebene Return EndFunction Function Control() If MouseHit(1) Grosse = Grosse * 0.25 DistX = (FracX - MouseX()) * 4 DistY = (FracY - MouseY()) * 4 FracX = MitteX + DistX FracY = MitteY + DistY Update = 1 EndIf If MouseHit(2) Grosse = Grosse * 4 DistX = (FracX - MouseX()) * 0.25 DistY = (FracY - MouseY()) * 0.25 FracX = MitteX + DistX FracY = MitteY + DistY Update = 1 EndIf If KeyHit(KEY_A) Then MaxEbene = MaxEbene + 10 Update = 1 If KeyHit(KEY_Y) Then MaxEbene = MaxEbene - 10 Update = 1 If KeyHit(KEY_S) Then Screenshot() End Function Function Screenshot() DrawText "Bitte Warten...", 0, 0 Print "START" Flip 0 Local Pixmap:TPixmap = CreatePixmap(1280, 1024, PF_RGB888) For Local X:Int = 0 Until 1280 For Local Y:Int = 0 Until 1024 MandelBrot(0, 0, (X - FracX * 3.2) * Grosse / 3.2, (Y - FracY * 3.2) * Grosse / 3.2) WritePixel(Pixmap, X, Y, ColorFact * Color * $10000 + ColorFact * Color * 0.5 * $100 + 0) If KeyHit(KEY_SPACE) Then Exit Next Next SavePixmapPNG(Pixmap, "Mandelbrot.png", 9) DrawText "Mandelbrot.png Gespeichert.", 0, 0 Print "COMPLETE" Flip 0 End Function 2. Sierpinski Tepich (auch BM) Code: [AUSKLAPPEN] Global GraphXY = 243
Graphics GraphXY, GraphXY Local Timer:TTimer = CreateTimer(30) Global PMap:TPixmap = CreatePixmap(GraphXY, GraphXY, PF_I8) ClearPixels(PMap, $FFFFFF) Local XYKante:Float = GraphXY / 3 While Not KeyHit(KEY_ESCAPE) If XYKante >= GraphXY - 5 Then XYKante = GraphXY / 3 Else XYKante = XYKante / 0.99 SierpinskiTeppich(1, 5, XYKante, XYKante, XYKante) DrawPixmap(PMap, 0, 0) ClearPixels(PMap, $FFFFFF) Flip 0 Cls WaitTimer(Timer) Wend Function SierpinskiTeppich(ae:Int, me:Int, x:Float, y:Float, kante:Float) If ae <= me DrawPixRect(x, y, kante) kante = kante / 3 ae = ae + 1 SierpinskiTeppich(ae, me, x - kante * 2, y - kante * 2, kante)'lo SierpinskiTeppich(ae, me, x + kante, y - kante * 2, kante)'mo SierpinskiTeppich(ae, me, x + kante * 4, y - kante * 2, kante)' ro SierpinskiTeppich(ae, me, x + kante * 4, y + kante, kante)'rm SierpinskiTeppich(ae, me, x + kante * 4, y + kante * 4, kante)'ru SierpinskiTeppich(ae, me, x + kante, y + kante * 4, kante)'mu SierpinskiTeppich(ae, me, x - kante * 2, y + kante * 4, kante)'lu SierpinskiTeppich(ae, me, x - kante * 2, y + kante, kante)'lm EndIf Return End Function Function DrawPixRect(xpos, ypos, kante) For Local x = xpos Until kante + xpos For Local y = ypos Until kante + ypos If x < GraphXY And y < GraphXY WritePixel(PMap, x, y, $000000) EndIf Next Next End Function 3. Fraktal Baum oder wie auch immer(B3D) Code: [AUSKLAPPEN] Graphics 800,600,16,2
SetBuffer BackBuffer() timer=CreateTimer(30) Const AnfangsWinkel=90 Global AnderungsWinkel=67 Global Scale#=0.75 Global Grosse#=100 Global Ebenen=10 Global X=400 Global Y=550 Global update=1 Global MZSpeed While Not KeyHit(1) MZSpeed=MouseZSpeed() TastenAbfragen If update=1 Cls Text 0,0,"A und Y um abweichungswinkel zu ändern. Aktuell: "+AnderungsWinkel Text 0,10,"S und X um relative Skalierung zu ändern. Aktuell: "+Scale Text 0,20,"D und C um Anzahl ebenen zu wechseln. Aktuell: "+Ebenen Text 0,30,"Mausrad um zu Skalieren. Aktuell: "+Grosse Text 0,40,"Pfeiltasten um zu Bewegen. Aktuell: "+X+","+Y LockBuffer BackBuffer() FraktalBaum(X,Y,1,Ebenen,Grosse,Scale,AnfangsWinkel,AnderungsWinkel) UnlockBuffer BackBuffer() update=0 EndIf WaitTimer timer Flip 0 Wend End Function FraktalBaum(x,y,ae,me,size#,scale#,aw,wa) Local w,x2,y2 If ae<=me x2=x+Cos(aw)*size y2=y-Sin(aw)*size Line x,y,x2,y2 ae=ae+1 w=aw-wa FraktalBaum(x2,y2,ae,me,size*scale,scale,w,wa) w=aw+wa FraktalBaum(x2,y2,ae,me,size*scale,scale,w,wa) EndIf Return 0 End Function Function TastenAbfragen() If MZSpeed<>0 Grosse=Grosse+(Grosse*MZSpeed)/10 update=1 EndIf If KeyDown(203)Or KeyDown(205) X=X+KeyDown(203)*10-KeyDown(205)*10 update=1 EndIf If KeyDown(200)Or KeyDown(208) Y=Y+KeyDown(200)*10-KeyDown(208)*10 update=1 EndIf If KeyDown(30)Or KeyDown(44) AnderungsWinkel=AnderungsWinkel+KeyDown(30)-KeyDown(44) update=1 EndIf If KeyHit(32) Ebenen=Ebenen+1 update=1 Else If KeyHit(46) Ebenen=Ebenen-1 update=1 EndIf If KeyDown(31) Scale=Scale+0.01 update=1 Else If KeyDown(45) Scale=Scale-0.01 update=1 EndIf End Function 4. Fraktal Baum in 3D (B3D) - nicht Perfekt Code: [AUSKLAPPEN] Graphics3D 800,600,0,2
SetBuffer BackBuffer() Global timer=CreateTimer(60) Global camera=CreateCamera() MoveEntity camera,0,0,-100 CameraRange camera,0.05,2000 Global winkel=90 While Not KeyHit(1);pitch=>z-achse yaw=>y-achse LockBuffer BackBuffer() FraktalBaum3D(0,0,0,0,5,200,0.5,0,90,winkel,winkel) UnlockBuffer BackBuffer() winkel=winkel+KeyDown(30)-KeyDown(44) MoveEntity camera,KeyDown(205)*4-KeyDown(203)*4,0,KeyDown(200)*4-KeyDown(208)*4 If MouseDown(2) TurnEntity camera,MouseYSpeed(),-MouseXSpeed(),0 EndIf MoveMouse 100,100 Text 0,0,winkel Flip 0 WaitTimer timer Cls Wend End Function FraktalBaum3D(x#,y#,z#,ae,me,size#,scale#,APitch,AYaw,BPitch,BYaw) Local x2,y2,z2,Pitch,Yaw If ae<=me x2=x+size*Cos(APitch)*Cos(AYaw) y2=y+size*Sin(AYaw) z2=z+size*Sin(APitch)*Cos(AYaw) Line3D x,y,z,x2,y2,z2 ae=ae+1 Pitch=APitch+BPitch Yaw=AYaw+BYaw FraktalBaum3D(x2,y2,z2,ae,me,size*scale,scale,Pitch,Yaw,BPitch,BYaw) Pitch=APitch-BPitch Yaw=AYaw-BYaw FraktalBaum3D(x2,y2,z2,ae,me,size*scale,scale,Pitch,Yaw,BPitch,BYaw) Pitch=APitch+BPitch Yaw=AYaw-BYaw FraktalBaum3D(x2,y2,z2,ae,me,size*scale,scale,Pitch,Yaw,BPitch,BYaw) Pitch=APitch-BPitch Yaw=AYaw+BYaw FraktalBaum3D(x2,y2,z2,ae,me,size*scale,scale,Pitch,Yaw,BPitch,BYaw) EndIf Return End Function Function Line3D(x,y,z,x2,y2,z2) Local x2d,y2d CameraProject camera,x,y,z x2d=ProjectedX() y2d=ProjectedY() CameraProject camera,x2,y2,z2 If Not(x2d=0 And y2d=0) Or (ProjectedX()=0 And ProjectedY()=0) Line x2d,y2d,ProjectedX(),ProjectedY() EndIf End Function und 5. Koch-Kurve 3D(B3D)leider nur 4 iterationen möglich, nicht sehr elegant gelöst Code: [AUSKLAPPEN] Graphics3D 800,600,16,2
Global Timer=CreateTimer(60) Global Camera=CreateCamera() PositionEntity Camera,0,0,-10 Local LightPiv=CreatePivot() PositionEntity LightPiv,364.6,-121.5,364.5 Local Light=CreateLight(2,LightPiv) PositionEntity(Light,1000,-243,364.5) Global KochMesh=CreateMesh() Global surface=CreateSurface(KochMesh) CreateQuad(729) CameraRange Camera,0.1,1000 KochKurve3D(1,4,364.5,-121.5,364.5) UpdateNormals(KochMesh) While Not KeyHit(1) MoveEntity Camera,KeyDown(205)*2-KeyDown(203)*2,0,KeyDown(200)*2-KeyDown(208)*2 TurnEntity Camera,MouseYSpeed(),-MouseXSpeed(),0 TurnEntity LightPiv,0,1,0 MoveMouse 100,100 WaitTimer Timer RenderWorld Text 0,0,TrisRendered() Flip 0 Wend End Function KochKurve3D(ae,me,x#,y#,z#,top=1,kante#=243);top 0=x,1=y,2=z;3=-x,4=-y,5=-z If ae<=me AddCube(x,y,z,kante,top) ae=ae+1 Select top Case 0 KochKurve3D(ae,me,x+kante/3,y-kante,z-kante,top,kante/3) KochKurve3D(ae,me,x+kante/3,y,z-kante,top,kante/3) KochKurve3D(ae,me,x+kante/3,y+kante,z-kante,top,kante/3) KochKurve3D(ae,me,x+kante/3,y+kante,z,top,kante/3) KochKurve3D(ae,me,x+kante/3,y+kante,z+kante,top,kante/3) KochKurve3D(ae,me,x+kante/3,y,z+kante,top,kante/3) KochKurve3D(ae,me,x+kante/3,y-kante,z+kante,top,kante/3) KochKurve3D(ae,me,x+kante/3,y-kante,z,top,kante/3) KochKurve3D(ae,me,x-kante/3*2,y,z,top,kante/3) KochKurve3D(ae,me,x,y-kante/3*2,z,1,kante/3) KochKurve3D(ae,me,x,y+kante/3*2,z,4,kante/3) KochKurve3D(ae,me,x,y,z-kante/3*2,2,kante/3) KochKurve3D(ae,me,x,y,z+kante/3*2,5,kante/3) Case 1 KochKurve3D(ae,me,x-kante,y+kante/3,z-kante,top,kante/3) KochKurve3D(ae,me,x,y+kante/3,z-kante,top,kante/3) KochKurve3D(ae,me,x+kante,y+kante/3,z-kante,top,kante/3) KochKurve3D(ae,me,x+kante,y+kante/3,z,top,kante/3) KochKurve3D(ae,me,x+kante,y+kante/3,z+kante,top,kante/3) KochKurve3D(ae,me,x,y+kante/3,z+kante,top,kante/3) KochKurve3D(ae,me,x-kante,y+kante/3,z+kante,top,kante/3) KochKurve3D(ae,me,x-kante,y+kante/3,z,top,kante/3) KochKurve3D(ae,me,x,y-kante/3*2,z,top,kante/3) KochKurve3D(ae,me,x-kante/3*2,y,z,0,kante/3) KochKurve3D(ae,me,x+kante/3*2,y,z,3,kante/3) KochKurve3D(ae,me,x,y,z-kante/3*2,2,kante/3) KochKurve3D(ae,me,x,y,z+kante/3*2,5,kante/3) Case 2 KochKurve3D(ae,me,x-kante,y-kante,z+kante/3,top,kante/3) KochKurve3D(ae,me,x,y-kante,z+kante/3,top,kante/3) KochKurve3D(ae,me,x+kante,y-kante,z+kante/3,top,kante/3) KochKurve3D(ae,me,x+kante,y,z+kante/3,top,kante/3) KochKurve3D(ae,me,x+kante,y+kante,z+kante/3,top,kante/3) KochKurve3D(ae,me,x,y+kante,z+kante/3,top,kante/3) KochKurve3D(ae,me,x-kante,y+kante,z+kante/3,top,kante/3) KochKurve3D(ae,me,x-kante,y,z+kante/3,top,kante/3) KochKurve3D(ae,me,x,y,z-kante/3*2,top,kante/3) KochKurve3D(ae,me,x-kante/3*2,y,z,0,kante/3) KochKurve3D(ae,me,x+kante/3*2,y,z,3,kante/3) KochKurve3D(ae,me,x,y-kante/3*2,z,1,kante/3) KochKurve3D(ae,me,x,y+kante/3*2,z,4,kante/3) Case 3 KochKurve3D(ae,me,x-kante/3,y-kante,z-kante,top,kante/3) KochKurve3D(ae,me,x-kante/3,y,z-kante,top,kante/3) KochKurve3D(ae,me,x-kante/3,y+kante,z-kante,top,kante/3) KochKurve3D(ae,me,x-kante/3,y+kante,z,top,kante/3) KochKurve3D(ae,me,x-kante/3,y+kante,z+kante,top,kante/3) KochKurve3D(ae,me,x-kante/3,y,z+kante,top,kante/3) KochKurve3D(ae,me,x-kante/3,y-kante,z+kante,top,kante/3) KochKurve3D(ae,me,x-kante/3,y-kante,z,top,kante/3) KochKurve3D(ae,me,x+kante/3*2,y,z,top,kante/3) KochKurve3D(ae,me,x,y-kante/3*2,z,1,kante/3) KochKurve3D(ae,me,x,y+kante/3*2,z,4,kante/3) KochKurve3D(ae,me,x,y,z-kante/3*2,2,kante/3) KochKurve3D(ae,me,x,y,z+kante/3*2,5,kante/3) Case 4 KochKurve3D(ae,me,x-kante,y-kante/3,z-kante,top,kante/3) KochKurve3D(ae,me,x,y-kante/3,z-kante,top,kante/3) KochKurve3D(ae,me,x+kante,y-kante/3,z-kante,top,kante/3) KochKurve3D(ae,me,x+kante,y-kante/3,z,top,kante/3) KochKurve3D(ae,me,x+kante,y-kante/3,z+kante,top,kante/3) KochKurve3D(ae,me,x,y-kante/3,z+kante,top,kante/3) KochKurve3D(ae,me,x-kante,y-kante/3,z+kante,top,kante/3) KochKurve3D(ae,me,x-kante,y-kante/3,z,top,kante/3) KochKurve3D(ae,me,x,y+kante/3*2,z,top,kante/3) KochKurve3D(ae,me,x-kante/3*2,y,z,0,kante/3) KochKurve3D(ae,me,x+kante/3*2,y,z,3,kante/3) KochKurve3D(ae,me,x,y,z-kante/3*2,2,kante/3) KochKurve3D(ae,me,x,y,z+kante/3*2,5,kante/3) Case 5 KochKurve3D(ae,me,x-kante,y-kante,z-kante/3,top,kante/3) KochKurve3D(ae,me,x,y-kante,z-kante/3,top,kante/3) KochKurve3D(ae,me,x+kante,y-kante,z-kante/3,top,kante/3) KochKurve3D(ae,me,x+kante,y,z-kante/3,top,kante/3) KochKurve3D(ae,me,x+kante,y+kante,z-kante/3,top,kante/3) KochKurve3D(ae,me,x,y+kante,z-kante/3,top,kante/3) KochKurve3D(ae,me,x-kante,y+kante,z-kante/3,top,kante/3) KochKurve3D(ae,me,x-kante,y,z-kante/3,top,kante/3) KochKurve3D(ae,me,x,y,z+kante/3*2,top,kante/3) KochKurve3D(ae,me,x-kante/3*2,y,z,0,kante/3) KochKurve3D(ae,me,x+kante/3*2,y,z,3,kante/3) KochKurve3D(ae,me,x,y-kante/3*2,z,1,kante/3) KochKurve3D(ae,me,x,y+kante/3*2,z,4,kante/3) End Select EndIf End Function Function CreateQuad(kante) v1=AddVertex(surface,0,0,0) v2=AddVertex(surface,kante,0,0) v3=AddVertex(surface,kante,0,kante) v4=AddVertex(surface,0,0,kante) AddTriangle(surface,v1,v2,v3) AddTriangle(surface,v3,v4,v1) End Function Function AddCube(x#,y#,z#,kante#,top) v1=AddVertex(surface,x+kante/2,y+kante/2,z-kante/2):VertexColor(surface,v1,255,0,0) v2=AddVertex(surface,x-kante/2,y+kante/2,z-kante/2) v3=AddVertex(surface,x+kante/2,y-kante/2,z-kante/2) v4=AddVertex(surface,x-kante/2,y-kante/2,z-kante/2) v5=AddVertex(surface,x+kante/2,y+kante/2,z+kante/2) v6=AddVertex(surface,x-kante/2,y+kante/2,z+kante/2) v7=AddVertex(surface,x+kante/2,y-kante/2,z+kante/2) v8=AddVertex(surface,x-kante/2,y-kante/2,z+kante/2) If top<>0 AddTriangle(surface,v7,v3,v1) AddTriangle(surface,v1,v5,v7) EndIf If top<>1 AddTriangle(surface,v6,v5,v1) AddTriangle(surface,v1,v2,v6) EndIf If top<>2 AddTriangle(surface,v5,v6,v8) AddTriangle(surface,v8,v7,v5) EndIf If top<>3 AddTriangle(surface,v2,v4,v6) AddTriangle(surface,v8,v6,v4) EndIf If top<>4 AddTriangle(surface,v4,v7,v8) AddTriangle(surface,v7,v4,v3) EndIf If top<>5 AddTriangle(surface,v3,v2,v1) AddTriangle(surface,v2,v3,v4) EndIf End Function so. das sind alle. Rückmeldungen, Verbesserungen, und andere kommentare sind erwünscht. Edit: Single Surface in Code 5 & lockbuffer bei code 3 und 4 eingebaut |
||
- Zuletzt bearbeitet von Joel am So, Apr 10, 2011 16:23, insgesamt 2-mal bearbeitet
|
hecticSieger des IS Talentwettbewerb 2006 |
So, Apr 10, 2011 12:15 Antworten mit Zitat
|
|---|---|---|
|
Auch Blitz3D ist nicht so langsam wie manche denken. Wenn man zwei Zeilen hinzufügt, verschnellert sich der Code (je nach Rechner) bis um das 50-Fache.
Dein 3. Code: [AUSKLAPPEN] LockBuffer BackBuffer()
FraktalBaum(X,Y,1,Ebenen,Grosse,Scale,AnfangsWinkel,AnderungsWinkel) UnlockBuffer BackBuffer() Dein 4. Code: [AUSKLAPPEN] LockBuffer BackBuffer()
FraktalBaum3D(0,0,0,0,5,200,0.5,0,90,winkel,winkel) UnlockBuffer BackBuffer() |
||
| Download der Draw3D2 V.1.1 für schnelle Echtzeiteffekte über Blitz3D | ||
|
|
Joel |
So, Apr 10, 2011 12:51 Antworten mit Zitat
|
|---|---|---|
|
@hectic: oh.. das wust ich nicht. Wird eingefügt...
hab jetzt die Koch Kurve 3D (code 5) single surface gemacht.. |
||
Übersicht
BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group