Sierpinski-/Dürer-Pentagon

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Addi

Betreff: Sierpinski-/Dürer-Pentagon

BeitragFr, Dez 20, 2013 23:53
Antworten mit Zitat
Benutzer-Profile anzeigen
Diese kleine Programm erstellt wahlweise ein Dürer- oder ein Sierpinski-Pentagon.
Beide Fraktale unterscheiden sich vom IFS her eigentlich nur in der Tatsache, dass
beim Dürer-Pentagon neben den Funktionen des IFS vom Sierpinski-Pentagon noch eine 6te
für das mittlere Pentagon integriert ist. Sie sorgt dafür, dass das 6te Pentagon zusätzlich zu einer
Skallierung und Verschiebung noch eine Rotation um 180 Grad bekommt.

Nähere Infos:
http://ecademy.agnesscott.edu/.../durer.htm
http://ecademy.agnesscott.edu/...etails.htm

Programm (Code ist leider nicht optimiert Very Happy):
BlitzBasic: [AUSKLAPPEN]
Type Pentagon
Field point1#[1]
Field point2#[1]
Field point3#[1]
Field point4#[1]
Field point5#[1]

Field r, g, b
End Type

Type PentagonList
Field pe.Pentagon
Field it
End Type

;----------;

;Erstellen des Start-Pentagons
Local pent.Pentagon = New Pentagon
pent\r = 255
pent\g = 255
pent\b = 255
pent\point1[0] = Cos( 90)*200.0 - Cos(234)*200.0
pent\point1[1] = -Sin( 90)*200.0 + Sin(234)*200.0
pent\point2[0] = Cos(162)*200.0 - Cos(234)*200.0
pent\point2[1] = -Sin(162)*200.0 + Sin(234)*200.0
pent\point3[0] = Cos(234)*200.0 - Cos(234)*200.0
pent\point3[1] = -Sin(234)*200.0 + Sin(234)*200.0
pent\point4[0] = Cos(306)*200.0 - Cos(234)*200.0
pent\point4[1] = -Sin(306)*200.0 + Sin(234)*200.0
pent\point5[0] = Cos( 18)*200.0 - Cos(234)*200.0
pent\point5[1] = -Sin( 18)*200.0 + Sin(234)*200.0

Global r# = pent\point4[0] - pent\point3[0] ;Radius berechnen

;----------;

;Zwischenspeicher für die resutierenden neuen Pentagons
Local tempPent.PentagonList = New PentagonList
tempPent\pe = pent
tempPent\it = 0

Local tp.PentagonList, ttp.PentagonList

;----------;
;Interieren

AppTitle "Dürer/Sierpinskie Pentagon

Local count = Input("Wie viele Iterationen (>5 = sinnlos)?: "), i, j
Local duerer = Int(Input("Sierpinskie[0]; Dürer[>0]?: ")) > 0

count = count - (count - 5)*(count > 5)

If count > 0 Then
For i = 0 To count - 1
For tp = Each PentagonList

If tp\it = i Then
For j = 0 To 4 + duerer
ttp = New PentagonList
ttp\pe = CopyPentagon(tp\pe)
ttp\it = i + 1

Insert ttp After Last PentagonList

If j = 0 Then
TransformP1(ttp\pe)
ttp\pe\r = 72:ttp\pe\b = 255
Else If j = 1 Then
TransformP2(ttp\pe)
ttp\pe\g = 148:ttp\pe\b = 255
Else If j = 2 Then
TransformP3(ttp\pe)
ttp\pe\g = 255:ttp\pe\b = 144
Else If j = 3 Then
TransformP4(ttp\pe)
ttp\pe\r = 76:ttp\pe\g = 255
Else If j = 4 Then
TransformP5(ttp\pe)
ttp\pe\r = 255:ttp\pe\g = 216
Else If j = 5 And duerer Then
TransformP6(ttp\pe)
ttp\pe\r = 255:ttp\pe\g = 0
End If
Next

Delete tp\pe:Delete tp
Else
Exit
End If

Next
Next
End If

Delete Each PentagonList

;----------;
;Hauptprogramm

Graphics 800, 600, 16, 2

;Alles in ein Bild zeichnen
Local img = CreateImage(800, 600), p.Pentagon
SetBuffer ImageBuffer(img)

