Compare commits

...

3 Commits

Author SHA1 Message Date
tTh
f039df4fe2 more doc ! 2024-02-07 03:40:23 +01:00
tTh
e3ff6de512 mood of the night 2024-02-07 03:22:44 +01:00
tTh
cd715e902f wavmetrics in the wild ! 2024-02-07 02:36:08 +01:00
12 changed files with 316 additions and 56 deletions

View File

@ -24,10 +24,7 @@ trigofest: trigofest.f90 Makefile vue3axes.o utils_ga.o
gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@ gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@
noisepic: noisepic.f90 Makefile noisepic: noisepic.f90 Makefile
gfortran $(GFOPT) $< $(MYLIB) \ gfortran $(GFOPT) $< $(MYLIB) -o $@
-o $@
# ---- bienvenue dans le monde applicatif
wavmetrics.o: wavmetrics.f90 Makefile wavmetrics.o: wavmetrics.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<

View File

@ -3,12 +3,16 @@
Quelques essais approximatifs pour faire des graphiques inutiles, Quelques essais approximatifs pour faire des graphiques inutiles,
dans une démarche mettant en avant la dans une démarche mettant en avant la
[techno-futilité](https://wiki.interhacker.space/index.php?title=Techno-futilit%C3%A9), [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 Actuellement, certains des logiciels que vous voyez ici utilisent un backend graphique brassé
graphique brassé à la maison et nommé `genplot2`. Hélas, celui-ci est [à 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... un peu foireux sur les tracés de ligne...
## geowaves
Une idée en l'air, probablement...
## trigofest ## trigofest
@ -20,15 +24,11 @@ que c'est d'la balle !
Ou comment dessiner des gaussiennes en jetant des dés. Ou comment dessiner des gaussiennes en jetant des dés.
## vue3axes
Un module assez spécialisé.
## soundscope ## soundscope
Retranscription en image de type oscilloscope d'un fichier son. Une tentative de retranscription en image de type oscilloscope/vumètre d'un fichier son.
Le code source ([soundscope.f90](soundscope.f90)) est encore Les codes source du proggy ([soundscope.f90](soundscope.f90)) et du
bien gore. [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 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. pour la partie dessin.

View File

@ -1,5 +1,9 @@
program essai program essai
! *******************************************
! CE TRUC NE MARCHE PAS /O\
! *******************************************
use pixrgb use pixrgb
implicit none implicit none
@ -60,6 +64,7 @@ subroutine setpixel(pic, x, y)
.and. & .and. &
(iy .gt. lbound(pic, 2)) .and. (iy .lt. ubound(pic, 2)) ) & (iy .gt. lbound(pic, 2)) .and. (iy .lt. ubound(pic, 2)) ) &
then then
pix(ix, iy)%r = 0
pic(ix, iy)%g = 65000 pic(ix, iy)%g = 65000
pic(ix, iy)%b = 20000 pic(ix, iy)%b = 20000
else else

35
GrafAnim/geowaves.f90 Normal file
View 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

View File

@ -9,23 +9,28 @@ program soundscope
implicit none implicit none
integer :: width = 720 integer :: width = 800
integer :: height = 576 integer :: height = 600
integer :: marge = 32 integer :: marge = 32
integer :: samplerate = 44100 integer :: samplerate = 44100
integer :: framerate = 30 integer :: framerate = 30
integer, parameter :: overtrig = 25200
type(t_pixrgb), allocatable :: pix(:,:) type(t_pixrgb), allocatable :: pix(:,:)
character (len=280) :: filename character (len=280) :: filename
integer :: iter, foo, tx, ty integer :: iter, foo, tx, ty
integer :: smppf integer :: smppf
logical :: flagdone logical :: flagdone
smppf = samplerate / framerate smppf = samplerate / framerate
write(0, *) "sample rate = ", samplerate
write(0, *) "frames per second = ", framerate
write(0, *) "samples per frame = ", smppf
allocate(pix(width, height)) allocate(pix(width, height))
call fill_random_gauss(pix, 65000, marge) ! call fill_random_gauss(pix, 65000, marge)
iter = 0 iter = 0
do do
@ -46,13 +51,19 @@ program soundscope
enddo enddo
call dim_pix_rgb_mul(pix, 0.86) 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" write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
call rgbpix_spit_as_pnm_16(pix, filename) call rgbpix_spit_as_pnm_16(pix, filename)
@ -60,13 +71,17 @@ program soundscope
exit exit
endif endif
if (iter .EQ. 360) exit
enddo enddo
write(0, *) " [done]" write(0, *) " [done]"
contains contains
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------
!-- !-
! This is the classic Lissajou
!-
subroutine make_a_frame_xy(image, nbdata, jobdone) subroutine make_a_frame_xy(image, nbdata, jobdone)
type(t_pixrgb), intent(inout) :: image(:,:) type(t_pixrgb), intent(inout) :: image(:,:)
@ -88,15 +103,16 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
endif endif
! add flash ! ! add flash !
if ( (idx .LT. 100) .AND. & if ( (idx .LT. 50) .AND. &
((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then ((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
write(0,*) "overshoot!" write(0,*) "overshoot in xy!"
call fill_random_gauss(image, 65000, marge) call fill_random_gauss(image, 65000, marge)
endif endif
! scale it to the window ! scale it to the window
ix = width - ((2 * int(vl / 111.111)) + 400) ix = int((vl/65536.9) * real(width)) + width/2
iy = (2 * int(vr / 166.666)) + 300 ix = width - ix
iy = int((vr/65536.9) * real(height)) + height/2
if (is_pixel_inside(ix, iy)) then if (is_pixel_inside(ix, iy)) then
call make_big_dot(image, ix, iy) call make_big_dot(image, ix, iy)
endif endif
@ -105,9 +121,73 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
end subroutine 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) subroutine make_a_frame_dplot(image, nbdata, jobdone)
type(t_pixrgb), intent(inout) :: image(:,:) type(t_pixrgb), intent(inout) :: image(:,:)
integer, intent(in) :: nbdata integer, intent(in) :: nbdata
@ -129,8 +209,8 @@ subroutine make_a_frame_dplot(image, nbdata, jobdone)
endif endif
! add flash ! ! add flash !
if ( (idx .LT. 100) .AND. & if ( (idx .LT. 100) .AND. &
((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then ((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
write(0,*) "overshoot!" write(0,*) "overshoot in dplot!"
call fill_random_gauss(image, 65000, marge) call fill_random_gauss(image, 65000, marge)
endif endif
@ -183,7 +263,7 @@ subroutine dessine_cadre(image, R, G, B, border)
end subroutine end subroutine
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------
function is_pixel_inside(ix, iy) function is_pixel_inside(ix, iy)
integer,intent(in) :: ix, iy integer,intent(in) :: ix, iy
logical :: is_pixel_inside logical :: is_pixel_inside
@ -200,8 +280,6 @@ function is_pixel_inside(ix, iy)
end function end function
!-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------

View File

@ -3,6 +3,7 @@
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
module utils_ga module utils_ga
use pixrgb use pixrgb
implicit none implicit none
@ -33,7 +34,25 @@ subroutine increment_pixel(pix, k)
type(t_pixrgb), intent(inout) :: pix type(t_pixrgb), intent(inout) :: pix
integer :: k 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 end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
@ -104,6 +123,25 @@ subroutine dim_pix_rgb_sub(pix, k)
enddo enddo
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 end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------

2
Modules/.gitignore vendored
View File

@ -1,6 +1,6 @@
chkpixels chkpixels
t twavm
trnd trnd
*.pgm *.pgm

View File

@ -31,6 +31,7 @@ mathstuff2.o: mathstuff2.f90 Makefile
noisepictures.o: noisepictures.f90 Makefile noisepictures.o: noisepictures.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
# new: Wed Feb 7 01:27:48 UTC 2024
wavmetrics.o: wavmetrics.f90 Makefile wavmetrics.o: wavmetrics.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
@ -59,3 +60,8 @@ t_centermag: t_centermag.f90 Makefile libtth90modules.a
trnd: trnd.f90 Makefile libtth90modules.a trnd: trnd.f90 Makefile libtth90modules.a
gfortran $(GFOPT) $< libtth90modules.a -o $@ 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 $@

View File

@ -3,6 +3,11 @@
## Modules disponibles ## 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 ### spitpgm
@ -25,11 +30,13 @@ or have a sane place to put a breakpoint with gdb
## Compiler un module ## 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 And when you use the module, you have to specify the paths
for the .mod and the .o to the linker. for the .mod and the .o to the linker.
*
See [Makefile](./Makefile) for an example. See [Makefile](./Makefile) for an example.
## TODO ## TODO
- écrire la doc ! - write the fscking doc !

39
Modules/twavm.f90 Normal file
View File

@ -0,0 +1,39 @@
program essai
! new: Wed Feb 7 01:27:48 UTC 2024
use mathstuff2
use wavmetrics
implicit none
write(0, *) "----------------- essai -------------------"
call run_first_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
!-----------------------------------------------------------------------
end program

View File

@ -1,15 +1,16 @@
! new: Thu Jan 4 00:08:04 UTC 2024
module wavmetrics module wavmetrics
! new: Thu Jan 4 00:08:04 UTC 2024
use mathstuff2 use mathstuff2
implicit none implicit none
type wavmetric type wavmetric
integer :: num integer :: nbre ! number of slices/samples
real :: freql, freqr real :: freql, freqr ! zero-crossing estimation
integer :: maxl, maxr integer :: maxl, maxr ! maximum of abs values
real :: meanl, meanr
end type end type
type intsample type intsample
@ -17,14 +18,51 @@ module wavmetrics
end type end type
contains contains
!------------------------------------------------------------- !-------------------------------------------------------------
!-
subroutine compute_wavmetric(samples, start, size, metrics) ! main computation routine, still full buggy
!-
subroutine compute_wavmetric(samples, size, metrics)
type(intsample), intent(in) :: samples(:) type(intsample), intent(in) :: samples(:)
integer, intent(in) :: start, size integer, intent(in) :: size
type(wavmetric), intent(out) :: metrics 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, Lval)) Rfreq = Rfreq + 1
endif
Lsum = Lsum + Lval
Rsum = Rsum + Rval
enddo
metrics%num = 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 end subroutine
!------------------------------------------------------------- !-------------------------------------------------------------
@ -32,6 +70,13 @@ end subroutine
subroutine display_wavmetrics(metrics) subroutine display_wavmetrics(metrics)
type(wavmetric), intent(in) :: metrics type(wavmetric), intent(in) :: metrics
! print '(1X, "metrics are :")'
print '(1X, " | num ", I0)', metrics%num
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 subroutine
!------------------------------------------------------------- !-------------------------------------------------------------

View File

@ -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 version de 77, les `GOTO`s sont moins agréables à faire, mais
l'existence des _pointeurs_ compense largement. l'existence des _pointeurs_ compense largement.
## content ## Le contenu
- [Modules](Modules/) : quelques composants de base.
- [SoundBrotching](SoundBrotching/) : faire gémir vos tympans - [SoundBrotching](SoundBrotching/) : faire gémir vos tympans
- [BloubWorld](BloubWorld/) : la vie des particules - [BloubWorld](BloubWorld/) : la vie des particules
- [Fraktalism](Fraktalism/) : du chaos dans les pixels - [Fraktalism](Fraktalism/) : du chaos dans les pixels
- [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret - [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret
- [GrafAnim](GrafAnim/) : Ah, enfin de la gif89a en vue ! - [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 - Le canal `#tetalab` sur le réseau IRC de
[Libera](https://libera.chat/) [Libera](https://libera.chat/)
- La [mailing-list publique](https://lists.tetalab.org/mailman/listinfo/tetalab) du Tetalab. - 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)