Fraktal als Vektorgrafik

Manche Dinge sind einfach zu komplex, um sie von Hand zu machen, lassen sich aber auf ganz einfache Regeln zurückführen.
Ein Beispiel hierfür ist das Fraktal der Startseite www.Jachens.de.

Die Positionen jeder neuen Generation von Kreisen lässt sich per Rekursion aus ihren Müttern und Großmüttern ableiten.

Sofern man nicht direkt Postscript schreiben möchte, scheint mir das Vektorzeichenprogramm Xfig eine gute Alternative zu sein, da dessen Xfig-Format eine fast menschenlesbare ASCII-Datei ist.

Ja, es gibt Menschen, die noch FORTRAN programmieren.

 
! ifort blauesfraktal.f90 -o blauesfraktal.x && ./blauesfraktal.x
 
module global
implicit none
integer :: i,j,n,z,loop
integer :: gesamt
integer :: Mutter, Oma
real    :: x,y, x_Mutter, y_Mutter, x_Oma, y_Oma
real    :: L,Breite
integer,  parameter                 :: tiefe=6
integer,  dimension(0:tiefe)        :: Anzahl
integer, allocatable,dimension(:)   :: Muetter
real,     dimension(0:tiefe)        :: Radius
real,    allocatable,dimension(:,:) :: Position
end module global
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
program blauesfraktal
use global
implicit none
 
!Radien
x=1.0
do n=1,tiefe
   x= x + 1.0/(2.0*real(n))
end do
!Skalierung fuer Xfig
L=2**tiefe *100
Breite = 4*L
Radius(0)=L
do n=1,tiefe
   Radius(n)=0.5*Radius(n-1)
end do !n
 
!Anzahl der Kreise
Anzahl(0)=1
Anzahl(1)=4
do n=2,tiefe
   Anzahl(n) = Anzahl(n-1)*3
end do !n
gesamt=0
do n=0,tiefe
   gesamt = gesamt + Anzahl(n)
   write (*,*) n,Anzahl(n),Radius(n)
end do !n
 
allocate(Position(1:2,0:gesamt))
allocate(Muetter(0:gesamt))
 
!Positionen
n=0
z=0
Position(1,z) = 0.0
Position(2,z) = 0.0
n=1
!Norden
z=z+1
Muetter(z)=0
Position(1,z) = Position(1,Muetter(z))
Position(2,z) = Position(2,Muetter(z)) + 0.5*Radius(n-1) + Radius(n)
!Osten
z=z+1
Muetter(z)=0
Position(1,z) = Position(1,Muetter(z)) + 0.5*Radius(n-1) + Radius(n)
Position(2,z) = Position(2,Muetter(z))
!Sueden
z=z+1
Muetter(z)=0
Position(1,z) = Position(1,Muetter(z))
Position(2,z) = Position(2,Muetter(z)) - 0.5*Radius(n-1) - Radius(n)
!Westen
z=z+1
Muetter(z)=0
Position(1,z) = Position(1,Muetter(z)) - 0.5*Radius(n-1) - Radius(n)
Position(2,z) = Position(2,Muetter(z))
 
gesamt=-1
do n=2,tiefe
   !Ablaufen der vorherigen Generation
   gesamt = gesamt + Anzahl(n-2)
   do loop=1, Anzahl(n-1)
      Mutter=gesamt+loop
      Oma=Muetter(Mutter)
      x_Mutter= Position(1,Mutter)
      y_Mutter= Position(2,Mutter)
      x_Oma   = Position(1,Oma)
      y_Oma   = Position(2,Oma)
      !Abfrage der Himmelsrichtungen
      x=Position(1,Mutter) 
      y=Position(2,Mutter) + 0.5*Radius(n-1) + Radius(n)
      call test_position !Norden
      x=Position(1,Mutter) + 0.5*Radius(n-1) + Radius(n)
      y=Position(2,Mutter)
      call test_position !Osten
      x=Position(1,Mutter) 
      y=Position(2,Mutter) - 0.5*Radius(n-1) - Radius(n)
      call test_position !Sueden
      x=Position(1,Mutter) - 0.5*Radius(n-1) - Radius(n)
      y=Position(2,Mutter)
      call test_position !Westen
   end do !loop
end do !n
 
call write_fig
 
end program blauesfraktal
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
subroutine test_position
use global
implicit none
real :: a,b, c,d
 
a=x       -x_Mutter
b=y       -y_Mutter
c=x_Mutter-x_Oma
d=y_Mutter-y_Oma
!quasi nach aussen
if ( (a+c)**2+(b+d)**2 > c**2+d**2 ) then
   z=z+1
   Muetter(z)=Mutter
   Position(1,z) = x
   Position(2,z) = y
end if
end subroutine test_position
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%!
! http://www.xfig.org/userman/fig-format.html
subroutine write_fig
use global
implicit none
integer, parameter :: linecolor = 10
integer, parameter :: fillcolor = 10
integer            :: thickness
!            -1 = Default
!             0 = Black
!             1 = Blue
!             2 = Green
!             3 = Cyan
!             4 = Red
!             5 = Magenta
!             6 = Yellow
!             7 = White
!          8-11 = four shades of blue (dark to lighter)
!         12-14 = three shades of green (dark to lighter)
 
open (12,file="blauesFraktal.fig")
write (12,"(a)") "#FIG 3.2"
write (12,"(a)") "Landscape"
write (12,"(a)") "Center"
write (12,"(a)") "Metric"
write (12,"(a)") "A4"
write (12,"(a)") "100.00"
write (12,"(a)") "Single"
write (12,"(a)") "-2"
write (12,"(a)") "1200 2"
Radius = 0.5 * Radius
do n=0,tiefe
   do loop=1, Anzahl(n)
      z=sum(Anzahl(0:n-1)) -1
      x= 0.5*Breite + Position(1,z+loop)
      y= 0.5*Breite + Position(2,z+loop)
      x_mutter= 0.5*Breite + Position(1,Muetter(z+loop))
      y_mutter= 0.5*Breite + Position(2,Muetter(z+loop))
      thickness = int(Radius(n)/20.0)
      !Kreise
      write (12,"(a,i,a,i,a,8i)") "1 3 0 1 ",&
           linecolor," ",fillcolor," 50 0 20 0.000 1 0.0000", &
           int(x), int(y), int(Radius(n)), int(Radius(n)),    &
           int(x), int(y), int(x+Radius(n)), int(y+Radius(n))
      !Verbindungslinien
      write (12,"(3(a,i),a)") "2 1 0 ",thickness," ",linecolor," ", &
           fillcolor," 50 0 20 0.000 0 0 -1 0 0 2"
      write (12,"(4i)") int(x), int(y), int(x_mutter), int(y_mutter)
   end do !loop
end do !n
 
close (12)
end subroutine write_fig

Der Internet Explorer kann SVG-Bilder nicht anzeigen!

Login
Valid HTML 4.01!