tTh
/
Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

pickover evolutif

This commit is contained in:
tth 2022-03-30 08:42:39 +02:00
parent f89860afe0
commit 756ef965fd
7 changed files with 79 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Fraktalism/.gitignore vendored
View File

@ -6,6 +6,7 @@ voxelize
evolvopick
WS/*.dat
WS/*.txt
*.pgm
*.gif

2
Fraktalism/Makefile
View File

@ -1,5 +1,5 @@
GFOPT = -Wall -Wextra -time -g -pg -Imods/
GFOPT = -Wall -Wextra -time -O -Imods/
# ---------------------------------------------

15
Fraktalism/encode.sh Executable file
View File

@ -0,0 +1,15 @@
#!/bin/bash
DDIR="frames/pick3d"
echo "Encoding from " $DDIR
ffmpeg -nostdin \
-loglevel warning \
-y -r 25 -f image2 -i $DDIR/%05d.png \
-metadata artist='---[ tTh ]---' \
-metadata title='---[ experiment ]---' \
-c:v libx264 -pix_fmt yuv420p \
clifford-evolv-0.mp4

39
Fraktalism/evolvopick.f90
View File

@ -13,44 +13,57 @@ program evolvopick
double precision :: dptick
type(t_point3d), dimension(:), allocatable :: points
integer :: nbpoints
integer :: errcode
integer :: fd, errcode
character (len=200) :: command
KA(1) = 2.24 ; KA(2) = 0.43
KA(3) = -0.65 ; KA(4) = -2.43
KB(1) = 1.11 ; KB(2) = 0.22
KB(3) = 1.65 ; KB(4) = -1.43
KA(1) = -1.42 ; KA(2) = 1.62
KA(3) = 1.08 ; KA(4) = -2.43
nbsteps = 1199
nbpoints = 26000
KB(1) = 1.51 ; KB(2) = -1.89
KB(3) = 1.69 ; KB(4) = 0.79
nbsteps = 1800
nbpoints = 70000
allocate(points(nbpoints), stat=errcode)
if (0 .NE. errcode) then
STOP " : EVOLVOPICK, NO ENOUGH MEMORY"
endif
do tick = 0, nbsteps
do tick = 0, nbsteps-1
dptick = DBLE(tick) / DBLE(nbsteps)
! print *, tick, " ", dptick
call interp4dp(KA, KB, KI, dptick)
! print *, KI(1), KI(2), KI(3), KI(4)
write(0, '(1X, I8, 3X, 4F12.6)') tick, KI
write(0, '(1X, I8, 3X, 4F11.6)') tick, KI
! mmmm, not optimal
open (newunit=fd, file='WS/k-pick.txt', &
status='unknown', position='append', &
action='write', iostat=errcode)
if (0 .NE. errcode) then
STOP ' : FUBAR ON OUTPUT FILE'
endif
write(fd, '(I5, 4X, 4F8.4)') tick, KI
close(fd)
!
call compute_pickover(points, KI)
call write_points3d(points, 7, 25990, 'WS/pick.dat')
call write_points3d(points, 27, 69900, 'WS/pick.dat')
write(command, '(A, I6)') './tracepick.sh ', tick
call execute_command_line (command, exitstat=errcode)
if (0 .NE. errcode) then
STOP ' : ERR RUN COMMAND !'
STOP ' : ERR RUN TRACE COMMAND !'
endif
enddo
!-----------------------------------------------------
contains
subroutine interp4dp (ina, inb, out, dpk)
double precision, dimension(4), intent(in) :: ina, inb
double precision, dimension(4), intent(out) :: out
@ -63,6 +76,4 @@ program evolvopick
end subroutine
end program evolvopick

31
Fraktalism/fraktals.f90
View File

@ -27,6 +27,9 @@ subroutine simple_julia(pic, cx, cy, maxiter)
C = complex(cx, cy)
print *, "Const = ", C
! ready ? ok, clear the picture
pic = 0
do ix = 1, width
fx = (float(ix) / (float(width)/4.0) - 2.0)
do iy = 1, height
@ -50,11 +53,10 @@ subroutine simple_julia(pic, cx, cy, maxiter)
if (over_iter) then
pic(ix, iy) = 0
else
pic(ix, iy) = iter
pic(ix, iy) = iter*12
endif
enddo
enddo
enddo ! iy
enddo ! ix
end subroutine simple_julia
!-----------------------------------------------------
@ -70,25 +72,19 @@ subroutine compute_pickover(array, coefs)
integer :: i
! print *, "coefs ", coefs
write(0, '(1X, A18, I9)') "compute pickover ", ubound(array, 1)
! write(0, '(1X, A18, I9)') "compute pickover ", ubound(array, 1)
xa = 0.00 ; ya = 0.00 ; za = 0.0
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)
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
@ -114,6 +110,9 @@ subroutine plot_pickover(pic, count)
STOP " : NO ENOUGH MEMORY"
endif
! Clear the picture
pic = 0
coefs(1) = 2.24 ; coefs(2) = 0.43
coefs(3) = -0.65 ; coefs(4) = -2.43
call compute_pickover(points, coefs)
@ -122,11 +121,9 @@ subroutine plot_pickover(pic, count)
h = ubound(pic, 2)
do i=1, ubound(points, 1)
px = (points(i)%x * (w/4.09)) + (w / 2)
py = (points(i)%y * (h/4.09)) + (h / 2)
pic(px, py) = 255 ! WARNING COREDUMP
px = int((points(i)%x * (w/4.09)) + (w / 2))
py = int((points(i)%y * (h/4.09)) + (h / 2))
pic(px, py) = 255 ! WARNING COREDUMP ?
enddo
deallocate(points)

4
Fraktalism/mods/points3d.f90
View File

@ -10,6 +10,8 @@ module points3d
!-----------------------------------------------------
contains
!-----------------------------------------------------
subroutine list_points3d(array, start, length)
type(t_point3d), dimension(:), intent(in) :: array
integer, intent(in) :: start, length
@ -38,7 +40,7 @@ subroutine write_points3d(array, start, length, fname)
integer :: sz, i, j, io
write(0, '(1X, A15, 2I9)') "write pt3d ", start, length
! write(0, '(1X, A15, 2I9)') "write pt3d ", start, length
sz = ubound(array, 1)
if ((start+length) .GT. sz) then
STOP ' : WRITE P3D, OUT OF BOUND'

29
Fraktalism/tracepick.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
POVOPT=" -d +q9 +a +W1024 +H768 -v +WT2"
POVOPT=" -d +q9 +a +W1280 +H1024 -v +WT4"
TMPNG="/dev/shm/evolv.png"
outfile=$(printf "frames/pick3d/%05d.png" $1)
@ -8,18 +8,29 @@ outfile=$(printf "frames/pick3d/%05d.png" $1)
awk -f pick2pov.awk < WS/pick.dat > WS/pickover.inc
PASS=900
PASS=2222
povray -ipick3d.pov -K120 ${POVOPT} \
Declare=NBPASS=${PASS} \
-O${TMPNG} 2> toto
-O${TMPNG} 2> WS/err-tracepick.txt
convert ${TMPNG} \
-fill Gray50 \
-gravity South-West \
-pointsize 24 \
-annotate +20+10 "tTh" \
title="Clifford Pickover strange attractor"
tdate=$(date +'%F %R:%S')
# echo $tdate
coefs=$(tail -1 WS/k-pick.txt)
# echo $coefs
txt=$(printf '%s %s' "$tdate" "$coefs")
convert ${TMPNG} \
-fill Orange \
-font Courier-Bold \
-pointsize 32 \
-gravity North-West \
-annotate +30+30 "${title}" \
-pointsize 22 \
-gravity South-West \
-annotate +30+30 "${txt}" \
$outfile
sleep 2