For p = Each Pentagon
Color p\r, p\g, p\b
Line p\point1[0] + 300, p\point1[1] + 400, p\point2[0] + 300, p\point2[1] + 400
Line p\point2[0] + 300, p\point2[1] + 400, p\point3[0] + 300, p\point3[1] + 400
Line p\point3[0] + 300, p\point3[1] + 400, p\point4[0] + 300, p\point4[1] + 400
Line p\point4[0] + 300, p\point4[1] + 400, p\point5[0] + 300, p\point5[1] + 400
Line p\point5[0] + 300, p\point5[1] + 400, p\point1[0] + 300, p\point1[1] + 400
Next

Delete Each Pentagon

SetBuffer FrontBuffer()
DrawImage img, 0, 0

WaitKey:End

;----------;

;Transformationsfunktion 1 des IFS (für das Pentagon links unten (keine Verschiebung))
Function TransformP1(pen.Pentagon)
pen\point1[0] = 0.382 * pen\point1[0] + 0 * pen\point1[1]
pen\point1[1] = 0 * pen\point1[0] + 0.382 * pen\point1[1]
pen\point2[0] = 0.382 * pen\point2[0] + 0 * pen\point2[1]
pen\point2[1] = 0 * pen\point2[0] + 0.382 * pen\point2[1]
pen\point3[0] = 0.382 * pen\point3[0] + 0 * pen\point3[1]
pen\point3[1] = 0 * pen\point3[0] + 0.382 * pen\point3[1]
pen\point4[0] = 0.382 * pen\point4[0] + 0 * pen\point4[1]
pen\point4[1] = 0 * pen\point4[0] + 0.382 * pen\point4[1]
pen\point5[0] = 0.382 * pen\point5[0] + 0 * pen\point5[1]
pen\point5[1] = 0 * pen\point5[0] + 0.382 * pen\point5[1]
End Function

;Transformationsfunktion 2 des IFS (für das Pentagon rechts unten)
Function TransformP2(pen.Pentagon)
pen\point1[0] = 0.382 * pen\point1[0] + 0 * pen\point1[1] + r*0.618
pen\point1[1] = 0 * pen\point1[0] + 0.382 * pen\point1[1]
pen\point2[0] = 0.382 * pen\point2[0] + 0 * pen\point2[1] + r*0.618
pen\point2[1] = 0 * pen\point2[0] + 0.382 * pen\point2[1]
pen\point3[0] = 0.382 * pen\point3[0] + 0 * pen\point3[1] + r*0.618
pen\point3[1] = 0 * pen\point3[0] + 0.382 * pen\point3[1]
pen\point4[0] = 0.382 * pen\point4[0] + 0 * pen\point4[1] + r*0.618
pen\point4[1] = 0 * pen\point4[0] + 0.382 * pen\point4[1]
pen\point5[0] = 0.382 * pen\point5[0] + 0 * pen\point5[1] + r*0.618
pen\point5[1] = 0 * pen\point5[0] + 0.382 * pen\point5[1]
End Function

;Transformationsfunktion 3 des IFS (für das Pentagon rechts oben)
Function TransformP3(pen.Pentagon)
pen\point1[0] = 0.382 * pen\point1[0] + 0 * pen\point1[1] + r*0.809
pen\point1[1] = 0 * pen\point1[0] + 0.382 * pen\point1[1] - r*0.588
pen\point2[0] = 0.382 * pen\point2[0] + 0 * pen\point2[1] + r*0.809
pen\point2[1] = 0 * pen\point2[0] + 0.382 * pen\point2[1] - r*0.588
pen\point3[0] = 0.382 * pen\point3[0] + 0 * pen\point3[1] + r*0.809
pen\point3[1] = 0 * pen\point3[0] + 0.382 * pen\point3[1] - r*0.588
pen\point4[0] = 0.382 * pen\point4[0] + 0 * pen\point4[1] + r*0.809
pen\point4[1] = 0 * pen\point4[0] + 0.382 * pen\point4[1] - r*0.588
pen\point5[0] = 0.382 * pen\point5[0] + 0 * pen\point5[1] + r*0.809
pen\point5[1] = 0 * pen\point5[0] + 0.382 * pen\point5[1] - r*0.588
End Function

