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

dernier commit avant le Gers

Browse Source
This commit is contained in:
tTh 2024-03-10 06:56:29 +01:00
parent caec2e08fe
commit 2c187e01bc
15 changed files with 145 additions and 81 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 @@ mkmandel
voxelize
evolvopick
henon
mkhenon
essai
plotcolmap

5
Fraktalism/Makefile
View File

@ -49,6 +49,11 @@ xjulia.pnm: mkjulia Makefile
henon: henon.f90 Makefile $(OBJDEP)
gfortran $(GFOPT) $< $(OBJS) -o $@
mkhenon: mkhenon.f90 Makefile $(OBJDEP)
gfortran $(GFOPT) $< $(OBJS) -o $@
# ---------------------------------------------
pickover: pickover.f90 Makefile $(OBJDEP)
gfortran $(GFOPT) $< $(OBJS) -o $@

7
Fraktalism/README.md
View File

@ -8,12 +8,17 @@ qui montre ma première expérience dans ce domaine.
## Trucs à voir
La fractale de Julia se porte plutôt bien.
La fractale de Julia se porte plutôt bien, mais les travaux continuent.
* [mkjuliagif.sh](mkjuliagif.sh) : fabrication de la gif animée
* [julias.f90](julias.f90) : fonctions de dessin d'une Julia
* [mkjulia.f90](mkjulia.f90) : le programme principal
**Q:** pourquoi faire la boucle en shell plutôt qu'en Fortran ?
**A:** Parce que je peux recompiler le binaire `mkjulia` pendant le
déroulement de la boucle, une manière comme une autre de faire
du *livecoding*.
## La technique

2
Fraktalism/encode.sh
View File

@ -36,7 +36,7 @@ TITLE='---{ experimental }---'
ffmpeg -nostdin \
-loglevel warning \
-y -r 30 -f image2 -i $SDIR/%05d.pnm \
-y -r 30 -f image2 -i $SDIR/%05d.png \
-metadata artist='---{ tTh }---' \
-metadata title="${TITLE}" \
-preset veryslow \

3
Fraktalism/fraktals.f90
View File

@ -137,6 +137,7 @@ subroutine interp4dp (ina, inb, out, dpk)
end subroutine
!-----------------------------------------------------------
!-
function dist0 (x, y)
implicit none
@ -146,6 +147,8 @@ function dist0 (x, y)
end function
!-----------------------------------------------------------
!-
function modulus2(pt)
implicit none
complex, intent(in) :: pt

29
Fraktalism/henon.f90
View File

@ -1,31 +1,10 @@
program henon
module henon
implicit none
integer :: passe
double precision :: vx, vy
integer :: w, h
integer :: foo, bar
double precision :: px, py
w = 2000 ; h = 1600
write(0, *) "###### Mapping of Henon "
do foo=1, 16
px = dble(foo) / 16.0
do bar=1,16
py = dble(bar) / 16.0
call compute_pixel_henon(px, py, 1700, &
passe, dble(0.5), vx, vy)
write(0, fmt=*) "passe ", passe, vx, vy
enddo
end do
contains
!-----------------------------------------------------
contains
!-----------------------------------------------------
!-----------------------------------------------------
subroutine compute_pixel_henon(a, b, maxpasse, passe, limit, rx, ry)
implicit none
double precision, intent(in) :: a, b, limit
@ -62,5 +41,5 @@ end subroutine
!-----------------------------------------------------
end program
end module

45
Fraktalism/julias.f90
View File

