more doc !

GrafAnim/Makefile

@@ -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)			\
+	gfortran $(GFOPT) $< $(MYLIB) -o $@
-		-o $@
-
-# ---- bienvenue dans le monde applicatif
 
 wavmetrics.o:	wavmetrics.f90 Makefile
 	gfortran $(GFOPT) -c $<

GrafAnim/README.md

@@ -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
+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...
 
+## 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.
+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 la partie dessin.

GrafAnim/essai.f90

@@ -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

GrafAnim/geowaves.f90

@@ -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
+

GrafAnim/soundscope.f90

@@ -9,11 +9,13 @@ program soundscope
 
   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(:,:)
   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.       &
+    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)
     endif
 
     ! 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
       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
+       ((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)
     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
 
-!-- ------------------------------------------------------------------
-
 
 !-- ------------------------------------------------------------------
 

GrafAnim/utils_ga.f90

@@ -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
 ! -------------------------------------------------------------------
 

Modules/.gitignore

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

Modules/Makefile

@@ -31,6 +31,7 @@ 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 $<
 
@@ -59,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 $@
+

Modules/README.md

@@ -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
 
@@ -25,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 !

Modules/twavm.f90

@@ -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

Modules/wavmetrics.f90

@@ -1,15 +1,16 @@
 
-! new: Thu Jan  4 00:08:04 UTC 2024
-
 module wavmetrics
 
+  ! new: Thu Jan  4 00:08:04 UTC 2024
+
   use mathstuff2
   implicit none
 
   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
 
   type intsample
@@ -17,14 +18,51 @@ module wavmetrics
   end type
 
   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(:)
-  integer, intent(in)               :: start, size
+  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, 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
 
 !-------------------------------------------------------------
@@ -32,6 +70,13 @@ end subroutine
 subroutine display_wavmetrics(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
 
 !-------------------------------------------------------------

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)
+