;Transformationsfunktion 4 des IFS (für das Pentagon ganz oben auf der Spitze)
Function TransformP4(pen.Pentagon)
pen\point1[0] = 0.382 * pen\point1[0] + 0 * pen\point1[1] + r*0.309
pen\point1[1] = 0 * pen\point1[0] + 0.382 * pen\point1[1] - r*0.951
pen\point2[0] = 0.382 * pen\point2[0] + 0 * pen\point2[1] + r*0.309
pen\point2[1] = 0 * pen\point2[0] + 0.382 * pen\point2[1] - r*0.951
pen\point3[0] = 0.382 * pen\point3[0] + 0 * pen\point3[1] + r*0.309
pen\point3[1] = 0 * pen\point3[0] + 0.382 * pen\point3[1] - r*0.951
pen\point4[0] = 0.382 * pen\point4[0] + 0 * pen\point4[1] + r*0.309
pen\point4[1] = 0 * pen\point4[0] + 0.382 * pen\point4[1] - r*0.951
pen\point5[0] = 0.382 * pen\point5[0] + 0 * pen\point5[1] + r*0.309
pen\point5[1] = 0 * pen\point5[0] + 0.382 * pen\point5[1] - r*0.952
End Function

;Transformationsfunktion 5 des IFS (für das Pentagon links oben)
Function TransformP5(pen.Pentagon)
pen\point1[0] = 0.382 * pen\point1[0] + 0 * pen\point1[1] - r*0.191
pen\point1[1] = 0 * pen\point1[0] + 0.382 * pen\point1[1] - r*0.588
pen\point2[0] = 0.382 * pen\point2[0] + 0 * pen\point2[1] - r*0.191
pen\point2[1] = 0 * pen\point2[0] + 0.382 * pen\point2[1] - r*0.588
pen\point3[0] = 0.382 * pen\point3[0] + 0 * pen\point3[1] - r*0.191
pen\point3[1] = 0 * pen\point3[0] + 0.382 * pen\point3[1] - r*0.588
pen\point4[0] = 0.382 * pen\point4[0] + 0 * pen\point4[1] - r*0.191
pen\point4[1] = 0 * pen\point4[0] + 0.382 * pen\point4[1] - r*0.588
pen\point5[0] = 0.382 * pen\point5[0] + 0 * pen\point5[1] - r*0.191
pen\point5[1] = 0 * pen\point5[0] + 0.382 * pen\point5[1] - r*0.588
End Function

;Transformationsfunktion 6 des IFS (Zusatz für das Dürer Pentagon für das Pentagon in der Mitte)
Function TransformP6(pen.Pentagon)
pen\point1[0] = -0.382 * pen\point1[0] + 0 * pen\point1[1] + r*0.691
pen\point1[1] = 0 * pen\point1[0] + -0.382 * pen\point1[1] - r*0.951
pen\point2[0] = -0.382 * pen\point2[0] + 0 * pen\point2[1] + r*0.691
pen\point2[1] = 0 * pen\point2[0] + -0.382 * pen\point2[1] - r*0.951
pen\point3[0] = -0.382 * pen\point3[0] + 0 * pen\point3[1] + r*0.691
pen\point3[1] = 0 * pen\point3[0] + -0.382 * pen\point3[1] - r*0.951
pen\point4[0] = -0.382 * pen\point4[0] + 0 * pen\point4[1] + r*0.691
pen\point4[1] = 0 * pen\point4[0] + -0.382 * pen\point4[1] - r*0.951
pen\point5[0] = -0.382 * pen\point5[0] + 0 * pen\point5[1] + r*0.691
pen\point5[1] = 0 * pen\point5[0] + -0.382 * pen\point5[1] - r*0.951
End Function

;Hilfsfunktion: gibt ein neues Pentagon mit den Eigenschaften des übergebenen zurück
Function CopyPentagon.Pentagon(pen.Pentagon)
Local p.Pentagon = New Pentagon, i
For i = 0 To 1
p\point1[i] = pen\point1[i]
p\point2[i] = pen\point2[i]
p\point3[i] = pen\point3[i]
p\point4[i] = pen\point4[i]
p\point5[i] = pen\point5[i]
Next

Return p
End Function


Dürer Pentagon:
user posted image

Sierpinski Pentagon:
user posted image


~EDITIERT~

Überlange unterbrechungsfreie Kommentarzeilen entfernt, weil diese das Forenlayout zerschiessen.
mfG, Holzchopf

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group