@ -1,5 +1,6 @@
module julias
use fraktals
implicit none
contains
@ -50,31 +51,40 @@ subroutine simple_julia(pic, cx, cy, maxiter)
end subroutine simple_julia
!===============================================================
subroutine julia_colormapped(pic, cx, cy, maxiter)
!-
! this code is nor really finished
!-
subroutine julia_colormapped(pic, cx, cy, mag, maxiter)
use pixrgb
type(t_pixrgb), intent(inout), dimension (:,:) :: pic
real, intent(in) :: cx, cy
real, intent(in) :: cx, cy, mag
integer, intent(in) :: maxiter
integer :: ix, iy, width, height
real :: fx, fy
integer :: ix, iy, width, height, iter
real :: fx, fy, div, off
complex :: Z, C
integer :: iter
logical :: over_iter
integer :: under, over
pic = t_pixrgb(0, 0, 0)
width = ubound(pic, 1)
height = ubound(pic, 2)
C = complex(cx, cy)
div = mag * 10.0 ; off = mag * 2.5
under = 0 ; over = 0
print *, "mag:", mag, " -> ", div, off
! print *, "Color julia, const = ", C
do ix = 1, width
fx = (float(ix) / (float(width*2)/10.0) - 2.5)
fx = (float(ix) / (float(width*2)/div) - off)
do iy = 1, height
fy = (float(iy) / (float(height*2)/10.0) - 2.5)
fy = (float(iy) / (float(height*2)/div) - off)
! ------ traitement du pixel
iter = 0 ; over_iter = .FALSE.
Z = complex(fx, fy)
do while ((real(Z)*real(Z) + imag(Z)*imag(Z)) .LT. 4.0)
do while ((real(Z)*real(Z) + (imag(Z)*imag(Z))) .LT. 4.0)
Z = (Z * Z) + C
iter = iter + 1
if (iter .GE. maxiter) then
@ -83,17 +93,22 @@ subroutine julia_colormapped(pic, cx, cy, maxiter)
endif
end do
if (over_iter) then
pic(ix, iy)%r = 0
pic(ix, iy)%g = mod(abs(int(real(Z) *140)), 255)
pic(ix, iy)%b = mod(abs(int(aimag(Z)*140)), 255)
pic(ix, iy)%r = mod(int(modulus2(Z)*2000.0), 255)
pic(ix, iy)%g = mod(abs(int(real(Z) *11.0)), 255)
pic(ix, iy)%b = mod(abs(int(aimag(Z)*11.0)), 255)
print *, ix, iy, Z, modulus2(Z)
over = over + 1
else
pic(ix, iy)%r = mod(iter*22, 255)
pic(ix, iy)%g = mod(iter*59, 255)
pic(ix, iy)%b = mod(iter*21, 255)
pic(ix, iy)%r = mod(iter*11, 255)
pic(ix, iy)%g = mod(iter*14, 255)
pic(ix, iy)%b = mod(iter*17, 255)
under = under + 1
endif
enddo ! iy
enddo ! ix
print *, "under", under, "over", over
end subroutine
!===============================================================
end module

27
Fraktalism/mkhenon.f90 Normal file
View File

@ -0,0 +1,27 @@
program henon
use PIXRGB
implicit none
type(t_pixrgb), allocatable :: picz(:,:)
integer :: argc
character(200) :: filename, string
real :: cx, cy
argc = IARGC()
if (3 .NE. argc) then
STOP ": MKHENON PROGGY NEED 3 PARAMETERS !"
endif
call getarg(1, filename)
call getarg(2, string) ; read (string, *) cx
call getarg(3, string) ; read (string, *) cy
allocate(picz(1280, 1024))
call rgbpix_spit_as_pnm_8(picz, trim(filename))
!-----------------------------------------------------
end program

4
Fraktalism/mkjulia.f90
View File

@ -26,9 +26,9 @@ program julia
call getarg(2, string) ; read (string, *) cx
call getarg(3, string) ; read (string, *) cy
allocate(picz(512, 342))
allocate(picz(1280, 1024))
call julia_colormapped(picz, cx, cy, 2500)
call julia_colormapped(picz, cx, cy, 0.600, 1000)
call rgbpix_spit_as_pnm_8(picz, trim(filename))
contains

48
Fraktalism/mkjuliagif.sh
View File

