fraktalist: refactoring in progress

This commit is contained in:
tth 2022-03-08 10:36:32 +01:00
parent cf2333cf1f
commit 307b590796
15 changed files with 356 additions and 33 deletions

View File

@ -1,9 +1,12 @@
julia
pickover
lorentz
*.pgm
*.gif
*.asc
*.png
*.mp4

View File

@ -1,5 +1,5 @@
GFOPT = -Wall -Wextra -time -g
GFOPT = -Wall -Wextra -time -g -Imods/
# ---------------------------------------------
@ -9,7 +9,8 @@ spitpgm.o: spitpgm.f90 Makefile
fraktals.o: fraktals.f90 Makefile
gfortran $(GFOPT) -c $<
OBJS = spitpgm.o fraktals.o
OBJS = spitpgm.o fraktals.o
DOT_O = mods/points3d.o
# ---------------------------------------------
@ -17,11 +18,17 @@ julia: julia.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
pickover: pickover.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) $(DOT_O) -o $@
lorentz: lorentz.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
# ---------------------------------------------
foo.pgm: pickover Makefile
./pickover $@ > /dev/null
lorentz.pgm: lorentz Makefile
./lorentz $@ > /dev/null
pickover.pgm: pickover Makefile
time ./pickover $@ > /dev/null
# ---------------------------------------------

View File

