diff --git a/Fraktalism/fraktals.f90 b/Fraktalism/fraktals.f90 index 2d1d9cf..a8d2909 100644 --- a/Fraktalism/fraktals.f90 +++ b/Fraktalism/fraktals.f90 @@ -5,6 +5,11 @@ module fraktals implicit none contains +!=============================================================== +!- +! Enfin un debut de Mandelbrot :) +!- + !=============================================================== ! nouveau 28 mai 2022 (again) ! source: @@ -12,18 +17,13 @@ module fraktals ! subroutine parasites_0(pic, cx, cy, maxiter) implicit none - - ! here is the wtf integer, intent(inout), dimension (:,:) :: pic - real, intent(in) :: cx, cy integer, intent(in) :: maxiter integer :: ix, iy, width, height real :: fx, fy, coef logical :: burps - ! write(0, *) "subroutine parasites_0" , maxiter - ! write(0, *) "constantes", cx, cy width = ubound(pic, 1) ; height = ubound(pic, 2) coef = float(maxiter) / 12.3456789 @@ -33,20 +33,19 @@ subroutine parasites_0(pic, cx, cy, maxiter) burps = (RAND() .lt. 0.01) do iy = 1, height fy = cy + (float(iy) / (float(height)/4.0) - 2.0) - if (burps) then pic(ix, iy) = mod(int(fx * fy * coef * 1.005), 250) else pic(ix, iy) = mod(int(fx * fy * coef), 250) endif - enddo enddo end subroutine parasites_0 - !=============================================================== - +!- +! some problems with color mapping, need more work +!- subroutine simple_julia(pic, cx, cy, maxiter) implicit none integer, intent(inout), dimension (:,:) :: pic @@ -72,22 +71,17 @@ subroutine simple_julia(pic, cx, cy, maxiter) fx = (float(ix) / (float(width)/4.0) - 2.0) do iy = 1, height fy = (float(iy) / (float(height)/4.0) - 2.0) - ! ------ traitement du pixel iter = 0 ; over_iter = .FALSE. Z = complex(fx, fy) do while (modulus2(Z) .LT. 4.0) - Z = (Z * Z) + C iter = iter + 1 - if (iter .GE. maxiter) then over_iter = .TRUE. exit endif - end do - if (over_iter) then pic(ix, iy) = 0 else @@ -98,22 +92,18 @@ subroutine simple_julia(pic, cx, cy, maxiter) end subroutine simple_julia !=============================================================== - +!- ! d'après les pages 91/92 du livre de Roger T Stevens -! "Fractal programming in C" -! +! "Fractal programming in C" +!- subroutine compute_pickover(array, coefs) type(t_point3d), dimension(:) :: array double precision, dimension(4) :: coefs double precision :: xa, ya, za, xb, yb, zb integer :: i - ! print *, "coefs ", coefs - - ! write(0, '(1X, A18, I9)') "compute pickover ", ubound(array, 1) xa = 1.0 ; ya = 1.0 ; za = 1.0 - do i=1, ubound(array, 1) xb = sin(coefs(1)*ya) - za*cos(coefs(2)*xa) yb = za*sin(coefs(3)*xa) - cos(coefs(4)*ya) @@ -126,7 +116,6 @@ subroutine compute_pickover(array, coefs) enddo end subroutine - !----------------------------------------------------- ! ! d'après les pages 91/92 du livre de Roger T Stevens @@ -190,7 +179,8 @@ end subroutine lorentz_0 !=============================================================== ! -- some support functions -- !----------------------------------------------------------- -! usage : evolvopick & voxelize +! usage in : evolvopick & voxelize +!- subroutine interp4dp (ina, inb, out, dpk) double precision, dimension(4), intent(in) :: ina, inb double precision, dimension(4), intent(out) :: out diff --git a/Fraktalism/mkmandel.f90 b/Fraktalism/mkmandel.f90 index 49c4b3b..5e4b711 100644 --- a/Fraktalism/mkmandel.f90 +++ b/Fraktalism/mkmandel.f90 @@ -1,5 +1,8 @@ !----------------------------------------------------- -! IMAGE PROCESSING +! MANDELBROT SET +!- +! refactored Thu 29 Dec 2022 03:21:16 PM CET +!- !----------------------------------------------------- !- subroutine plotsomething(pic, start) @@ -14,7 +17,7 @@ subroutine plotsomething(pic, start) ! type (CenterMag), intent(in) :: cz integer :: ix, iy, width, height - real :: fx, fy, mod2 + real :: fx, fy, mod2, rval complex :: za, zb, cste integer :: iter, maxiter logical :: escape @@ -28,7 +31,7 @@ subroutine plotsomething(pic, start) ! initialise constants ! - maxiter = 2500; + maxiter = 1984 ! enter megaloop ! @@ -37,8 +40,6 @@ subroutine plotsomething(pic, start) !! print *, "line ", iy, fy do ix = 1, width fx = (float(ix) / float(width/3)) - 2.0 - - !! print *, "pixel ", ix, iy, " at ", fx, fy !------------------------------------- ! working on the current pixel za = start @@ -47,7 +48,6 @@ subroutine plotsomething(pic, start) escape = .FALSE. do while (iter .lt. maxiter) zb = (za * za) + cste - ! if (modulus2(zb) .gt. 4.0) then mod2 = real(zb)*real(zb) + aimag(zb)*aimag(zb) !! print *, "mod2 ", mod2 if (mod2 .GT. 4.0) then @@ -59,10 +59,11 @@ subroutine plotsomething(pic, start) !! print *, "ZA ITER ESCAPE", za, iter, escape enddo if (escape) then - pic(ix, iy)%r = mod(iter*22, 255) - pic(ix, iy)%b = mod(iter*7, 255) + pic(ix, iy)%r = mod(iter*12, 255) + pic(ix, iy)%b = mod(iter*8, 255) else - pic(ix, iy)%g = mod(int(mod2 * 555), 200) + rval = (mod2 + abs(real(start)*aimag(start))) * 666.666 + pic(ix, iy)%g = mod(int(rval), 180) ! pic(ix, iy)%g = mod(iter, 255) ! pic(ix, iy)%b = mod(iter*11, 255) endif @@ -95,21 +96,21 @@ program mkmandel real :: stx, sty character (len=80) :: filename - print *, "-------- making some mandelbrot -------" + write(0, *) "-------- making some mandelbrot -------" - allocate(pic(800, 600)) + allocate(pic(1152, 900)) - do angle = 0, 1200 + do angle = 0, 1500 call rgbpix_set_to_zero(pic) - radangle = float(angle) * 0.017453292522222 - radius = float(angle) / 2000.0 + radangle = float(angle) * 0.01664 + radius = float(angle) / 1500.0 write (filename, "(a, i5.5, a)") "frames/mandel/", angle, ".pnm" ! filename = trim(filename) print *, "#### passe ", angle, radangle, trim(filename) - stx = radius * sin(radangle*3.9) + stx = radius * (sin(radangle*3.9) + sin(radangle*5.36)) sty = radius * cos(radangle*3.3) call plotsomething (pic, complex(stx, sty))