@ -3,7 +3,6 @@
#
# build the prog
#
make mkjulia
if [ $? -ne 0 ] ; then
echo
@ -11,11 +10,12 @@ if [ $? -ne 0 ] ; then
exit 1
fi
cxa=" -1.5 "
cya=" -1.0 "
cxb=" 1.1 "
cyb=" 2.1 "
nbi=" 180 "
cxa=" -1.5432 " ; cya=" -0.8999 "
cxb=" 1.0975 " ; cyb=" 1.5091 "
nbi=" 2000 "
tmpimg="/dev/shm/juliatmp.pnm"
rm frames/julia/*
#
# run the prog
@ -23,29 +23,39 @@ nbi=" 180 "
workdir="frames/julia/"
for foo in $( seq 0 $(( nbi - 1)) )
do
img=$(printf "%s/%05d.pnm" $workdir $foo)
Ka=$( echo "$foo / $nbi" | bc -l)
Kb=$( echo "1.0 - $Ka" | bc -l)
# echo $Ka $Kb
cx=$(echo "($cxa*$Ka) + ($cxb*$Kb)" | bc -l)
cy=$(echo "$cya*$Ka + $cyb*$Kb" | bc -l)
# make mkjulia
printf "%5d %4.6f %4.6f %4.6f %4.6f\n" \
$foo $Ka $Kb $cx $cy
./mkjulia $img $cx $cy
./mkjulia $tmpimg $cx $cy
echo
img=$(printf "%s/%05d.png" $workdir $foo)
tcx=$(printf "%8.6f" $cx)
tcy=$(printf "%8.6f" $cy)
convert $tmpimg \
-gravity North-East \
-font Courier-Bold \
-pointsize 20 \
-fill Yellow \
-annotate +15+34 $tcx \
-annotate +15+58 $tcy \
-gravity South-East \
-font Courier \
-pointsize 14 \
-fill Yellow \
-annotate +10+6 "Konrad+tTh 2024" \
$img
done
mogrify \
-gravity South-East \
-font Courier-Bold \
-pointsize 12 \
-fill Black \
-annotate +10+4 "Konrad+tTh 2024" \
"${workdir}/*.pnm"
echo ; echo "Encoding, please wait..."
convert -delay 10 $workdir/*.pnm color-julia.gif
./encode.sh frames/julia/ foo.mp4

9
GrafAnim/readpicz.f90
View File

@ -35,9 +35,16 @@ program readpicz
write(0, *) "iostat", errcode
exit
endif
pix(x+1, y+1)%r = b * 200
if (mod(y, 2) .EQ. 1) then
pix(x+1, y+1)%r = g * 200
pix(x+1, y+1)%g = b * 200
pix(x+1, y+1)%b = r * 200
else
pix(x+1, y+1)%r = g * 200
pix(x+1, y+1)%g = r * 200
pix(x+1, y+1)%b = b * 200
endif
enddo
call rgbpix_spit_as_pnm_16(pix, trim(filename))

1
Modules/.gitignore vendored
View File

@ -2,6 +2,7 @@
chkpixels
twavm
trnd
t_centermag
datas/

21
Modules/centermag.f90
View File

@ -2,6 +2,11 @@
module centermag
implicit none
!-----------------------------------------------------------------------
!-
! By definition, the default centermax (0, 0, 1) give us a
! (-1,-1), (1, 1) box, who is mapped to the screen size.
!-
!-----------------------------------------------------------------------
! definition of structures
!-
type t_centermag
@ -13,16 +18,30 @@ type t_centermag
end type
!-------------------------------------------------------------------
contains
!-------------------------------------------------------------------
subroutine init_centermag(cntmag, w, h, mag)
type(t_centermag),intent(out) :: cntmag
integer, intent(in) :: w, h ! screen size
real, intent(in) :: mag
write(0, *) ">>> init centermag:", w, h
cntmag%wscr = w ; cntmag%hscr = h
cntmag%mag = mag
end subroutine
!-------------------------------------------------------------------
subroutine print_centermag (cm)
type(t_centermag), intent(in) :: cm
print *, "Screen ", cm%wscr, cm%hscr
print *, "MagFactor ", cm%mag
print *, "Center ", cm%cx, cm%cy
! print *, "Center ", cm%cx, cm%cy
end subroutine
!-------------------------------------------------------------------
!-------------------------------------------------------------------
subroutine centermag_scr2real (sx, sy, rx, ry)
integer, intent(in) :: sx, sy
real, intent(out) :: rx, ry

16
Modules/t_centermag.f90
View File

@ -1,15 +1,9 @@
program t
use centermag
implicit none
type(t_centermag) :: cmag
print *, '====== programme de test ======'
cmag%wscr = 800
cmag%hscr = 600
print *, '====== programme de test centermag ======'
call essai_centermag(cmag)
print *
@ -19,15 +13,13 @@ program t
contains
! --------------
subroutine essai_centermag(cm)
type(t_centermag), intent(in) :: cm
type(t_centermag), intent(inout) :: cm
real :: rx, ry
call init_centermag(cm, 800, 600, 1.0)
call print_centermag (cm)
print *
call centermag_scr2real(1, 1, rx, ry)
print *, 'to real :', rx, ry
rx = 0.45 ; ry = -1.098
end subroutine
! --------------

2
Modules/test-wavm.sh
View File

@ -4,7 +4,7 @@ WAVE="datas/wave.wav"
# sndfile-info ${WAVE}
echo ; echo ; echo
echo
wav2text ${WAVE} | ./twavm