@ -11,8 +11,24 @@ qui montre ma première expérience dans ce domaine.
Le gros des calculs de fractales est fait dans XXX, et la gestion
des pixels 'physiques' est fait dans YYY
Les fonctions d'usage général sont dans
[mods/](répertoire mods/) ave trop peu
[d'explications](mods/documentation.md)
Des scripts _shell_ sont utilisés pour construire les vidéos.
## File Formats
```
type t_point3d
double precision :: x, y, z
integer :: seq
end type t_point3d
```
Generally writen as a *sequencial unformated* file.
## TODO
- Voir de près le calcul du cadrage

1
Fraktalism/WS/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
*.inc

View File

@ -1,5 +1,11 @@
module fraktals
use points3d
implicit none
!-----------------------------------------------------
!-----------------------------------------------------
contains
!-----------------------------------------------------
@ -51,6 +57,42 @@ subroutine simple_julia(pic, cx, cy, maxiter)
enddo
end subroutine simple_julia
!-----------------------------------------------------
!
! d'après les pages 91/92 du livre de Roger T Stevens
! "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 = 0.00 ; ya = 0.00 ; za = 0.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)
zb = sin(xa)
array(i)%x = xb
array(i)%y = yb
array(i)%z = zb
array(i)%seq = i
xa = xb ; ya = yb ; za = zb
! print *, xb, yb, zb
enddo
end subroutine
!-----------------------------------------------------
!
! d'après les pages 91/92 du livre de Roger T Stevens
@ -61,37 +103,60 @@ subroutine pickover_0(pic, count)
integer, intent(inout), dimension (:,:) :: pic
integer, intent(in) :: count
double precision :: xa, ya, za, xb, yb, zb
double precision :: ka, kb, kc, kd
integer :: i, w, h, px, py
type(t_point3d), dimension(:), allocatable :: points
double precision, dimension(4) :: coefs
integer :: i, w, h, px, py, errcode
ka = 2.24 ; kb = 0.43 ; kc = -0.65 ; kd = -2.43
xa = 0.00 ; ya = 0.00 ; za = 0.0
write(0, '(1X, A18 , I9)') "pickover_0 ", count
allocate(points(count), stat=errcode)
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY"
endif
coefs(1) = 2.24 ; coefs(2) = 0.43
coefs(3) = -0.65 ; coefs(4) = -2.43
call compute_pickover(points, coefs)
w = ubound(pic, 1)
h = ubound(pic, 2)
h = ubound(pic, 2)
do i=1, count
do i=1, ubound(points, 1)
xb = sin(ka*ya) - za*cos(kb*xa)
yb = za*sin(kc*xa) - cos(kd*ya)
zb = sin(xa)
px = (xb * (w/4.05)) + (w / 2)
py = (yb * (h/4.05)) + (h / 2)
pic(px, py) = 200 ! WARNING COREDUMP
print *, xb, yb, zb
xa = xb ; ya = yb ; za = zb
px = (points(i)%x * (w/4.09)) + (w / 2)
py = (points(i)%y * (h/4.09)) + (h / 2)
pic(px, py) = 255 ! WARNING COREDUMP
enddo
deallocate(points)
end subroutine pickover_0
!-----------------------------------------------------
!
! d'après les pages NN/NN du livre de Roger T Stevens
! "Fractal programming in C"
!
subroutine lorentz_0(pic, count)
implicit none
integer, intent(inout), dimension (:,:) :: pic
integer, intent(in) :: count
! XXX double precision :: xa, ya, za, xb, yb, zb
! XXX double precision :: ka, kb, kc, kd
! XXX integer :: i, w, h, px, py
end subroutine lorentz_0
!-----------------------------------------------------------
! -- some support functions --
!-----------------------------------------------------
!-----------------------------------------------------------
!-----------------------------------------------------------
function dist0 (x, y)
implicit none
@ -100,7 +165,7 @@ function dist0 (x, y)
dist0 = ( x*x + y*y )
end function
!-----------------------------------------------------
!-----------------------------------------------------------
function modulus2(pt)
implicit none
complex, intent(in) :: pt

31
Fraktalism/lorentz.f90 Normal file
View File

@ -0,0 +1,31 @@
!
! this is the main programm
!
!-----------------------------------------------------
program lorentz
use spitpgm
use fraktals
implicit none
integer, dimension(800, 600) :: picz
integer :: argc
character(200) :: filename
argc = IARGC()
if (1 .NE. argc) then
STOP ": LORENTZ NEED A FILENAME !"
endif
call getarg(1, filename)
write (0, "(A)") "Lorentz -> "//trim(filename)
call lorentz_0(picz, 50000)
call spit_as_pgm_8(picz, trim(filename))
end program
!-----------------------------------------------------

9
Fraktalism/mods/Makefile Normal file
View File

@ -0,0 +1,9 @@
#
# compiling fraktalism's modules
#
GFOPT = -Wall -Wextra -time -g
points3d.o: points3d.f90 Makefile
gfortran $(GFOPT) -c $<

11
Fraktalism/mods/README.md Normal file
View File

@ -0,0 +1,11 @@
# Modules
Premier point : trouver les bonnes options de gfortran pour
définir l'emplacement des `.mod`.
Deuxième point : construire un Makefile cohérent d'un bout à l'autre,
avec un script de build bien robuste.
Troisième point : Faire la [documentation](documentation.md)

View File

@ -0,0 +1,9 @@
# La doc (enfin !)
## Points 3d
## Portable Net Map
.pgm

View File

@ -0,0 +1,33 @@
module points3d
implicit none
!-----------------------------------------------------
type t_point3d
double precision :: x, y, z
integer :: seq
end type t_point3d
!-----------------------------------------------------
contains
subroutine list_points3d(array, start, length)
type(t_point3d), dimension(:), intent(in) :: array
integer, intent(in) :: start, length
integer :: sz, i
sz = ubound(array, 1)
if ((start+length) .GT. sz) then
STOP ' : OUT OF BOUND'
endif
! send oi to stdout.
do i = start, start+length
print *, array(i)%x, array(i)%y, array(i)%z, array(i)%seq
enddo
end subroutine list_points3d
!-----------------------------------------------------
end module points3d

20
Fraktalism/pick2pov.awk Normal file
View File

@ -0,0 +1,20 @@
#!/usr/bin/awk
BEGIN {
print "// generated file, don't touch it bastard !"
print "#declare Pickover = object {"
print "union {"
}
# for every line
{
printf "sphere { <%f, %f, %f> 0.015 }\n", $1, $2, $3
}
END {
print "} }"
print "// done"
}

72
Fraktalism/pick3d.pov Normal file
View File

@ -0,0 +1,72 @@
#version 3.7;
global_settings {
ambient_light rgb <0.12, 0.04, 0.04>
assumed_gamma 1.0
}
#include "colors.inc"
#include "WS/pickover.inc"
#declare Tiers = NBPASS * 0.3333333;
#declare CK = (clock/Tiers)*180;
#declare Rep = object
{
union {
#local RB = 0.015;
cylinder { 0, <2, 0, 0>, RB pigment { color Red } }
cylinder { 0, <0, 2, 0>, RB pigment { color Green } }
cylinder { 0, <0, 0, 2>, RB pigment { color Blue } }
}
}
// object { Rep translate <-1, 0.10, -1> }
object {
object {
Pickover
texture {
pigment { color srgb <0.35, 0.45, 0.80> }
finish { phong 0.38 metallic 0.55 }
}
}
#if (clock < (Tiers))
rotate x*(CK)
#elseif (clock < (Tiers*2))
rotate y*(CK)
#else
rotate z*(CK)
#end
translate y*2.25
}
// ----------------------------------------------------------
plane {
<0, 1, 0>, 0
texture {
pigment { color srgb <0.133, 0.155, 0.111> }
finish { phong 0.18 metallic 0.55 }
}
}
// ----------------------------------------------------------
light_source { <-12, 17, -11> color Gray90 }
light_source { <-11, 11, 9> color Gray60 }
#declare XCAM = -3.8;
#declare YCAM = 3;
#declare ZCAM = 2.1;
camera {
location <XCAM, YCAM, ZCAM>
look_at <0, 2.09, 0>
right x*image_width/image_height
angle 86
}
// ----------------------------------------------------------

32
Fraktalism/pick3d.sh Executable file
View File

@ -0,0 +1,32 @@
#!/bin/bash
POVOPT=" -d +q9 +a +W1920 +H1080 -v +WT4"
PASS=600
ERR="/tmp/pov.error"
for pass in $(seq 0 $PASS)
do
dstname=$(printf "frames/pick3d/%05d.png" $pass)
echo $dstname
povray -ipick3d.pov -K${pass} \
Declare=NBPASS=${PASS} \
$POVOPT -O${dstname} 2> $ERR
if [ $? -ne 0 ]
then
tail $ERR
exit
fi
sleep 16
done
ffmpeg -nostdin \
-loglevel warning \
-y -r 25 -f image2 -i frames/pick3d/%05d.png \
-metadata artist='---[ tTh ]---' \
-c:v libx264 -pix_fmt yuv420p \
pick3d.mp4

View File

@ -6,25 +6,39 @@
program pickover
use spitpgm
use points3d
use fraktals
implicit none
integer, dimension(800, 600) :: picz
integer :: argc
character(200) :: filename
integer, dimension(800, 600) :: picz
integer :: argc
character(200) :: filename
double precision, dimension(4) :: coefs
type(t_point3d), dimension(:), allocatable :: points
integer :: nbr_points
integer :: errcode
argc = IARGC()
if (1 .NE. argc) then
STOP ": PICKOVER NEED A FILENAME !"
endif
call getarg(1, filename)
write (0, "(A)") " *** Pickover -> "//trim(filename)
write (0, "(A)") "Pickover -> "//trim(filename)
nbr_points = 999999
allocate(points(nbr_points), stat=errcode)
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY"
endif
call pickover_0(picz, 50000)
call spit_as_pgm_8(picz, trim(filename))
coefs(1) = 2.24 ; coefs(2) = 0.43
coefs(3) = -0.65 ; coefs(4) = -2.43
call compute_pickover(points, coefs)
call list_points3d(points, 2, 32000)
end program

View File

@ -1,7 +1,7 @@
#!/bin/bash
ASCFILE="nuage.asc"
IMAGE="pick3d.png"
IMAGE="pickplot.png"
make pickover
if [ $? -ne 0 ] ; then
@ -27,7 +27,7 @@ local angle="$2"
printf "== %s == %3d ==\n" $imgname $angle
gnuplot << __EOC__
set term png size 800,600
set term png size 1024,768
set output "${imgname}"
set title "3D Pickover"