Compare commits
15 Commits
7d0e302e09
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
2c187e01bc | ||
|
|
caec2e08fe | ||
|
|
d76861a4e4 | ||
|
|
764d7343f2 | ||
|
|
dd552abeda | ||
|
|
27635a0398 | ||
|
|
eef8e7db64 | ||
|
|
09a4cb7cff | ||
|
|
f039df4fe2 | ||
|
|
e3ff6de512 | ||
|
|
cd715e902f | ||
|
|
49183e4153 | ||
|
|
3da1022e8f | ||
|
|
c32db90e10 | ||
|
|
d1b7218b21 |
@@ -7,7 +7,7 @@ all: genbloubs movebloubs exportbloubs mergebloubs \
|
||||
# ------------------------------------------------------------
|
||||
|
||||
GFOPT = -Wall -Wextra -g -time -I../Modules
|
||||
OBJS = bloubspace.o povstuff.o mathstuff.o
|
||||
OBJS = bloubspace.o povstuff.o
|
||||
MYLIB = '../Modules/libtth90modules.a'
|
||||
|
||||
# ------------------------------------------------------------
|
||||
@@ -37,9 +37,6 @@ bloubspace.o: bloubspace.f90 Makefile
|
||||
povstuff.o: povstuff.f90 Makefile
|
||||
gfortran $(GFOPT) -c $<
|
||||
|
||||
mathstuff.o: mathstuff.f90 Makefile
|
||||
gfortran $(GFOPT) -c $<
|
||||
|
||||
# ------------------------------------------------------------
|
||||
|
||||
genbloubs: genbloubs.f90 Makefile $(OBJS)
|
||||
|
||||
2
Fraktalism/.gitignore
vendored
2
Fraktalism/.gitignore
vendored
@@ -6,6 +6,7 @@ mkmandel
|
||||
voxelize
|
||||
evolvopick
|
||||
henon
|
||||
mkhenon
|
||||
essai
|
||||
plotcolmap
|
||||
|
||||
@@ -17,6 +18,7 @@ WS/*.inc
|
||||
toto
|
||||
|
||||
*.pgm
|
||||
*.pnm
|
||||
*.gif
|
||||
*.asc
|
||||
*.png
|
||||
|
||||
@@ -38,12 +38,22 @@ plotcolmap: plotcolmap.f90 Makefile $(OBJDEP)
|
||||
|
||||
# ---------------------------------------------
|
||||
|
||||
mkjulia: mkjulia.f90 Makefile $(OBJDEP)
|
||||
gfortran $(GFOPT) $< $(OBJS) -o $@
|
||||
|
||||
xjulia.pnm: mkjulia Makefile
|
||||
./mkjulia $@ -0.204365 0.321463
|
||||
|
||||
# ---------------------------------------------
|
||||
|
||||
henon: henon.f90 Makefile $(OBJDEP)
|
||||
gfortran $(GFOPT) $< $(OBJS) -o $@
|
||||
|
||||
mkjulia: mkjulia.f90 Makefile $(OBJDEP)
|
||||
mkhenon: mkhenon.f90 Makefile $(OBJDEP)
|
||||
gfortran $(GFOPT) $< $(OBJS) -o $@
|
||||
|
||||
# ---------------------------------------------
|
||||
|
||||
pickover: pickover.f90 Makefile $(OBJDEP)
|
||||
gfortran $(GFOPT) $< $(OBJS) -o $@
|
||||
|
||||
|
||||
@@ -6,6 +6,20 @@ Voyons d'abord
|
||||
[une vidéo](http://la.buvette.org/fractales/f90/video.html)
|
||||
qui montre ma première expérience dans ce domaine.
|
||||
|
||||
## Trucs à voir
|
||||
|
||||
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
|
||||
|
||||
Le gros des calculs de fractales est fait dans `mods/fraktals.f90`,
|
||||
@@ -34,7 +48,7 @@ Generally writen as a *sequencial unformated* file.
|
||||
|
||||
## TODO
|
||||
|
||||
- Voir de près le calcul du cadrage
|
||||
- Voir de près le calcul du cadrage : [centermag](../Modules/centermag.f90)
|
||||
- Rajouter des formules
|
||||
- Ne pas procastiner sur le reste
|
||||
|
||||
|
||||
@@ -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 \
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -1,4 +1,6 @@
|
||||
module julias
|
||||
|
||||
use fraktals
|
||||
implicit none
|
||||
contains
|
||||
|
||||
@@ -42,37 +44,47 @@ subroutine simple_julia(pic, cx, cy, maxiter)
|
||||
if (over_iter) then
|
||||
pic(ix, iy) = 0
|
||||
else
|
||||
pic(ix, iy) = iter*12
|
||||
pic(ix, iy) = mod(iter*13, 256)
|
||||
endif
|
||||
enddo ! iy
|
||||
enddo ! ix
|
||||
|
||||
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)
|
||||
print *, "Color julia, const = ", C
|
||||
|
||||
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)/4.0) - 1.0)
|
||||
fx = (float(ix) / (float(width*2)/div) - off)
|
||||
do iy = 1, height
|
||||
fy = (float(iy) / (float(height*2)/4.0) - 1.0)
|
||||
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
|
||||
@@ -81,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*33, 255)
|
||||
pic(ix, iy)%g = mod(iter*59, 255)
|
||||
pic(ix, iy)%b = mod(iter*41, 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
27
Fraktalism/mkhenon.f90
Normal 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
|
||||
@@ -26,11 +26,15 @@ 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, 500)
|
||||
call julia_colormapped(picz, cx, cy, 0.600, 1000)
|
||||
call rgbpix_spit_as_pnm_8(picz, trim(filename))
|
||||
|
||||
contains
|
||||
|
||||
!-----------------------------------------------------
|
||||
|
||||
end program
|
||||
|
||||
!-----------------------------------------------------
|
||||
|
||||
@@ -3,7 +3,6 @@
|
||||
#
|
||||
# build the prog
|
||||
#
|
||||
|
||||
make mkjulia
|
||||
if [ $? -ne 0 ] ; then
|
||||
echo
|
||||
@@ -11,28 +10,52 @@ if [ $? -ne 0 ] ; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
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
|
||||
#
|
||||
workdir="frames/julia/"
|
||||
for foo in $(seq 0 179)
|
||||
for foo in $( seq 0 $(( nbi - 1)) )
|
||||
do
|
||||
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)
|
||||
|
||||
img=$(printf "%s/%05d.pnm" $workdir $foo)
|
||||
bar=$(echo "$foo / 247.0" | bc -l)
|
||||
cx=$(echo "0.5 * (1.52*c($foo/28.0))" | bc -l)
|
||||
cy=$(echo "0.5 * (1.45*s($foo/17.0))" | bc -l)
|
||||
# make mkjulia
|
||||
|
||||
./mkjulia $img $cx $cy
|
||||
printf "%5d %4.6f %4.6f %4.6f %4.6f\n" \
|
||||
$foo $Ka $Kb $cx $cy
|
||||
./mkjulia $tmpimg $cx $cy
|
||||
echo
|
||||
|
||||
sleep 145
|
||||
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
|
||||
|
||||
./tagpicz.sh $workdir
|
||||
|
||||
echo ; echo "Encoding, please wait..."
|
||||
|
||||
convert -delay 10 $workdir/*.pnm color-julia.gif
|
||||
# animate foo.gif &
|
||||
|
||||
./encode.sh frames/julia/ foo.mp4
|
||||
|
||||
@@ -17,10 +17,10 @@ do
|
||||
|
||||
mogrify \
|
||||
-gravity South-East \
|
||||
-font Courier \
|
||||
-font Courier-Bold \
|
||||
-pointsize 12 \
|
||||
-fill firebrick \
|
||||
-annotate +10+10 "Konrad+tTh 2023" \
|
||||
-fill Black \
|
||||
-annotate +10+4 "Konrad+tTh 2024" \
|
||||
$img
|
||||
echo "tagging " $img
|
||||
|
||||
|
||||
2
GrafAnim/.gitignore
vendored
2
GrafAnim/.gitignore
vendored
@@ -6,6 +6,7 @@ trigofest
|
||||
noisepic
|
||||
geowaves
|
||||
soundscope
|
||||
readpicz
|
||||
|
||||
*.scratch
|
||||
*.genplot
|
||||
@@ -16,4 +17,5 @@ F/*.tga
|
||||
*.pgm
|
||||
*.data
|
||||
*.png
|
||||
log.txt
|
||||
|
||||
|
||||
@@ -24,10 +24,7 @@ trigofest: trigofest.f90 Makefile vue3axes.o utils_ga.o
|
||||
gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@
|
||||
|
||||
noisepic: noisepic.f90 Makefile
|
||||
gfortran $(GFOPT) $< $(MYLIB) \
|
||||
-o $@
|
||||
|
||||
# ---- bienvenue dans le monde applicatif
|
||||
gfortran $(GFOPT) $< $(MYLIB) -o $@
|
||||
|
||||
wavmetrics.o: wavmetrics.f90 Makefile
|
||||
gfortran $(GFOPT) -c $<
|
||||
@@ -35,6 +32,9 @@ wavmetrics.o: wavmetrics.f90 Makefile
|
||||
soundscope: soundscope.f90 Makefile utils_ga.o
|
||||
gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@
|
||||
|
||||
readpicz: readpicz.f90 Makefile utils_ga.o
|
||||
gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@
|
||||
|
||||
# ---- modules locaux ----
|
||||
|
||||
usegenplot.o: usegenplot.f90 Makefile
|
||||
|
||||
@@ -3,12 +3,16 @@
|
||||
Quelques essais approximatifs pour faire des graphiques inutiles,
|
||||
dans une démarche mettant en avant la
|
||||
[techno-futilité](https://wiki.interhacker.space/index.php?title=Techno-futilit%C3%A9),
|
||||
une notion bien définie par le collectif Interhack.
|
||||
une notion bien définie par le collectif **Interhack**.
|
||||
|
||||
Actuellement, certains des logiciels que vous voyez ici utilisent un backend
|
||||
graphique brassé à la maison et nommé `genplot2`. Hélas, celui-ci est
|
||||
Actuellement, certains des logiciels que vous voyez ici utilisent un backend graphique brassé
|
||||
[à la maison](https://git.tetalab.org/tTh/libtthimage)
|
||||
et nommé `genplot2`. Hélas, celui-ci est
|
||||
un peu foireux sur les tracés de ligne...
|
||||
|
||||
## geowaves
|
||||
|
||||
Une idée en l'air, probablement...
|
||||
|
||||
## trigofest
|
||||
|
||||
@@ -20,15 +24,11 @@ que c'est d'la balle !
|
||||
|
||||
Ou comment dessiner des gaussiennes en jetant des dés.
|
||||
|
||||
## vue3axes
|
||||
|
||||
Un module assez spécialisé.
|
||||
|
||||
## soundscope
|
||||
|
||||
Retranscription en image de type oscilloscope d'un fichier son.
|
||||
Le code source ([soundscope.f90](soundscope.f90)) est encore
|
||||
bien gore.
|
||||
Une tentative de retranscription en image de type oscilloscope/vumètre d'un fichier son.
|
||||
Les codes source du proggy ([soundscope.f90](soundscope.f90)) et du
|
||||
[module](utils_ga.f90) associé sont encore bien *gore*.
|
||||
|
||||
Pour convertir le son en données exploitables, il faut utiliser ce [bout de code](../SoundBrotching/c-tools/text2wav.c). Certaines fonctions utilisée par ce logiciel sont dans [utils_ga.f90](utils_ga.f90)
|
||||
pour la partie dessin.
|
||||
|
||||
@@ -1,5 +1,9 @@
|
||||
program essai
|
||||
|
||||
! *******************************************
|
||||
! CE TRUC NE MARCHE PAS /O\
|
||||
! *******************************************
|
||||
|
||||
use pixrgb
|
||||
implicit none
|
||||
|
||||
@@ -60,6 +64,7 @@ subroutine setpixel(pic, x, y)
|
||||
.and. &
|
||||
(iy .gt. lbound(pic, 2)) .and. (iy .lt. ubound(pic, 2)) ) &
|
||||
then
|
||||
pix(ix, iy)%r = 0
|
||||
pic(ix, iy)%g = 65000
|
||||
pic(ix, iy)%b = 20000
|
||||
else
|
||||
|
||||
35
GrafAnim/geowaves.f90
Normal file
35
GrafAnim/geowaves.f90
Normal file
@@ -0,0 +1,35 @@
|
||||
! *******************************************
|
||||
!
|
||||
! *******************************************
|
||||
|
||||
program geowaves
|
||||
|
||||
use pixrgb
|
||||
implicit none
|
||||
|
||||
integer :: width = 640
|
||||
integer :: height = 480
|
||||
integer :: marge = 10
|
||||
type(t_pixrgb), allocatable :: pix(:,:)
|
||||
integer :: x, y, h
|
||||
real :: dist
|
||||
|
||||
allocate(pix(width, height))
|
||||
|
||||
do x=marge, width-marge
|
||||
|
||||
! write (0, *) " Y =", y
|
||||
|
||||
do y=marge, height-marge, 5
|
||||
|
||||
print *, x, y
|
||||
pix(x, y)%g = 30000
|
||||
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
call rgbpix_spit_as_pnm_16(pix, "foo.pnm")
|
||||
|
||||
end program geowaves
|
||||
|
||||
59
GrafAnim/readpicz.f90
Normal file
59
GrafAnim/readpicz.f90
Normal file
@@ -0,0 +1,59 @@
|
||||
program readpicz
|
||||
|
||||
use pixrgb
|
||||
implicit none
|
||||
|
||||
integer :: nbarg
|
||||
integer :: param0 = 10
|
||||
character(len=256) :: arg
|
||||
|
||||
! integer :: foo, bar
|
||||
|
||||
integer :: width = 640
|
||||
integer :: height = 480
|
||||
integer :: x, y, r, g, b
|
||||
integer :: errcode
|
||||
character (len=280) :: filename
|
||||
type(t_pixrgb), allocatable :: pix(:,:)
|
||||
|
||||
filename = "out.pnm"
|
||||
|
||||
nbarg = IARGC()
|
||||
if (nbarg .GT. 0) then
|
||||
call GETARG(1, arg)
|
||||
! write (0, '(A40, A5)') "argument = ", arg
|
||||
read (arg, *) param0
|
||||
endif
|
||||
|
||||
allocate(pix(width, height))
|
||||
|
||||
do
|
||||
!----- get a pixel
|
||||
read(5, *, iostat=errcode) x, y, r, g, b
|
||||
! print *, x, y
|
||||
if (0 .NE. errcode) then
|
||||
write(0, *) "iostat", errcode
|
||||
exit
|
||||
endif
|
||||
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))
|
||||
|
||||
contains
|
||||
! ----------------------------------------------------------
|
||||
|
||||
|
||||
! ----------------------------------------------------------
|
||||
|
||||
end program
|
||||
|
||||
@@ -9,11 +9,13 @@ program soundscope
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: width = 720
|
||||
integer :: height = 576
|
||||
integer :: marge = 32
|
||||
integer :: samplerate = 44100
|
||||
integer :: framerate = 30
|
||||
integer :: width = 800
|
||||
integer :: height = 600
|
||||
integer :: marge = 32
|
||||
integer :: samplerate = 44100
|
||||
integer :: framerate = 30
|
||||
|
||||
integer, parameter :: overtrig = 25200
|
||||
|
||||
type(t_pixrgb), allocatable :: pix(:,:)
|
||||
character (len=280) :: filename
|
||||
@@ -21,11 +23,14 @@ program soundscope
|
||||
integer :: smppf
|
||||
logical :: flagdone
|
||||
|
||||
|
||||
smppf = samplerate / framerate
|
||||
write(0, *) "sample rate = ", samplerate
|
||||
write(0, *) "frames per second = ", framerate
|
||||
write(0, *) "samples per frame = ", smppf
|
||||
|
||||
|
||||
allocate(pix(width, height))
|
||||
call fill_random_gauss(pix, 65000, marge)
|
||||
! call fill_random_gauss(pix, 65000, marge)
|
||||
|
||||
iter = 0
|
||||
do
|
||||
@@ -46,13 +51,19 @@ program soundscope
|
||||
enddo
|
||||
|
||||
call dim_pix_rgb_mul(pix, 0.86)
|
||||
if (mod(iter, 180) .LT. 90) then
|
||||
call make_a_frame_dplot(pix, smppf, flagdone)
|
||||
else
|
||||
call make_a_frame_xy(pix, smppf, flagdone)
|
||||
endif
|
||||
|
||||
call dessine_cadre(pix, 65000, 65000, 65000, marge)
|
||||
foo = mod(iter/36, 3)
|
||||
! print *, iter, " --> ", foo
|
||||
select case(foo)
|
||||
case(0)
|
||||
call make_a_frame_xy(pix, smppf, flagdone)
|
||||
case(1)
|
||||
call make_a_frame_bargraph(pix, smppf, flagdone)
|
||||
case(2)
|
||||
call make_a_frame_dplot(pix, smppf, flagdone)
|
||||
end select
|
||||
|
||||
call dessine_cadre(pix, 51000, 65000, 51000, marge)
|
||||
write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
|
||||
call rgbpix_spit_as_pnm_16(pix, filename)
|
||||
|
||||
@@ -60,13 +71,17 @@ program soundscope
|
||||
exit
|
||||
endif
|
||||
|
||||
if (iter .EQ. 360) exit
|
||||
|
||||
enddo
|
||||
|
||||
write(0, *) " [done]"
|
||||
|
||||
contains
|
||||
!-- ------------------------------------------------------------------
|
||||
!--
|
||||
!-
|
||||
! This is the classic Lissajou
|
||||
!-
|
||||
|
||||
subroutine make_a_frame_xy(image, nbdata, jobdone)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
@@ -88,15 +103,16 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
|
||||
endif
|
||||
|
||||
! add flash !
|
||||
if ( (idx .LT. 100) .AND. &
|
||||
((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
|
||||
write(0,*) "overshoot!"
|
||||
if ( (idx .LT. 50) .AND. &
|
||||
((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
|
||||
write(0,*) "overshoot in xy!"
|
||||
call fill_random_gauss(image, 65000, marge)
|
||||
endif
|
||||
|
||||
! scale it to the window
|
||||
ix = width - ((2 * int(vl / 111.111)) + 400)
|
||||
iy = (2 * int(vr / 166.666)) + 300
|
||||
ix = int((vl/65536.9) * real(width)) + width/2
|
||||
ix = width - ix
|
||||
iy = int((vr/65536.9) * real(height)) + height/2
|
||||
if (is_pixel_inside(ix, iy)) then
|
||||
call make_big_dot(image, ix, iy)
|
||||
endif
|
||||
@@ -105,9 +121,73 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
|
||||
end subroutine
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
!-- ------------------------------------------------------------------
|
||||
!--
|
||||
! new: Sat Jan 6 00:04:23 UTC 2024
|
||||
!-
|
||||
! TODO bien calculer la largeur et la position des vumetres !
|
||||
!-
|
||||
! Largeur utile : largeur ecran moins deux fois la marge
|
||||
|
||||
subroutine make_a_frame_bargraph(image, nbdata, jobdone)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: nbdata
|
||||
logical, intent(out) :: jobdone
|
||||
integer :: idx, errcode
|
||||
integer :: ir, il, foo
|
||||
integer :: sigma_l, sigma_r
|
||||
integer :: largutil, haututil, xpos, ypos
|
||||
|
||||
sigma_l = 0
|
||||
sigma_r = 0
|
||||
|
||||
do idx=0, nbdata
|
||||
! get a sample
|
||||
read(5, *, iostat=errcode) il, ir
|
||||
if (0 .NE. errcode) then
|
||||
write(0, *) "iostat =", errcode
|
||||
jobdone = .TRUE.
|
||||
exit
|
||||
endif
|
||||
sigma_l = sigma_l + abs(il)
|
||||
sigma_r = sigma_r + abs(ir)
|
||||
enddo
|
||||
! ici on a lu tous les samples, on a la somme des abs()
|
||||
write(0, *) "sigmas = ", sigma_l, sigma_r
|
||||
il = sigma_l / nbdata
|
||||
ir = sigma_r / nbdata
|
||||
|
||||
call clear_image(image, marge)
|
||||
|
||||
! il ne reste plus qu'à tracer la barre.
|
||||
largutil = width - (marge*2)
|
||||
haututil = height - (marge*2)
|
||||
ypos = marge + ((il*haututil) / 32768 )
|
||||
! write(0, *) "ypos = ", ypos
|
||||
do xpos=1, largutil
|
||||
! write(0, *) " xpos", xpos
|
||||
call make_big_dot(image, xpos, ypos)
|
||||
enddo
|
||||
ypos = marge + ((il*haututil) / 32768 )
|
||||
write(0, *) "ypos = ", ypos
|
||||
do xpos=(width/2)+8, width - (marge + 8)
|
||||
write(0, *) " xpos", xpos
|
||||
call make_big_dot(image, xpos, ypos)
|
||||
enddo
|
||||
|
||||
! et ma fin de la trace : une séparation au milieu.
|
||||
do foo=marge+9, height-(marge+9)
|
||||
image(width/2, foo - 9)%r = 65500
|
||||
image(width/2, foo - 4)%r = 65500
|
||||
image(width/2, foo )%r = 65500
|
||||
image(width/2, foo + 4)%r = 65500
|
||||
image(width/2, foo + 9)%r = 65500
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
!-
|
||||
! THIS SUBROUTINE IS BOGUS !
|
||||
!-
|
||||
subroutine make_a_frame_dplot(image, nbdata, jobdone)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: nbdata
|
||||
@@ -129,8 +209,8 @@ subroutine make_a_frame_dplot(image, nbdata, jobdone)
|
||||
endif
|
||||
! add flash !
|
||||
if ( (idx .LT. 100) .AND. &
|
||||
((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
|
||||
write(0,*) "overshoot!"
|
||||
((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
|
||||
write(0,*) "overshoot in dplot!"
|
||||
call fill_random_gauss(image, 65000, marge)
|
||||
endif
|
||||
|
||||
@@ -183,7 +263,7 @@ subroutine dessine_cadre(image, R, G, B, border)
|
||||
end subroutine
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
function is_pixel_inside(ix, iy)
|
||||
integer,intent(in) :: ix, iy
|
||||
logical :: is_pixel_inside
|
||||
@@ -200,8 +280,6 @@ function is_pixel_inside(ix, iy)
|
||||
|
||||
end function
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
|
||||
7
GrafAnim/t_readpicz.sh
Executable file
7
GrafAnim/t_readpicz.sh
Executable file
@@ -0,0 +1,7 @@
|
||||
#!/bin/bash
|
||||
|
||||
tga_mires mircol0 mire.tga "Fortran Moderne"
|
||||
|
||||
tga_to_text foo.tga | ./readpicz
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
! -------------------------------------------------------------------
|
||||
|
||||
module utils_ga
|
||||
|
||||
use pixrgb
|
||||
implicit none
|
||||
|
||||
@@ -33,7 +34,25 @@ subroutine increment_pixel(pix, k)
|
||||
type(t_pixrgb), intent(inout) :: pix
|
||||
integer :: k
|
||||
|
||||
pix%r = pix%r + k
|
||||
pix%g = pix%g + k
|
||||
pix%b = pix%b + k
|
||||
|
||||
end subroutine
|
||||
! -------------------------------------------------------------------
|
||||
subroutine make_bar_dot(image, ix, iy)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: ix, iy
|
||||
integer :: foo
|
||||
|
||||
do foo=-1, 1
|
||||
image(ix+foo, iy)%r = 45000
|
||||
image(ix+foo, iy)%g = 5000
|
||||
image(ix+foo, iy)%b = 45000
|
||||
enddo
|
||||
image(ix-2, iy)%g = 45000
|
||||
image(ix , iy)%g = 65500
|
||||
image(ix+2, iy)%g = 45000
|
||||
|
||||
end subroutine
|
||||
! -------------------------------------------------------------------
|
||||
@@ -104,6 +123,25 @@ subroutine dim_pix_rgb_sub(pix, k)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
! -------------------------------------------------------------------
|
||||
subroutine clear_image(image, border)
|
||||
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: border
|
||||
integer :: ix, iy
|
||||
|
||||
! write(0, *) "dim 1 =", ubound(image, 1)
|
||||
! write(0, *) "dim 2 =", ubound(image, 2)
|
||||
|
||||
do ix=1+border, ubound(image, 1)-border
|
||||
do iy=1+border, ubound(image, 2)-border
|
||||
image(ix, iy)%r = 5555
|
||||
image(ix, iy)%g = 0
|
||||
image(ix, iy)%b = 0
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
! -------------------------------------------------------------------
|
||||
|
||||
|
||||
5
Modules/.gitignore
vendored
5
Modules/.gitignore
vendored
@@ -1,7 +1,10 @@
|
||||
|
||||
chkpixels
|
||||
t
|
||||
twavm
|
||||
trnd
|
||||
t_centermag
|
||||
|
||||
datas/
|
||||
|
||||
*.pgm
|
||||
*.pnm
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
|
||||
GFOPT = -Wall -Wextra -g -I.
|
||||
|
||||
all: chkpixels trnd t
|
||||
all: chkpixels trnd twavm
|
||||
|
||||
# ---------------------------------------------------------
|
||||
|
||||
@@ -31,17 +31,23 @@ mathstuff2.o: mathstuff2.f90 Makefile
|
||||
noisepictures.o: noisepictures.f90 Makefile
|
||||
gfortran $(GFOPT) -c $<
|
||||
|
||||
# new: Wed Feb 7 01:27:48 UTC 2024
|
||||
wavmetrics.o: wavmetrics.f90 Makefile
|
||||
gfortran $(GFOPT) -c $<
|
||||
|
||||
#----------------------------------------------------------
|
||||
# making a fluffy archive
|
||||
#
|
||||
OBJECTS = spitpgm.o pixrgb.o \
|
||||
centermag.o dummy.o \
|
||||
trials.o mathstuff2.o \
|
||||
noisepictures.o
|
||||
noisepictures.o wavmetrics.o
|
||||
|
||||
libtth90modules.a: $(OBJECTS) Makefile
|
||||
$(AR) rs $@ $?
|
||||
|
||||
# please explain the 'ar' command line
|
||||
|
||||
#----------------------------------------------------------
|
||||
# programmes de testouille
|
||||
#
|
||||
@@ -54,3 +60,8 @@ t_centermag: t_centermag.f90 Makefile libtth90modules.a
|
||||
|
||||
trnd: trnd.f90 Makefile libtth90modules.a
|
||||
gfortran $(GFOPT) $< libtth90modules.a -o $@
|
||||
|
||||
# new: Wed Feb 7 01:27:48 UTC 2024
|
||||
twavm: twavm.f90 Makefile libtth90modules.a
|
||||
gfortran $(GFOPT) $< libtth90modules.a -o $@
|
||||
|
||||
|
||||
@@ -3,6 +3,11 @@
|
||||
|
||||
## Modules disponibles
|
||||
|
||||
### wavmetrics
|
||||
|
||||
This module try to make some computations on *stereo* buffers.
|
||||
|
||||
This is just a [WIP](./wavmetrics.f90), see [twavm](./twavm.f90) for a no-use case.
|
||||
|
||||
### spitpgm
|
||||
|
||||
@@ -11,8 +16,7 @@ Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
|
||||
### pixrgb
|
||||
|
||||
Write 8 bits or 16 bits RGB pictures to PNM format.
|
||||
|
||||
**Warning!** The width of the picture MUST be a multiple of 4 !
|
||||
The width of the picture MUST be a multiple of 4 !
|
||||
|
||||
### trials
|
||||
|
||||
@@ -26,11 +30,13 @@ or have a sane place to put a breakpoint with gdb
|
||||
|
||||
## Compiler un module
|
||||
|
||||
You can use the same options as for a main program.
|
||||
*You can use the same options as for a main program.
|
||||
And when you use the module, you have to specify the paths
|
||||
for the .mod and the .o to the linker.
|
||||
*
|
||||
|
||||
See [Makefile](./Makefile) for an example.
|
||||
|
||||
## TODO
|
||||
|
||||
- écrire la doc !
|
||||
- write the fscking doc !
|
||||
|
||||
@@ -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
|
||||
|
||||
6
Modules/farbfeld.f90
Normal file
6
Modules/farbfeld.f90
Normal file
@@ -0,0 +1,6 @@
|
||||
!-
|
||||
!-
|
||||
! https://linuxfr.org/users/devnewton/liens/farbfeld-le-format-d-image-le-plus-simple-du-monde
|
||||
! http://tools.suckless.org/farbfeld/
|
||||
!-
|
||||
|
||||
@@ -6,15 +6,15 @@ module mathstuff2
|
||||
implicit none
|
||||
contains
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
! really quick'n'dirty hack
|
||||
! not really tested yet...
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
! really quick'n'dirty hack
|
||||
! not really tested yet...
|
||||
subroutine init_random_seed()
|
||||
|
||||
integer, dimension(3) :: tarray
|
||||
integer :: t3, foo
|
||||
real :: dummy
|
||||
|
||||
call itime(tarray)
|
||||
t3 = 3600*tarray(1) + 60*tarray(2) + tarray(3)
|
||||
! write(0, '(A,3I3,A,I6)') "sranding: ", tarray, " --> ", t3
|
||||
@@ -28,8 +28,10 @@ module mathstuff2
|
||||
|
||||
end subroutine
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
!-
|
||||
!- May be I can make some generic procedures ?
|
||||
!-
|
||||
logical function diff_sign(a, b)
|
||||
integer, intent(in) :: a, b
|
||||
|
||||
@@ -45,8 +47,6 @@ logical function diff_sign(a, b)
|
||||
diff_sign = .FALSE.
|
||||
|
||||
end function
|
||||
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
! ----------------------------------------------------------------
|
||||
end module mathstuff2
|
||||
|
||||
|
||||
@@ -1,35 +0,0 @@
|
||||
program t
|
||||
|
||||
use centermag
|
||||
implicit none
|
||||
|
||||
type(t_centermag) :: cmag
|
||||
|
||||
print *, '====== programme de test ======'
|
||||
|
||||
cmag%wscr = 800
|
||||
cmag%hscr = 600
|
||||
|
||||
call essai_centermag(cmag)
|
||||
print *
|
||||
|
||||
STOP ': PAF LE CHIEN ?'
|
||||
|
||||
! --------------
|
||||
contains
|
||||
! --------------
|
||||
subroutine essai_centermag(cm)
|
||||
type(t_centermag), intent(in) :: cm
|
||||
|
||||
real :: rx, ry
|
||||
|
||||
call print_centermag (cm)
|
||||
print *
|
||||
|
||||
call centermag_scr2real(1, 1, rx, ry)
|
||||
print *, 'to real :', rx, ry
|
||||
|
||||
end subroutine
|
||||
! --------------
|
||||
|
||||
end program
|
||||
@@ -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
|
||||
|
||||
real :: rx, ry
|
||||
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
|
||||
! --------------
|
||||
|
||||
11
Modules/test-wavm.sh
Executable file
11
Modules/test-wavm.sh
Executable file
@@ -0,0 +1,11 @@
|
||||
#!/bin/bash
|
||||
|
||||
WAVE="datas/wave.wav"
|
||||
|
||||
# sndfile-info ${WAVE}
|
||||
|
||||
echo
|
||||
|
||||
wav2text ${WAVE} | ./twavm
|
||||
|
||||
echo
|
||||
67
Modules/twavm.f90
Normal file
67
Modules/twavm.f90
Normal file
@@ -0,0 +1,67 @@
|
||||
program twavm
|
||||
|
||||
! new: Wed Feb 7 01:27:48 UTC 2024
|
||||
|
||||
use mathstuff2
|
||||
use wavmetrics
|
||||
implicit none
|
||||
|
||||
write(0, *) "----------------- twavm -------------------"
|
||||
|
||||
call run_second_test(44100/30)
|
||||
|
||||
contains
|
||||
!-----------------------------------------------------------------------
|
||||
|
||||
subroutine run_first_test(nbs)
|
||||
integer, intent(in) :: nbs ! nombre d'echantillons
|
||||
|
||||
type(intsample), allocatable :: samples(:)
|
||||
type(wavmetric) :: metrics
|
||||
integer :: foo, bar
|
||||
|
||||
write(0, '(1X, "first test on ", I0, " samples.")') nbs
|
||||
|
||||
! create the buffer, and fill it with garbage
|
||||
allocate(samples(nbs))
|
||||
do foo=1, nbs
|
||||
samples(foo)%left = mod(irand(), 65534) - 32700
|
||||
samples(foo)%right = mod(irand(), 60000) - 29999
|
||||
enddo
|
||||
|
||||
! compute and display the metrics (gi-go)
|
||||
call compute_wavmetric(samples, nbs, metrics)
|
||||
call display_wavmetrics(metrics)
|
||||
|
||||
end subroutine
|
||||
!-----------------------------------------------------------------------
|
||||
!-----------------------------------------------------------------------
|
||||
!-
|
||||
!- we read the datas from stdin
|
||||
!-
|
||||
subroutine run_second_test(nbs)
|
||||
integer, intent(in) :: nbs ! nombre d'echantillons
|
||||
|
||||
type(intsample), allocatable :: samples(:)
|
||||
type(wavmetric) :: metrics
|
||||
integer :: foo, bar
|
||||
integer :: vl, vr
|
||||
|
||||
write(0, '(1X, "second test on ", I0, " samples.")') nbs
|
||||
|
||||
! create the buffer, and fill it with stdin
|
||||
allocate(samples(nbs))
|
||||
do foo=1, nbs
|
||||
read(5, *) vl, vr
|
||||
! print '(1X, 2I16)', vl, vr
|
||||
samples(foo)%left = vl
|
||||
samples(foo)%right = vr
|
||||
enddo
|
||||
|
||||
! compute and display the metrics (gi-go)
|
||||
call compute_wavmetric(samples, nbs, metrics)
|
||||
call display_wavmetrics(metrics)
|
||||
|
||||
end subroutine
|
||||
!-----------------------------------------------------------------------
|
||||
end program
|
||||
85
Modules/wavmetrics.f90
Normal file
85
Modules/wavmetrics.f90
Normal file
@@ -0,0 +1,85 @@
|
||||
|
||||
module wavmetrics
|
||||
|
||||
! new: Thu Jan 4 00:08:04 UTC 2024
|
||||
|
||||
use mathstuff2
|
||||
implicit none
|
||||
|
||||
type wavmetric
|
||||
integer :: nbre ! number of slices/samples
|
||||
real :: freql, freqr ! zero-crossing estimation
|
||||
integer :: maxl, maxr ! maximum of abs values
|
||||
real :: meanl, meanr
|
||||
end type
|
||||
|
||||
type intsample
|
||||
integer :: left, right
|
||||
end type
|
||||
|
||||
contains
|
||||
!-------------------------------------------------------------
|
||||
!-
|
||||
! main computation routine, still full buggy
|
||||
!-
|
||||
subroutine compute_wavmetric(samples, size, metrics)
|
||||
type(intsample), intent(in) :: samples(:)
|
||||
integer, intent(in) :: size
|
||||
type(wavmetric), intent(out) :: metrics
|
||||
|
||||
integer :: Lmax, Rmax
|
||||
integer :: Lval, Rval
|
||||
integer :: idx
|
||||
integer :: Lfreq, Rfreq
|
||||
|
||||
real :: Lsum, Rsum
|
||||
|
||||
Lmax = 0 ; Rmax = 0
|
||||
Lfreq = 1 ; Rfreq = 1
|
||||
Lsum = 0.0 ; Rsum = 0.0
|
||||
|
||||
do idx=1, size
|
||||
Lval = samples(idx)%left
|
||||
Rval = samples(idx)%right
|
||||
|
||||
! print *, Rval, Lval
|
||||
if (abs(Lval) .GT. Lmax) Lmax = abs(Lval)
|
||||
if (abs(Rval) .GT. Rmax) Rmax = abs(Rval)
|
||||
|
||||
if (idx .GT. 1) then
|
||||
if (diff_sign(samples(idx-1)%left, Lval)) Lfreq = Lfreq + 1
|
||||
if (diff_sign(samples(idx-1)%right, Rval)) Rfreq = Rfreq + 1
|
||||
endif
|
||||
|
||||
Lsum = Lsum + Lval
|
||||
Rsum = Rsum + Rval
|
||||
|
||||
enddo
|
||||
|
||||
metrics%nbre = size
|
||||
metrics%maxl = Lmax ; metrics%maxr = Rmax
|
||||
metrics%freql = 1.0 / (Lfreq / real(size))
|
||||
metrics%freqr = 1.0 / (Rfreq / real(size))
|
||||
metrics%meanl = Lsum / real(size)
|
||||
metrics%meanr = Rsum / real(size)
|
||||
|
||||
end subroutine
|
||||
|
||||
!-------------------------------------------------------------
|
||||
|
||||
subroutine display_wavmetrics(metrics)
|
||||
type(wavmetric), intent(in) :: metrics
|
||||
|
||||
! print '(1X, "metrics are :")'
|
||||
|
||||
print '(1X, " | nbre ", I0)', metrics%nbre
|
||||
print '(1X, " | freq ", 2F12.2)', metrics%freql, metrics%freqr
|
||||
print '(1X, " | mean ", 2F12.2)', metrics%meanl, metrics%meanr
|
||||
print '(1X, " | maxi ", 2I8)', metrics%maxl, metrics%maxr
|
||||
|
||||
end subroutine
|
||||
|
||||
!-------------------------------------------------------------
|
||||
!-------------------------------------------------------------
|
||||
|
||||
end module
|
||||
18
README.md
18
README.md
@@ -8,21 +8,31 @@ de Janvier 2022, et j'ai bien aimé. Bon, contrairement à la
|
||||
version de 77, les `GOTO`s sont moins agréables à faire, mais
|
||||
l'existence des _pointeurs_ compense largement.
|
||||
|
||||
## content
|
||||
## Le contenu
|
||||
|
||||
- [Modules](Modules/) : quelques composants de base.
|
||||
- [SoundBrotching](SoundBrotching/) : faire gémir vos tympans
|
||||
- [BloubWorld](BloubWorld/) : la vie des particules
|
||||
- [Fraktalism](Fraktalism/) : du chaos dans les pixels
|
||||
- [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret
|
||||
- [GrafAnim](GrafAnim/) : Ah, enfin de la gif89a en vue !
|
||||
|
||||
## Prérequis
|
||||
## Utilisation
|
||||
|
||||
- GNUtrucs : bash, make, awk...
|
||||
- Prérequis de base, les GNUtrucs : gfortran, gcc, bash, make, awk...
|
||||
- Première chose à faire, compiler les [modules](Modules/README.md)
|
||||
qui seront utilisés par les autres logiciels.
|
||||
- Et ensuite, à vous de jouer. Fouillez dans les dossiers en sachant
|
||||
bien que beaucoup de ces trucs ne sont ni fait, ni à faire.
|
||||
|
||||
## hotline
|
||||
## Hotline
|
||||
|
||||
- Le canal `#tetalab` sur le réseau IRC de
|
||||
[Libera](https://libera.chat/)
|
||||
- La [mailing-list publique](https://lists.tetalab.org/mailman/listinfo/tetalab) du Tetalab.
|
||||
|
||||
## Ressources
|
||||
|
||||
* [Fortran Programming Language](https://fortran-lang.org/)
|
||||
* [Fortran Tips](https://zmoon.github.io/FortranTipBrowser/tips/index.html)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user