dernier commit avant le Gers

BloubWorld/.gitignore

@@ -7,6 +7,8 @@ nbimg.inc
 *.mp4
 *.lst
 *.wav
+*.xyz
+*.ssv
 frames/*
 log.*
 
@@ -17,4 +19,5 @@ mergebloubs
 listbloubs
 essai
 
+WS/*.data
 core

BloubWorld/Makefile

@@ -6,13 +6,14 @@ all:	genbloubs movebloubs exportbloubs mergebloubs	\
 
 # ------------------------------------------------------------
 
-GFOPT = -Wall -Wextra -g -time
+GFOPT = -Wall -Wextra -g -time  -I../Modules
-OBJS  = bloubspace.o povstuff.o mathstuff.o
+OBJS  = bloubspace.o povstuff.o
+MYLIB = '../Modules/libtth90modules.a'
 
 # ------------------------------------------------------------
 
 essai:		essai.f90 Makefile $(OBJS)
-	gfortran $(GFOPT) $< $(OBJS)  -o $@
+	gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
 
 # ------------------------------------------------------------
 
@@ -36,25 +37,22 @@ 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)
-	gfortran $(GFOPT) $< $(OBJS)  -o $@
+	gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
 
 movebloubs:	movebloubs.f90 Makefile $(OBJS)
-	gfortran $(GFOPT) $< $(OBJS)  -o $@
+	gfortran $(GFOPT) $< $(OBJS) $(MYLIB)  -o $@
 
 listbloubs:	listbloubs.f90 Makefile $(OBJS)
-	gfortran $(GFOPT) $< $(OBJS)  -o $@
+	gfortran $(GFOPT) $< $(OBJS) $(MYLIB)  -o $@
 
 exportbloubs:	exportbloubs.f90 Makefile $(OBJS)
-	gfortran $(GFOPT) $< $(OBJS)  -o $@
+	gfortran $(GFOPT) $< $(OBJS) $(MYLIB)  -o $@
 
 mergebloubs:	mergebloubs.f90 Makefile $(OBJS)
-	gfortran $(GFOPT)  $< $(OBJS)  -o $@
+	gfortran $(GFOPT)  $< $(OBJS) $(MYLIB)  -o $@
 
 # ------------------------------------------------------------
 

BloubWorld/README.md

@@ -7,36 +7,15 @@ dans lequel se déplacent des **bloubs**, lesquels sont
 des sortes de particule
 munie de certaines propriétés (age, grosseur, vitesses, etc...).
 Lesquelles valeurs peuvent évoluer en fonction du temps.
+Tout est expliqué dans ce [document](doc/what-is-a-bloub.md).
 
-## Description d'un bloub
+la structure d'un bloub est (presque) simple, en fait.
-
-Attention cette description n'est qu'un exemple, mais les points
-essentiels de la première étape sont là.
-Les caractériques dynamiques : position et vélocités.
-Coté physique : l'age en bloubcycle (avec un maximum), la taille,
-un petit nom, et un état (coucou la FSM).
-
-
-```
-  type t_bloubs
-    character(8)         :: nick
-    logical              :: alive
-    integer              :: state
-    integer              :: num               ! ???
-    real                 :: px, py, pz
-    real                 :: vx, vy, vz
-    real                 :: radius
-    integer              :: age, agemax
-  end type t_bloubs
-```
-
-C'est (preseque) simple, en fait.
 Le plus compliqué, c'est de savoir quoi faire de ce fatras
 de *bigdata*.
-
 On peut fabriquer des gazillions de bloubs, et ensuite
 les lacher dans un espace clôt, avec des parois
-rebondissantes. Chaque choc va un peu les user, et au bout d'un moment,
+rebondissantes.
+Chaque choc va un peu les user, et au bout d'un moment,
 ils vont mourir. C'est comme ça, c'est la vie des bloubs.
 
 ## Comment ça fonctionne ?
@@ -45,8 +24,6 @@ Pas trop mal pour un premier jet. Il suffit de lire
 le script `runme.sh` pour avoir une idée de l'enchainement
 des opérations. Lequel enchainement est décrit plus bas.
 
-## Les logiciels
-
 Pour le moment, l'ensemble des opérations est gérée par un script shell
 qui enchaine des opérations plus élémentaires. Oui, je sais, ce n'est
 pas optimal, mais c'est un cadre idéal pour les bricolages hasardeux.
@@ -55,21 +32,34 @@ Ces opérations agissent sur des fichiers de type `.blbs` qui sont,
 vu du fortran, des dumps séquentiels du type t_bloubs. Un format
 de fichier qui va être modifié assez souvent, ne gardez pas d'archives.
 
+## Les logiciels
+
+
 ### genbloubs
 
 Fabrication d'une population de bloubs plus ou moins aléatoires.
-Deux paramètres : le nom du fichier et le nombre de bloubs.
+Deux paramètres : le nom du fichier (extention `.blbs`)
+et le nombre de bloubs désirés.
 Les règles de génération *devraient* être paramétrables.
+([source](genbloubs.f90))
 
 ### movebloubs
 
-Le cœur actif du système : c'est lui qui, à chaque tick, va déplacer
+Il ne fait que deux choses : à chaque tick, va déplacer
-les bloubs, gérer les rebonds avec la boudary-box, éliminer les
+les bloubs et faire naitre de nouveaux bloubs
-bloubs usés par les chocs, et faire naitre de nouveaux bloubs
 si le besoin s'en fait sentir.
+Seul problème, il n'a pas de notion directe du temps, parce qu'il est juste de passage dans un pipeline.
+([source](movebloubs.f90))
 
-Seul problème, il n'a pas de notion directe du temps, parce qu'il est
+### mergebloubs
-juste de passage dans un pipeline.
+
+Le cœur actif du système : c'est lui qui, à chaque tick, va
+gérer les rebonds avec la boudary-box, éliminer les
+bloubs usés par les chocs, gérer les fusions de bloubs
+(avec plein de mathstuff dedans) et assurer l'équilibre
+global du système...
+C'est sur cette partie qu'il y a des améliorations à trouver.
+([source](mergebloubs.f90))
 
 ### exportbloubs
 
@@ -77,13 +67,14 @@ Sortie sur `stdout` de certaines propriétes des bloubs, qui seront
 reprise par un (ou des) scripts écrits en `awk`, afin de générer
 ce qu'il faut pour les différents moteurs de rendu.
 **Le format de sortie est susceptible de changer sans préavis.**
+Bon, pour le moment, dans les formats il n'y a que POVray,
+mais Gnuplot et/ou Rdata arriveront bien un de ces jours.
+([source](exportbloubs.f90))
 
-Bon, pour le moment, il n'y a que POVray, mais Gnuplot arrivera en second.
+Un exemple : l'idée est de générer un fichier `.inc` pour
-
+Povray pour utiliser les données exportées dans une scène,
-### mergebloubs
+par exemple le barycentre des bloubs. Et c'est très facile
-
+à faire avec un [script Awk](toinc.awk).
-Alors, celui-ci, il n'est pas vraiment au point. Il faut tout ré-écrire
-et faire gaffe à l'explosion quadratique.
 
 ## TODO
 

BloubWorld/bloubspace.f90

@@ -17,6 +17,7 @@ module bloubspace
     real                 :: vx, vy, vz
     real                 :: radius
     integer              :: age, agemax
+    integer              :: red, green, blue
   end type t_bloubs
 
   type t_boundingbox
@@ -30,6 +31,8 @@ module bloubspace
   ! ----------------------------------------------------------------
 
   subroutine load_boundingbox(infile, where, name)
+    implicit none
+
     character(*), intent(in)            :: infile
     type(t_boundingbox), intent (out)   :: where
     character(8), intent(in)            :: name
@@ -37,7 +40,7 @@ module bloubspace
     integer                   :: fd, errcode
     character(200)            :: message
 
-    print *, "try to load ", infile
+    print *, "try to load ", infile, " name ", name
 
     ! put some default values
     where%id = "default"
@@ -67,32 +70,44 @@ module bloubspace
   end subroutine load_boundingbox
 
   ! ----------------------------------------------------------------
-
+  !-
-  subroutine random_pv (blb)
+  !    coefxyz :
+  !             dispersion de la position autour de l'origine
+  !-
+  subroutine make_a_random_bloub(blb, coefxyz)
+    implicit none
     type(t_bloubs), intent (out)     :: blb
+    real, intent(in)                 :: coefxyz
 
-    blb%px = 3.57 * (rand() - 0.50)
+    ! write(0, *) "coef xyz = ", coefxyz
-    blb%py = 2.66 * (rand() - 0.50)
+    blb%px = coefxyz * (rand() - 0.50)
-    blb%pz = 3.57 * (rand() - 0.50)
+    blb%py = coefxyz * (rand() - 0.50)
+    blb%pz = coefxyz * (rand() - 0.50)
 
-    blb%vx = (rand()) / 2.500
+    blb%vx = (rand() / 9.000)
-    if (blb%px .LT. 0.0) blb%vx = -blb%vx
+    ! if (blb%px .LT. 0.0) blb%vx = -blb%vx
 
-    blb%vy = (rand()) / 4.000
+    blb%vy = -0.10 + (rand() / 11.000)
-    if (blb%py .LT. 0.0) blb%vy = -blb%vx
+    ! if (blb%py .LT. 0.0) blb%vy = -blb%vy
 
-    blb%vz = (rand()) / 2.500
+    blb%vz =  (rand() / 10.000)
-    if (blb%pz .LT. 0.0) blb%vz = -blb%vz
+    ! if (blb%pz .LT. 0.0) blb%vz = -blb%vz
+
+    blb%red   = mod(irand(), 256)
+    blb%green = 127 + mod(irand(), 127)
+    blb%blue  = mod(irand(), 256)
 
     blb%state  = 0
     blb%alive  = .TRUE.
     blb%age    = 0
-    blb%agemax = 300
+    blb%agemax = 250 + mod(irand(), 250)
 
   end subroutine
   ! ----------------------------------------------------------------
   !        Load a blbs file into an array of bloubs
+
   subroutine spit_bloubs_to_file (fname, blbarray, towrite)
+    implicit none
     character(*), intent(in)       :: fname
     type(t_bloubs), dimension(:)   :: blbarray
     integer, intent(in)            :: towrite
@@ -100,8 +115,8 @@ module bloubspace
     integer                :: errcode, output, foo, spitted
     character(200)         :: chaine
  
-    write (0, '(" spitting", (I6), " bloubs to ", (A), " file")')     &
+    ! write (0, '(" spitting", (I6), " bloubs to ", (A), " file")')     &
-                        towrite, trim(fname)
+    !                     towrite, trim(fname)
 
     open(      newunit=output,                            &
                file=trim(fname), form='unformatted',      &
@@ -124,13 +139,15 @@ module bloubspace
     enddo
 
     close(output)
-    write(0, '(1X, "spitted ", I6, " bloubs")') spitted 
+    write(0, '(1X, "spitted ", I0, " bloubs to ", A)')       &
+                             spitted,            trim(fname) 
 
   end subroutine spit_bloubs_to_file
   ! ----------------------------------------------------------------
   !        Dump an array of bloubs to a blbs file.
   ! 
   subroutine slurp_bloubs_file_in_array (infile, blbarray, nbread)
+    implicit none
     character(*), intent(in)                   :: infile
     type(t_bloubs), dimension(:), intent(out)  :: blbarray
     integer, intent(out)                       :: nbread
@@ -159,7 +176,7 @@ module bloubspace
       read (unit=input, iostat=errcode, iomsg=chaine) bloub
       if (0 .ne. errcode) then
         ! may be we got an EOF ?
-        ! write(0, '(" got errcode on read ", (I8,1X,A))') errcode, chaine
+        ! write(0, '("errcode on read ", (I0,1X,A))') errcode, chaine
         exit
       endif
       nbread = nbread + 1
@@ -181,6 +198,7 @@ module bloubspace
   !        Display a bloub content to stderr
 
   subroutine display_bloub (blb, message)
+    implicit none
     type(t_bloubs), intent (in)  :: blb
     character(*),   intent (in)  :: message
 
@@ -200,8 +218,11 @@ module bloubspace
 
   end subroutine
   ! ----------------------------------------------------------------
-
+  !-
+  !		Deplacement d'un bloub
+  !-
   subroutine move_bloub (blb, coef)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
     real,           intent (in)     :: coef
 
@@ -210,58 +231,78 @@ module bloubspace
     blb%py  = blb%py + (blb%vy * coef)
     blb%pz  = blb%pz + (blb%vz * coef)
 
+    ! faire vieillir le bloub
+    blb%age = blb%age + 1
+
   end subroutine
   ! ----------------------------------------------------------------
   ! 
   !     detection des collisions avec les parois de la boite
-  !     laquelle boite gagnerais beaucoup a etre parametrable.
+  !     laquelle boite gagnerais beaucoup a etre parametrable,
+  !     ainsi qu'un éventuel coefficient de réduction de la
+  !     vitesse. XXX
   ! 
   subroutine bound_a_bloub (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
 
     real, parameter      :: SH = 6.0
-    real, parameter      :: SV = 4.0
+    real, parameter      :: SV = 6.0
+
+    logical              :: flag
+
+    flag = .FALSE.
 
     !    X axis
     if ((blb%px + blb%radius) .GT. SH) then
       blb%vx = -1.0 * blb%vx
-      blb%px = SH- blb%radius
+      blb%px = SH - blb%radius
-      blb%age = blb%age + 1
+      flag = .TRUE.
     endif
     if ((blb%px - blb%radius) .LT. -SH) then
       blb%vx = -1.0 * blb%vx
       blb%px = -SH + blb%radius
-      blb%age = blb%age + 1
+      flag = .TRUE.
     endif
 
     ! vertical axe Y
     if ((blb%py - blb%radius) .LT. -SV) then
       blb%vy = -1.0 * blb%vy
       blb%py = -SV + blb%radius
-      blb%age = blb%age + 1
+      flag = .TRUE.
     endif
     if ((blb%py + blb%radius) .GT. SV) then       ! overshoot ?
       blb%vy = -1.0 * blb%vy
-      blb%age = blb%age + 1
       blb%py = SV - blb%radius
+      flag = .TRUE.
     endif
 
     !    Z axis
     if ((blb%pz + blb%radius) .GT. SH) then
       blb%vz = -1.0 * blb%vz
-      blb%age = blb%age + 1
       blb%pz = SH - blb%radius
+      flag = .TRUE.
     endif
     if ((blb%pz + blb%radius) .LT. -SH) then
       blb%vz = -1.0 * blb%vz
-      blb%age = blb%age + 1
       blb%pz = -SH + blb%radius
+      flag = .TRUE.
+    endif
+
+    if (flag) then
+      blb%age = blb%age + 1
+      blb%radius = blb%radius * 0.9999
+    endif
+
+    if (blb%age .GT. blb%agemax) then
+      blb%alive = .FALSE.
     endif
 
   end subroutine
 
   ! ----------------------------------------------------------------
   function distance_of_bloubs(bla, blb)
+    implicit none
     type(t_bloubs), intent(in)   :: bla, blb
     real                         :: distance_of_bloubs
 
@@ -279,15 +320,16 @@ module bloubspace
   !          kill a bloub under condition(s)
 
   subroutine green_soylent (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
 
-    if (blb%age .gt. 24) then
+    if (blb%age .gt. 240) then
       blb%alive = .FALSE.
     endif
 
     ! this is juste a molly-guard, don't worry
     ! 
-    if (blb%radius .GT. 2.0) then
+    if (blb%radius .GT. 5.0) then
       blb%alive = .FALSE.
     endif
   end subroutine

BloubWorld/doc/what-is-a-bloub.md

@@ -2,38 +2,112 @@
 
 ## Philosophie
 
-Bonne question, mais nous n'avons pas le temps, point suivant ?
+Bonne question, mais nous n'avons pas le temps, point
+suivant ? En fait, si, il est tard, mais j'ai envie de
+raconter des conneries.
 
-En fait, si, il est tard, mais j'ai envie de raconter des
+Un bloub est une entité mathématique qui vit
-conneries.
+dans un espace cartésien abstrait, bien que normé.
+Il peut aussi être borné, soit en mode "boite", soit
+en mode "tore". La notion de champ de gravité est
+ignoré, parce qu'un bloub se moque d'avoir une masse.
+Par contre les bloubs peuvent interagir entre eux
+de divers manières : rebond (genre billard), échange
+de données, fusion volumique...
 
 ## Technique
 
-Voici la version du _Sat 19 Feb 2022 12:37:42 AM CET_
+Un bloub est caractérisé par un certain nombre de valeurs,
+rangées dans une structure de donnée.
+Ces valeurs représentent des choses comme la position,
+la taille, l'age et la couleur d'un bloub.
+
+En voici la version Fortran du _Fri Jan 26 00:58:37 UTC 2024_,
+c'est à dire presque (mais pas que) complètement différente
+de l'état actuel ou possible du logiciel. Il faut noter que
+certains champs ne sont pas encore utilisés.
 
 ```
   type t_bloubs
     character(8)         :: nick
     logical              :: alive
+    integer              :: state
     integer              :: num               ! ???
     real                 :: px, py, pz
     real                 :: vx, vy, vz
     real                 :: radius
-    integer              :: age
+    real                 :: density
+    integer              :: age, agemax
+    integer              :: red, green, blue
   end type t_bloubs
 ```
 
-Certains champs sont assez explicites, comme le nick, la position
+Certains champs sont assez explicites, comme le *nick*,
-dans l'espace, le rayon (pour nous, un bloub est
+la position dans l'espace, le rayon (pour nous, un bloub est
-une entité abstraite assimilable à une bubulle)
+une entité abstraite assimilable à une bubulle) ou la vitesse
-ou la vitesse sur les trois axes.
+sur les trois directions de l'espace bloubeux.
-D'autres, comme `alive`, sont
+D'autres, comme `alive`, sont plus délicates à expliquer,
-plus délicates à expliquer, sauf si l'on considère que les
+sauf si l'on considère que les bloubs sont zombifiables.
-bloubs sont zombifiables.
 
-D'autres, comme l'age, sont bien plus sujettes à de diverses
+D'autres, comme age et agemax, sont bien plus sujettes à de diverses
 interprétations. doit-on incrémenter l'age à chaque tick d'horloge
 ou à chaque évènement discret ? Et à quel age un bloub devient-il
 trop vieux, à quel age va-t-il mourir ?
 
+## La fusion des blobs
+
+Quand deux bloubs se rencontrent (en première approche, cela veut
+dire que leurs surfaces se recoupent) il y a bien entendu quelque
+chose qui se déclenche. En général, c'est la fusion des deux
+bloubs. Mais une fusion de bloubs, c'est quoi ?
+
+Je pense qu'il y a une infinité de possibilités, je vais me contenter
+d'expliquer la démarche que j'ai suivie.
+Tout d'abord, pour la fusion de certains paramètres, comme la position
+ou la vitesse, on va faire simple : une moyenne sans pondération.
+Précis et efficace.
+
+Pour d'autres (le nick & le num) je n'ai pas d'idée bien précise,
+il y a peut-être la notion de « nick dominant » à définir.
+Par contre, c'est peut-être sur les valeurs 'corporelles' :
+taille, densité, age et couleur qu'il y a des choses à faire.
+
+  * Taille : c'est le `radius` d'une sphere -> somme des volumes
+  * Densité : cette valeur n'est actuellement pas gérée
+  * Age : (somme des deux ages) * coefficient
+  * Agemax : (maximum des deux agemaxs) - forfait
+  * Couleurs : un système de mutation selon critères ?
+
+Il ne reste qu'à coder tout ça...
+
+## Analyse de population
+
+Nous avons des moyens assez simple d'enregistrer l'état complet
+de la population de bloubs à chaque itération. 
+La meilleure preuve étant les vidéos publiés dans les peertubes.
+Mais nous devrions plus nous pencher sur les aspects statistiques,
+comme la démographie, l'état de santé, la pyramide des ages... 
+
+Les traitements simples peuvent faire appel à Awk et Gnuplot.
+Pour les visions plus avancées, un logiciel spécialisé sera
+le bienvenu, et **R** est un bon candidat potentiel.
+On peut aussi envisager la pureté du code Fortran,
+couplé avec un *toolkit* graphique comme XXX.
+
+Il ne reste qu'à coder tout ça...
+
+## Et pour la suite ?
+
+Au fil du temps, le bloub évolue et se complexifie.
+La prochaine itération sera dotée d'un attribut de couleur et
+d'amusantes fonctions pour mixer ces couleurs si deux bloubs
+se trouvent à fusionner.
+On peut aussi envisager de les munir d'un spin non entier
+dans le but assumé d'augmenter la complexité des rencontres
+interbloubs.
+
+<u>tTh, janvier 2024</u>
+
+
+
 

BloubWorld/essai.f90

@@ -1,18 +1,10 @@
 program essai
 
-  use bloubspace
+!  use bloubspace
-  use mathstuff
+  use mathstuff2
   implicit none
 
-  type(t_boundingbox)    :: bbox
+  call test_random(10)
-
-  call load_boundingbox("WS/boundinboxes.dat", bbox, "cube    ")
-
-  print *, bbox
-
-
-  ! call test_random(20)
-
 
   STOP ': BECAUSE JOB IS DONE'
 
@@ -20,18 +12,19 @@ program essai
          contains
 
 subroutine test_random(nbre)
+  implicit none
   integer, intent(in)         :: nbre
-  integer                     :: foo, bar
+  integer                     :: foo
-  real                        :: quux
+  real                        :: quux, bar
   double precision            :: somme
 
   call init_random_seed()           ! in module 'mathstuff'
   somme = 0.0
   do foo=1, nbre
-    quux = rand()
+    quux = 10.0 * rand()
     somme = somme + quux
-    bar = mod(irand(), 7)
+    bar = quux ** (.1/.3)
-    print *, foo, quux, somme/foo, bar
+    print *, quux, bar, somme/foo
   enddo
 end subroutine test_random
 ! --------------------------------------------------------------

BloubWorld/exportbloubs.f90

@@ -34,12 +34,13 @@ program exportbloubs
     endif
     if (bloub%alive) then
       print *, bloub%px, bloub%py, bloub%pz, bloub%radius,     &
-               bloub%age, bloub%state
+               bloub%age, bloub%state, "   ",                  &
+               bloub%red, bloub%green, bloub%blue
       compte = compte + 1
     endif
   enddo
   
-  write(0, '(1X, I8, A)') compte, " bloubs exported"
+  write(0, '(1X, I0, A)') compte, " bloubs exported"
 
   close(idu)
 

BloubWorld/genbloubs.f90

@@ -1,7 +1,7 @@
 program genbloubs
 
   use bloubspace
-  use mathstuff
+  use mathstuff2
 
   integer               :: nbbloubs
   integer               :: i
@@ -33,8 +33,8 @@ program genbloubs
 
     bloub%nick    = 'noname  '
     bloub%num     = i + 41
-    call random_pv(bloub)
+    call make_a_random_bloub(bloub, 11.80)
-    bloub%radius  = 0.035 + (0.03*rand())
+    bloub%radius  = 0.010 + (0.12*rand())
 
     write(idu) bloub              ! no error control ?
 

BloubWorld/listbloubs.f90

@@ -1,4 +1,4 @@
-program movebloubs
+program listbloubs
 
   use bloubspace
   implicit none
@@ -33,13 +33,13 @@ program movebloubs
   write(0, '(A,I6,1X,A)') "slurped ", nbgot, "bloubs"
 
   do i=1, nbgot
-    write(6, '(A8, 1X, 1L, 1X, I2, 3X, F8.3, 3X, 3F8.3, 3X, 3F8.3, 1X, I4)')  &
+    write(6, '(A8, 1X, 1L, 1X, I2, 1X, F8.3, 1X, 3F8.3, 1X, 3F8.3, 1X, 2I4)')  &
           bloubs(i)%nick, bloubs(i)%alive,               &
           bloubs(i)%state,                               &
           bloubs(i)%radius,                              &
           bloubs(i)%px, bloubs(i)%py, bloubs(i)%pz,      &
           bloubs(i)%vx, bloubs(i)%vy, bloubs(i)%vz,      &
-          bloubs(i)%age
+          bloubs(i)%age, bloubs(i)%agemax
   enddo
 
 end program

BloubWorld/mathstuff.f90

@@ -8,18 +8,20 @@ module mathstuff
   !                  not really tested yet...
 
   subroutine init_random_seed()
+    implicit none
 
     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
+    ! write(0, '(A,3I3,A,I6)') " sranding: ", tarray, " --> ", t3
     call srand(t3)
 
     ! after initializing the random generator engine,
     ! you MUST use it for initializing the initializer
-    do foo=1, tarray(1)+5
+    do foo=1, tarray(1)+15
       dummy = rand()
     enddo
 

BloubWorld/mergebloubs.f90

@@ -5,6 +5,7 @@ program mergebloubs
           !-------------------------------------------!
 
   use bloubspace
+  use mathstuff2
   implicit none
 
   integer, parameter       :: NB_MAX_BLOUBS = 250000
@@ -24,16 +25,18 @@ program mergebloubs
   call getarg(1, infile)
   call getarg(2, outfile)
 
-  write(0, '(A, 2A15, I8)') "### mergebloubs ",        &
+  write(0, '(A, A, 1X, A, 1X, I6)') "### mergebloubs ",        &
                  trim(infile), trim(outfile), NB_MAX_BLOUBS
 
+  call init_random_seed()
+
   allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY"
   endif
 
   call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
-  write(0, '(A,I6,1X,A)') " slurped ", nbgot, "bloubs"
+  write(0, '(A,I0,1X,A)') " slurped ", nbgot, "bloubs"
 
   contacts = 0
   do ia = 1, nbgot
@@ -42,19 +45,28 @@ program mergebloubs
       dist = distance_of_bloubs(bloubs(ia), bloubs(ib))
       radd = bloubs(ia)%radius + bloubs(ib)%radius
       if (dist .LT. radd) then
+
         contacts = contacts + 1
         call merge_two_bloubs(bloubs(ia), bloubs(ib), merged)
         bloubs(ia)       = merged
         bloubs(ia)%nick  = "marged"
         bloubs(ia)%state = 1;
         bloubs(ib)%alive = .FALSE.
+        write(0, *) "  *** merged ", ia, " and ", ib,       &
+                    "   new r = ",  merged%radius
+
+        ! call display_bloub (bloubs(ia), "juste merged")
+
       endif
 
     enddo
   enddo
 
   call spit_bloubs_to_file (outfile, bloubs, nbgot)
-  print *, contacts, "contacts pour ", nbgot, "bloubs"
+  if (contacts .GT. 0) then
+    write(0, '(A,I0,A,I0,A)') &
+          " merge: ", contacts, " contacts pour ", nbgot, " bloubs"
+  endif
 
   ! STOP 'mergebloubs [done]'
 
@@ -63,12 +75,21 @@ program mergebloubs
 contains
 
   subroutine merge_two_bloubs(bla, blb, blr)
+      implicit none
       type(t_bloubs), intent(in)   :: bla, blb
       type(t_bloubs), intent(out)  :: blr
 
+      real             :: va, vb
+!-
+! XXX please insert here a static counter for the 'num' id
+!-
+
       blr%nick     = "merged  "
       blr%num      = 0                !    ???
 
+      va = bla%radius * bla%radius * bla%radius
+      vb = blb%radius * blb%radius * blb%radius
+
       blr%px = (bla%px + blb%px) / 2.0
       blr%py = (bla%py + blb%py) / 2.0
       blr%pz = (bla%pz + blb%pz) / 2.0
@@ -76,8 +97,13 @@ contains
       blr%vx = (bla%vx + blb%vx) / 2.0
       blr%vy = (bla%vy + blb%vy) / 2.0
       blr%vz = (bla%vz + blb%vz) / 2.0
+      if (0.001 .GT. rand()) then
+         blr%vx = blr%vx * 1.04
+         blr%vy = blr%vy * 1.04
+         blr%vz = blr%vz * 1.04
+      endif
 
-      blr%radius = (bla%radius + blb%radius) / 2.222
+      blr%radius = (va + vb) ** 0.33335
       blr%age = min(bla%age, blb%age)
 
       ! bring it to life !

BloubWorld/movebloubs.f90

@@ -2,7 +2,7 @@ program movebloubs
 
   use bloubspace
   use povstuff
-  use mathstuff
+  use mathstuff2
 
   implicit none
 
@@ -14,8 +14,6 @@ program movebloubs
   ! logical                  :: add_new_bloub = .TRUE.
   real                     :: rnd
 
-  call init_random_seed()
-
   i = IARGC()
   if (i .ne. 2) then
     STOP ": BAD ARGS ON COMMAND LINE"
@@ -26,6 +24,8 @@ program movebloubs
   write (0, '(A)') &
   "### moving bloubs from "//trim(infile)//" to "//trim(outfile)
 
+  call init_random_seed()
+
   open(newunit=inu,                                          &
                   file=trim(infile), form='unformatted',     &
                   iostat=errcode,                            &
@@ -48,6 +48,9 @@ program movebloubs
   compteur = 0
   killed   = 0
 
+!-
+!		begin of bigloop
+!-
   do
     read (unit=inu, iostat=errcode) bloub
     if (0 .ne. errcode) then
@@ -58,15 +61,19 @@ program movebloubs
     ! moving, morphing and boundingboxing
     call move_bloub     (bloub, 0.185)
     call bound_a_bloub  (bloub)
-    if (bloub%radius .GT. 0.0238) then
+    if (bloub%radius .GT. 3.50) then
-      bloub%radius = bloub%radius * 0.996
+      bloub%radius = bloub%radius * 0.999
     endif
 
-    call green_soylent (bloub)
+    ! if (bloub%radius .LT. 0.00015) then
-    if (.NOT. bloub%alive) then
+    !   bloub%alive = .FALSE.
-      ! write(0, '(A)') "   KILL!"
+    ! endif
-      killed = killed  + 1
+
-    endif
+    ! XXX call green_soylent (bloub)
+    ! XXX if (.NOT. bloub%alive) then
+    ! XXX   ! write(0, '(A)') "   KILL!"
+    ! XXX   killed = killed  + 1
+    ! XXX endif
 
     ! calcul du barycentre
     bx = bx + dble(bloub%px)
@@ -83,53 +90,47 @@ program movebloubs
 
   enddo                     ! end of main loop
 
-  write(0, '(I5,1X,A)') compteur, "bloubs processed"
+  write(0, '(1X,I0,1X,A)') compteur, "bloubs processed"
-
+  if (killed .GT. 0) then
-  ! ok, we have read all the bloubs in the input file
+    write (0, '(1X,I0,A)') killed, " bloubs killed"
-
-  ! insert some fancy conditional here
-  if (compteur .LT.  200) then
-    call add_more_bloubs(outu, 4, 0.1056)
   endif
 
-  ! insert some very fancy conditional here
+  ! ok, we have read all the bloubs from the input file
-  if (compteur .LT. 800) then
+
-    rnd = rand()
+  ! insert some fancy conditional here
-    write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd
+  if (compteur .LT. 50) then
-    if (rnd .LT. 0.0604) then
+    call add_more_bloubs(outu, 5, 0.046)
-      call add_more_bloubs(outu, 11, 0.099)
+  endif
-    endif
+
+  rnd = rand()
+  ! write(0, *) 'rnd= ', rnd
+  if (rnd .LT. 0.18) then
+    write (0, *) '... random of life ...'
+    call add_more_bloubs(outu, 5, 0.056)
   endif
 
   close(inu)    ;    close(outu)
 
-  if (killed .GT. 0) then
-    write (0, '(I5,A)') killed, " bloubs killed"
-  endif
-
-  bx = bx / dble(compteur)
-  by = by / dble(compteur)
-  bz = bz / dble(compteur)
-  write (0, '(A,3(F12.6,3X))') "barycentre : ", bx, by, bz
-
 ! --------------------------------------------------------------
 contains
 
   subroutine add_more_bloubs(un, nbre, rayon)
+  implicit none
   integer, intent(in)        :: un, nbre
   real,    intent(in)        :: rayon
   type(t_bloubs)             :: bloub
   integer                    :: foo, count
 
-  count = nbre+mod(irand(), 6)
+  count = nbre+mod(irand(), 2)
-  write(0, '(A,I4,1X,A)') "adding", count, "bloubs"
+  write(0, '(1X,A,I0,1X,A)') "movebloubs: adding ", count, " bloubs"
 
   do foo=1, count
 
     bloub%nick = 'newbie  '
-    call random_pv(bloub)
+    call make_a_random_bloub(bloub, 10.00)
-    bloub%radius = rayon + (0.15*rand())
+    bloub%radius = rayon + (0.11*rand())
     bloub%age   = 1
+    bloub%agemax = 160 + (count * 4)
     bloub%alive = .TRUE.
     bloub%num   = mod(irand(), 42)
     write(un) bloub              ! no error control ?

BloubWorld/plotbary.sh

@@ -0,0 +1,5 @@
+#!/bin/bash
+
+BARYDATAS="WS/log.barycentres"
+
+wc -l $BARYDATAS

BloubWorld/plotworld.sh

@@ -0,0 +1,24 @@
+#!/bin/bash
+
+INFILE="out.blbs"
+SSV="WS/out.ssv"
+IMAGE="dessin.png"
+
+./listbloubs $INFILE > $SSV
+
+
+timestamp=$(date --utc)
+
+gnuplot << __EOC__
+set term png    size 720,720
+set output      "${IMAGE}"
+set grid        front
+set tics	1
+
+set title       "High density bloub world - ${timestamp}"
+
+plot			\
+	"${SSV}"  using 5:6 lt rgb "#002090"
+__EOC__
+
+echo 'done'

BloubWorld/povstuff.f90

@@ -13,6 +13,7 @@ module povstuff
   contains               ! -----------------------------------------
 
   subroutine show_bbox( bbox )
+    implicit none
     type (t_boundb), intent(in)     :: bbox
 
     print *, bbox%bbminx, bbox%bbminy, bbox%bbminz
@@ -23,6 +24,7 @@ module povstuff
   ! ----------------------------------------------------------------
 
   subroutine start_of_inc_file (fd)
+    implicit none
     integer, intent (in)             :: fd
 
     write(fd, '(A)') "// DON'T EDIT THIS FILE !"

BloubWorld/runme.sh

@@ -7,16 +7,19 @@
 
 INCFILE="WS/bloubs.inc"
 TMPPNG="/dev/shm/bloubs7.png"
-POVOPT="+Q9 +a -v -d -W1600 -H1200 -WT2"
+POVOPT="+Q9 +a -v -d -W1024  -H768 -WT2"
 DDIR="frames/a"
 LOGERR="log.error"
-TXTCOLOR="GreenYellow"
+TXTCOLOR="#db4090"
+
+BLOUBDATAS="WS/bloubs.data"
+BARYDATAS="WS/log.barycentres"
 
 # --- put the work file in ramdisk
 BLBS_IN="/dev/shm/in.blbs"
 BLBS_OUT="/dev/shm/out.blbs"
 
-NBIMG=3000
+NBIMG=2000
 
 make all
 err=$?
@@ -31,50 +34,55 @@ printf "\n#declare NbImg = %d;\n" $NBIMG > WS/nbimg.inc
 #    first, we have to make a seminal buch of bloubs
 #    --> this function need to be parametrizable
 #
-./genbloubs ${BLBS_IN}   3
+./genbloubs ${BLBS_IN}  2
 
 for idx in $(seq 0 $((NBIMG-1)) )
 do
 
-	echo "======== run passe $idx ========="
+	echo "================= run passe $idx ===================="
 
-	./exportbloubs ${BLBS_IN} | awk -f toinc.awk > $INCFILE
+	# make the bloubs's data readable by POVray
+	#
+	./exportbloubs ${BLBS_IN} > $BLOUBDATAS
+        awk -f toinc.awk < $BLOUBDATAS > $INCFILE
+	awk '{ print $1, $2, $3 }' < $BLOUBDATAS > $BARYDATAS
+
+	echo "### raytracing pass $idx"
 
 	povray -Iscene.pov -K${idx} -O${TMPPNG} ${POVOPT} 2> $LOGERR
 	if [ 0 -ne $? ] ; then
 		tail -15 $LOGERR
-		sleep 30
+		sleep 90
 	fi
 
-	td=$(date +'%F %R:%S')
+	td=$(date -u +'%F %R' | tr '01' 'ol')
-	hi=$(printf "#%05d" $idx)
+	hi=$(printf "#%04d" $idx | tr '01' 'ol')
-	count=$(tail -1 "WS/log.nb_bloubs")
+	count=$(tail -1 "WS/log.nb_bloubs" | tr '01' 'ol')
 
 	PNG=$(printf "%s/%05d.png" ${DDIR} $idx)
 
 	convert		${TMPPNG}			\
 			-font Courier-Bold		\
-			-pointsize 28			\
+			-pointsize 32			\
 			-fill "$TXTCOLOR"		\
 			-gravity south-east		\
 			-annotate +25+5 "$td"		\
 			-gravity south-west		\
 			-annotate +25+5 "$hi"		\
-			-pointsize 48			\
 			-gravity north-east		\
 			-annotate +45+5 "$count"	\
 			-gravity north-west		\
 			-annotate +45+5 "BloubWorld"	\
 			$PNG
 
-	echo $PNG '[done]'
+	echo ' ' $PNG '[done]'
 
 	./movebloubs ${BLBS_IN} ${BLBS_OUT}
 	./mergebloubs ${BLBS_OUT} ${BLBS_IN}
 	# mv ${BLBS_OUT} ${BLBS_IN}
 
-	echo
+	echo "### run done"
-	sleep 90
+	sleep 35
 
 done
 

BloubWorld/scene.pov

@@ -29,60 +29,112 @@ object	{
 	finish { phong 0.57 specular 0.57 }
 	}
 
-object {
+#declare La_Boite = object
-	union {
+{
-		plane	{ <1, 0, 0>, -37 	}
+union {
-		plane	{ <1, 0, 0>,  37	}
+	plane	{ <1, 0, 0>, -37 	}
-		plane	{ <0, 1, 0>, -27	}
+	plane	{ <1, 0, 0>,  37	}
-		plane	{ <0, 1, 0>,  27	}
+	plane	{ <0, 1, 0>, -27	}
-		plane	{ <0, 0, 1>,  69 	}
+	plane	{ <0, 1, 0>,  27	}
-
+	plane	{ <0, 0, 1>,  69 	}
-		texture {
+	texture {
-			pigment { color srgb <0.125, 0.144, 0.111> } 
+		pigment { color srgb <0.225, 0.244, 0.211> } 
-			finish { phong 0.18 metallic 0.25 reflection 0.35 }
+		finish { phong 0.18 metallic 0.25 reflection 0.35 }
-			}
 		}
 	}
+}
 
-// object { cylinder { <0, 0, 0>, <10, 0, 0>, 0.05 pigment { color Cyan } } }
+cylinder { 0, -y, 30
+	texture {
+		pigment { color srgb <0.225, 0.244, 0.211> } 
+		finish { phong 0.18 metallic 0.25 reflection 0.10 }
+		}
+translate -6.20*y
+}
+
+sky_sphere {
+  pigment { color Gray20 }
+  emission rgb <0.01, 0.01, 0.01>
+  }
+
+//  ----------------------------------------------------------
+
+#declare Croisillon = object
+{
+#local SC = 0.75;
+union	{
+	cylinder { -SC*x, SC*x, 0.04 }
+	cylinder { -SC*y, SC*y, 0.04 }
+	cylinder { -SC*z, SC*z, 0.04 }
+	}
+texture	{
+	pigment { color Gray50 }
+	}
+}
+
+object { Croisillon scale 0.90 translate <Bary_X, Bary_Y, Bary_Z> }
 
 //  ----------------------------------------------------------
 
 #declare BH = 6;		// H = taille en horizontal
-#declare BV = 4;		// V = taille en vertical
+#declare BV = 6;		// V = taille en vertical
-#declare BR = 0.034;
+#declare BR = 0.056;
 
 #declare Une_Borne = object
 {
 merge	{
 	cylinder { <0, BV, 0>,   <0, -BV,   0>,   BR     }
-	cylinder { <0, 0.014, 0>, <0, -0.014, 0>,   BR*4   }
+	cylinder { <0, 0.042, 0>, <0, -0.042, 0>,   BR*1.90   }
 	}
 }
 
+#local Ruc = BR * 0.90;
+#local Rud = BR * 0.30;
+
 #declare Un_Cadre = object
 {
 merge {
-	#local Ruc = BR * 0.90;
 	cylinder { <-BH, 0, -BH>, <-BH, 0,  BH>,   Ruc    }
 	cylinder { < BH, 0, -BH>, < BH, 0,  BH>,   Ruc    }
 	cylinder { < BH, 0, -BH>, <-BH, 0, -BH>,   Ruc    }
 	cylinder { < BH, 0,  BH>, <-BH, 0,  BH>,   Ruc    }
+	cylinder { < BH, 0,   0>, <-BH, 0,   0>,   Rud  }
+	cylinder { <  0, 0, -BH>, <  0, 0,  BH>,   Rud  }
+	}
+texture {
+	pigment { color Gray50 }
+	finish { phong 0.87 specular 0.57 }
+	}
+}
+
+#declare Montants = object
+{
+union	{
+	cylinder { <-BH, -BH,   0>, <-BH, BH,   0>,   Rud  }
+	cylinder { < BH, -BH,   0>, < BH, BH,   0>,   Rud  }
+	cylinder { <  0, -BH, -BH>, <  0, BH, -BH>,   Rud  }
+	cylinder { <  0, -BH,  BH>, <  0, BH,  BH>,   Rud  }
+	}
+texture {
+	pigment { color Gray50 }
+	finish { phong 0.57 specular 0.87 }
 	}
-pigment { color Gray40 }
 }
 
 #declare Les_Bornes = object
 {
 union	{
-	#local E = 0.0015;
+	#local E = 0.0005;
 	object { Un_Cadre translate  y*(BV-E)         }
 	object { Un_Cadre translate -y*(BV-E)         }
 
-	object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue }  }
+	object { Montants }
-	object { Une_Borne translate < BH, 0, -BH> pigment { color Green } }
+
-	object { Une_Borne translate <-BH, 0,  BH> pigment { color Green } }
+	#local G = Green * 0.80;
-	object { Une_Borne translate < BH, 0,  BH> pigment { color Red }   }
+	object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue*0.9 }  }
+	object { Une_Borne translate < BH, 0, -BH> pigment { color G } }
+	object { Une_Borne translate <-BH, 0,  BH> pigment { color G } }
+	object { Une_Borne translate < BH, 0,  BH> pigment { color Red*0.9 }   }
 	}
 }
 
@@ -109,22 +161,20 @@ union {
 }
 //  ----------------------------------------------------------
 
-light_source { <19, -12+NormClock, -17> color Gray80 }
+light_source { < 19,  12+NormClock, -17> color Gray80 }
-light_source { <11,  14-NormClock,   9> color Gray60 }
+light_source { <-14,  10-NormClock, -29> color Gray70 }
 
-#declare XCAM = 8 - ( 15 * NormClock);
+#declare XCAM = 5 - ( 10 * NormClock);
-#declare YCAM = -1.1 + (0.95 * NormClock);
+#declare YCAM = -1.1 + (1.25 * NormClock);
-#declare ZCAM = -13.10;
+#declare ZCAM = -19.20;
 
-#declare XLAT = Bary_X;
+#declare XLAT = 0;
-#declare YLAT = Bary_Y;
+#declare YLAT = 0;
-#declare ZLAT = Bary_Z;
+#declare ZLAT = 0;
-
-// object { Repere scale 2.5 translate <XLAT, YLAT, ZLAT> }
 
 camera  {
 	location   <XCAM, YCAM, ZCAM>
 	look_at    <XLAT, YLAT, ZLAT>
 	right           x*image_width/image_height
-	angle		86
+	angle		64
 	}

BloubWorld/toinc.awk

@@ -9,6 +9,8 @@ BEGIN	{
 	count = 0
 	bx = by = bz = 0.0
 	print "// GENERATED FILE, DON'T TOUCH IT !"
+	print "// --------------------------------"
+	print
 	print "#declare Bloubs = object\n{"
 	print "union\t{"
 	}
@@ -18,27 +20,31 @@ BEGIN	{
 	merged = $6
 
 	color = "Cyan"
-	if (age < 2)		color = "Yellow"
 	if (merged) {
-		if (age > 12)	color = "Orange"
+		if (age > 150)	color = "Orange"
-		else		color = "Red"
+		else		color = "Yellow"
 		}
 	else	{
-		if (age > 12)	color = "CadetBlue"
+		if (age > 150)	color = "DarkGreen"
 		else		color = "Aquamarine"
 		}
+	if (age < 18)		color = "Gray40"
+	if (age <  9)		color = "Blue"
 
 	bx += $1
 	by += $2
 	bz += $3
 	pigment = "pigment { color " color " }"
-	printf "\tsphere { <%f, %f, %f>, %f %s }\n",	\
+	printf "\tsphere { <%f, %f, %f>, %f \n\t\t%s }\n",	\
 			  $1, $2, $3,  $4, pigment
 	count++
 	}
 
 END	{
-	print "\t}  // end of union\n}\n"
+	# print "\t}\n"
+        print "\t} // end of union\n"
+	print "finish { phong 0.57 specular 0.67 }\n"
+        print "}\n"
 	print "#declare Nb_Bloubs = ", count, ";\n"
 	print "#declare Bary_X = ", bx/count, ";";
 	print "#declare Bary_Y = ", by/count, ";";

Call_the_C/.gitignore

@@ -0,0 +1,2 @@
+call_the_c
+*.o

Call_the_C/Makefile

@@ -0,0 +1,20 @@
+#
+#	Fortran calls to a C function
+#
+
+all:	call_the_c
+
+# ----------------------------------------------------------
+
+first-try.o:	first-try.c Makefile
+	gcc -Wall -g -c $<
+
+soundfiles.o:	soundfiles.c Makefile
+	gcc -Wall -g -c $<
+
+# ----------------------------------------------------------
+
+call_the_c:	call_the_c.f90 Makefile first-try.o
+	gfortran -Wall -g $< first-try.o -o $@
+
+# ----------------------------------------------------------

Call_the_C/README.md

@@ -0,0 +1,12 @@
+# Calling a C function
+
+WARNING : THIS IS A WIP !
+
+## Unix utilities
+
+getpid, sleep, ...
+
+## libsndfile
+
+Bibliothèque de fonctions pour lire et écrire les fichiers sonores.
+

Call_the_C/call_the_c.f90

@@ -0,0 +1,15 @@
+program call_the_c
+  implicit none
+
+  integer                :: foo
+  integer, external      :: give_me_my_pid
+
+  print *, "XXX we are calling a C func"
+  call first_try ()
+  foo = give_me_my_pid()
+  print *, "process id = ", foo
+  print *, "XXX are we alive ?"
+
+end program
+
+

Call_the_C/first-try.c

@@ -0,0 +1,24 @@
+/*
+ *		first try of a C func called from Fortran
+ */
+
+#include  <stdio.h>
+#include  <unistd.h>
+
+/* --------------------------------------------------------------- */
+void first_try_(void)
+{
+fprintf(stderr, "     pid=%u  file='%s'  func='%s' \n",
+		(long)getpid(), __FILE__, __func__);
+}
+/* --------------------------------------------------------------- */
+long give_me_my_pid_ (void)
+{
+pid_t		my_pid;
+
+my_pid = (long)getpid();
+fprintf(stderr, " %s -> %d\n", __func__, my_pid);
+
+return my_pid;
+}
+/* --------------------------------------------------------------- */

Call_the_C/soundfiles.c

@@ -0,0 +1,11 @@
+/*
+ *			SOUNDFILES
+ *			----------
+ *
+ *	Interface pour libsndfile
+ */
+
+#include   <stdio.h>
+
+/* --------------------------------------------------------------- */
+/* --------------------------------------------------------------- */

Fraktalism/.gitignore

@@ -6,6 +6,7 @@ mkmandel
 voxelize
 evolvopick
 henon
+mkhenon
 essai
 plotcolmap
 
@@ -17,6 +18,7 @@ WS/*.inc
 toto
 
 *.pgm
+*.pnm
 *.gif
 *.asc
 *.png

Fraktalism/Makefile

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

Fraktalism/README.md

@@ -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,10 +48,11 @@ 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
 
 ## See also
 
 - https://www.maths.town/fractal-articles/mandelbulb/mandelbulb-all-powers/
+- https://discuss.pixls.us/t/intriguing-shapes-in-buddhabrot-like-fractals/41816

Fraktalism/encode.sh

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

Fraktalism/fraktals.f90

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

Fraktalism/henon.f90

@@ -1,31 +1,10 @@
-program henon
+module henon
 
   implicit none
-
+  contains
-  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
+
-!-----------------------------------------------------
-!-----------------------------------------------------
 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
 

Fraktalism/julias.f90

@@ -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
+    integer      ::  ix, iy, width, height, iter
-    real         ::  fx, fy
+    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)%r = mod(int(modulus2(Z)*2000.0), 255)
-            pic(ix, iy)%g = mod(abs(int(real(Z) *140)), 255)
+            pic(ix, iy)%g = mod(abs(int(real(Z) *11.0)), 255)
-            pic(ix, iy)%b = mod(abs(int(aimag(Z)*140)), 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)%r = mod(iter*11, 255)
-            pic(ix, iy)%g = mod(iter*29, 255)
+            pic(ix, iy)%g = mod(iter*14, 255)
-            pic(ix, iy)%b = mod(iter*21, 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

Fraktalism/mandelbrots.f90

@@ -28,7 +28,7 @@ subroutine mandelbrot_one(pic, start)
     integer   :: iter, maxiter
     logical   :: escape
 
-    write(0,*) "> plotsomething"
+    ! write(0,*) "> plotsomething"
 
     width  = ubound(pic, 1)
     height = ubound(pic, 2)
@@ -37,7 +37,7 @@ subroutine mandelbrot_one(pic, start)
 
     !   initialise constants
     ! 
-    maxiter =  1984
+    maxiter =  3456
 
     !   enter megaloop
     ! 

Fraktalism/mkhenon.f90

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

Fraktalism/mkjulia.f90

@@ -26,11 +26,15 @@ program julia
     call getarg(2, string)       ;   read (string, *) cx
     call getarg(3, string)       ;   read (string, *) cy
 
-    allocate(picz(640, 480))
+    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
 
 !-----------------------------------------------------

Fraktalism/mkjuliagif.sh

@@ -3,7 +3,6 @@
 #
 #	build the prog
 #
-
 make mkjulia
 if [ $? -ne 0 ] ; then
 	echo
@@ -11,26 +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)
+	# make mkjulia
-	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)
 
-	./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
+
+	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
+./encode.sh frames/julia/ foo.mp4
-# animate foo.gif &
-

Fraktalism/mkmandel.f90

@@ -23,9 +23,9 @@ program mkmandel
 
     write(0, *) "-------- making some mandelbrot -------"
 
-    allocate(pic(1024, 768))
+    allocate(pic(640, 480))
 
-    do angle = 0, 1500
+    do angle = 0, 2000
 
         call rgbpix_set_to_zero(pic)
 
@@ -33,10 +33,10 @@ program mkmandel
         radius   = float(angle) / 2000.0
         write (filename, "(a, i5.5, a)") "frames/mandel/", angle, ".pnm"
         ! filename = trim(filename)
-        write(0,*) "#### passe ", angle, radangle, trim(filename)
+        write(0,*) "passe ", angle, radangle, trim(filename)
 
-        stx = radius * (sin(radangle*2.07) + 0.2131*sin(radangle*7.36))
+        stx = radius * (sin(radangle*4.07) + 0.2131*sin(radangle*11.36))
-        sty = radius * (cos(radangle*3.21) + 0.2725*cos(radangle*9.99))
+        sty = radius * (cos(radangle*6.21) + 0.2725*cos(radangle*10.99))
 
         call mandelbrot_one(pic, complex(stx, sty))
         call rgbpix_spit_as_pnm_8 (pic, trim(filename))

Fraktalism/tagpicz.sh

@@ -15,12 +15,12 @@ fi
 for img in $SDIR/*.pnm
 do
 
-	mogrify					\
+	mogrify						\
-		-gravity South-East		\
+		-gravity South-East			\
-		-font Courier			\
+		-font Courier-Bold			\
-		-pointsize 12			\
+		-pointsize 12				\
-		-fill Yellow			\
+		-fill Black				\
-		-annotate +10+10 "tTh 2023"	\
+		-annotate +10+4 "Konrad+tTh 2024"	\
 		$img
 	echo "tagging " $img
 

GrafAnim/.gitignore

@@ -3,6 +3,10 @@ essai
 doubledice
 doublegauss
 trigofest
+noisepic
+geowaves
+soundscope
+readpicz
 
 *.scratch
 *.genplot
@@ -11,4 +15,7 @@ F/*.tga
 *.gif
 *.pnm
 *.pgm
+*.data
+*.png
+log.txt
 

GrafAnim/Makefile

@@ -3,24 +3,39 @@
 #
 
 GFOPT = -Wall -Wextra -g -time  -I../Modules
+MYLIB = '../Modules/libtth90modules.a'
 
 # ---- programmes
 
-essai:	essai.f90 usegenplot.o Makefile
+essai:	essai.f90 Makefile
-	gfortran $(GFOPT) $< usegenplot.o -o $@
+	gfortran $(GFOPT) $< $(MYLIB) -o $@
+
+geowaves:	geowaves.f90 Makefile
+	gfortran $(GFOPT) $< $(MYLIB) -o $@
 
 doubledice:	doubledice.f90 Makefile	\
 		utils_ga.o usegenplot.o
 	gfortran $(GFOPT) $< usegenplot.o utils_ga.o -o $@
 
 doublegauss:	doublegauss.f90 Makefile utils_ga.o
-	gfortran $(GFOPT) $<  ../Modules/pixrgb.o  utils_ga.o -o $@
+	gfortran $(GFOPT) $<  $(MYLIB)  utils_ga.o -o $@
 
 trigofest:	trigofest.f90 Makefile vue3axes.o utils_ga.o
-	gfortran $(GFOPT) $<  ../Modules/pixrgb.o  ../Modules/spitpgm.o \
+	gfortran $(GFOPT) $<  $(MYLIB) utils_ga.o -o $@
-			utils_ga.o -o $@
 
-# ---- modules locaux
+noisepic:	noisepic.f90  Makefile
+	gfortran $(GFOPT) $< $(MYLIB) -o $@
+
+wavmetrics.o:	wavmetrics.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+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
 	gfortran $(GFOPT) -c $<

GrafAnim/README.md

@@ -1,24 +1,36 @@
 # GrafAnim
 
 Quelques essais approximatifs pour faire des graphiques inutiles,
-dans une démarche mettant en avant la techno-futilité, une notion
+dans une démarche mettant en avant la
-bien définie par le collectif Interhack.
+[techno-futilité](https://wiki.interhacker.space/index.php?title=Techno-futilit%C3%A9),
+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
 
 Distorsions approximatives de la courbe de Lissajous.
-
+Expériences inspirées par [ce site](https://bleuje.com/tutorial1/)
-Expériences inspirées par  https://bleuje.com/tutorial1/ que c'est d'la balle !
+que c'est d'la balle !
 
 ## doubledice
 
-Ou comment dessiner des gaussiennes.
+Ou comment dessiner des gaussiennes en jetant des dés.
+
+## soundscope
+
+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.
 
-## vue3axes
 
-Un module assez spécialisé

GrafAnim/doublegauss.f90

@@ -4,7 +4,7 @@ program doublegauss
   implicit none
 
   type(t_pixrgb), allocatable     ::    pic(:,:)
-  character (len=80)              ::    filename
+  character (len=280)             ::    filename
   integer                         ::    pass, iter
   integer                         ::    xrnd, yrnd
 

GrafAnim/essai.f90

@@ -1,46 +1,97 @@
 program essai
-  use usegenplot
+
+! *******************************************
+!      CE TRUC NE MARCHE PAS /O\
+! *******************************************
+
+  use pixrgb
   implicit none
 
-  integer                   :: foo, bar
   integer                   :: nbarg
-  integer                   :: numframe = 0
+  integer                   :: param0 = 10
   character(len=256)        :: arg
 
-  ! write(0, *)   "------------ essai graf anim ---------------"
+  ! integer                   :: foo, bar
+
+  integer                   :: width  = 512
+  integer                   :: height = 342
+  integer                   :: seqnum
+  real                      :: nclock, kx, ky
+  character (len=280)       :: filename
+
+  type(t_pixrgb), allocatable      :: pix(:,:)
+
+  write(0, *)   "--------- essai FLUFFYWAVES ------------"
 
   nbarg = IARGC()
   if (nbarg .GT. 0) then
        call GETARG(1, arg)
        ! write (0, '(A40, A5)') "argument = ",  arg
-       read (arg, *) numframe
+       read (arg, *) param0
   endif
 
-  write(0, '(A20, I5)')  "frame number =", numframe
+  allocate(pix(width, height))
 
-  call init_genplot("essai.genplot")
+  do seqnum = 0, param0
-  call do_frame(7)
+    nclock = float(seqnum) / float(param0)
+    call rgbpix_set_to_rgb(pix, 0, 0, 0)
 
-  call gplt_setcol(2)
+    kx = nclock * 0.35 * sin(nclock * 7.0)
+    ky = nclock * 0.95 * cos(nclock * 7.0)
+    call iterator (pix, kx, ky, 50000)
 
-  bar = (numframe * 20) - 120
+    write (filename, "(a, i5.5, a)") "./F/np/", seqnum, ".pnm"
-  do foo=20, 620, 50
+    write(0, *)  seqnum, kx, ky, trim(filename)
-    call gplt_line(foo, 20, bar, 460)
+    call rgbpix_spit_as_pnm_16(pix, trim(filename))
-    call gplt_line(bar, 20, foo, 460)
   enddo
 
-  call end_genplot("done for today")
+contains
+! ----------------------------------------------------------
+!-
+subroutine setpixel(pic, x, y)
+  implicit none
+  type(t_pixrgb), intent(inout)   :: pic(:,:)
+  real, intent(in)                :: x, y 
 
-contains        !------------------------------------------
+  integer                         :: ix, iy
 
-subroutine do_frame(color)
+  ix = 600 - int (300.0 * x)
-  integer, intent(in)           :: color
+  iy = 600 - int (300.0 * y)
-  integer                       :: savecol
 
-  savecol = gplt_getcol()
+  ! print *, ix, iy
-  call gplt_setcol(color)
+
-  call gplt_rect(0, 0, 640, 480)
+  if ( (ix .gt. lbound(pic, 1)) .and. (ix .lt. ubound(pic, 1))    &
-  call gplt_setcol(savecol)
+               .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
+     ! XXX write(0, *) 'out', ix, iy
+  endif
+
+end subroutine
+
+! ----------------------------------------------------------
+!-
+subroutine iterator(img, x0, y0, nbi)
+  implicit none
+  type(t_pixrgb), intent(inout)   :: img(:,:)
+  real, intent(in)                :: x0, y0
+  integer, intent(in)             :: nbi
+  real                            :: xa, ya, xb, yb
+  integer                         :: bcl
+
+  xa = x0      ;     ya = y0
+
+  do bcl=0, nbi
+    xb = xa - 0.4 * sin ( ya + sin( 0.4 * ya ) )
+    yb = ya - 0.4 * sin ( xa + sin(  -2 * xa ) )
+    call setpixel(img, xb, yb)
+    xa = xb
+    ya = yb
+  enddo
 
 end subroutine
 

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/go.sh

@@ -2,16 +2,14 @@
 
 set -e
 
-make essai
+make noisepic
 
 for foo in $(seq 0 89)
 do
-	./essai $foo > a.scratch
+
-	fname=$(printf "F/%04d.tga" $foo)
+	./noisepic $foo
-	echo $fname
-	genplot2 -s 640x480 a.scratch $fname
 
 done
 
-convert -delay 10 F/????.tga foo.gif
+convert -delay 10 F/np/*.pnm foo.gif
 

GrafAnim/noisepic.f90

@@ -0,0 +1,67 @@
+program noisepic
+
+  use spitpgm
+  use pixrgb
+  use noisepictures
+  use mathstuff2
+  implicit none
+
+  integer                   :: numframe = 0
+
+  integer                   :: nbarg
+  character(len=256)        :: arg
+  integer                   :: ranges(6)
+  real                      :: fclock, kpi, r1, r3, r5
+
+  nbarg = IARGC()
+  if (nbarg .GT. 0) then
+       call GETARG(1, arg)
+       ! write (0, '(A40, A5)') "argument = ",  arg
+       read (arg, *) numframe
+  endif
+
+  call init_random_seed()
+
+  kpi = 3.151592654 / 3.0
+
+  do numframe = 0, 479
+    fclock = kpi * float(numframe) / 480.0
+    r1 = 27000 + 20000 * cos(fclock*26)
+    ranges(1) = nint(r1)    ; ranges(2) = ranges(1)+300
+
+    r3 = 32000 + 28000 * cos(fclock*29)
+    ranges(3) = nint(r3)    ; ranges(4) = ranges(3)+300
+
+    r5 = 29000 + 23000 * cos(fclock*32)
+    ranges(5) = nint(r5)    ; ranges(6) = ranges(5)+300
+
+    print *, 'r123', numframe, fclock, r1, r3, r5
+
+    call make_noise_color_range_pic (numframe, ranges, 29000)
+  enddo
+
+contains
+!-- ------------------------------------------------------------------
+!--
+!-- ------------------------------------------------------------------
+subroutine make_noise_color_range_pic (seqv, rngs, nbre)
+  implicit none
+  integer, intent(in)        :: seqv, nbre
+  integer, intent(in)        :: rngs(6)
+
+  type(t_pixrgb), allocatable      :: pix(:,:)
+  character (len=280)              :: filename
+
+  allocate(pix(640, 480))
+  call rgbpix_set_to_rgb(pix, 0, 0, 0)
+
+  write (filename, "(a, i5.5, a)") "./F/np/", seqv, ".pnm"
+  ! print *, 'filename: ', trim(filename)
+
+  call noise_range_rgb16_pic(pix, rngs, nbre)
+  call rgbpix_spit_as_pnm_16(pix, trim(filename))
+
+  deallocate(pix)
+end subroutine
+!-- ------------------------------------------------------------------
+end program

GrafAnim/readpicz.f90

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

GrafAnim/soundscope.f90

@@ -0,0 +1,287 @@
+! *****************************************************
+! 
+! *****************************************************
+
+program soundscope
+
+  use pixrgb
+  use utils_ga
+
+  implicit none
+
+  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
+  integer                       :: iter, foo, tx, ty
+  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)
+
+  iter = 0
+  do 
+    write(0, *) "----- iteration", iter, "  -----"
+    iter = iter + 1
+
+    do foo=0, 100
+      tx = (marge/2) + fair_random_gauss(width-marge)
+      ty = (marge/2) + fair_random_gauss(height-marge)
+      if (is_pixel_inside(tx, ty)) then
+        call make_red_dot(pix, tx, ty)
+      endif
+      tx = (marge/2) + fair_random_gauss(width-marge)
+      ty = (marge/2) + fair_random_gauss(height-marge)
+      if (is_pixel_inside(tx, ty)) then
+        call make_blue_dot(pix, tx, ty)
+      endif
+    enddo
+
+    call dim_pix_rgb_mul(pix, 0.86)
+
+    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)
+
+    if (flagdone) then
+      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(:,:)
+  integer, intent(in)            :: nbdata
+  logical, intent(out)           :: jobdone
+  integer                        :: idx, errcode
+  real                           :: vl, vr
+  integer                        :: ix, iy
+
+  jobdone = .FALSE.
+
+  do idx=0, nbdata
+    ! get a sample
+    read(5, *, iostat=errcode) vl, vr
+    if (0 .NE. errcode) then
+      write(0, *) "iostat", errcode
+      jobdone = .TRUE.
+      exit
+    endif
+
+    !   add flash !
+    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 = 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
+  enddo
+
+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
+  logical, intent(out)           :: jobdone
+  integer                        :: idx, errcode
+  real                           :: vl, vr
+  integer                        :: il, ir, xpos
+
+  jobdone = .FALSE.
+  xpos = 1
+
+  do idx=0, nbdata
+    ! get a sample
+    read(5, *, iostat=errcode) vl, vr
+    if (0 .NE. errcode) then
+      write(0, *) "iostat", errcode
+      jobdone = .TRUE.
+      exit
+    endif
+    !   add flash !
+    if ( (idx .LT. 100)       .AND.       &
+       ((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
+      write(0,*) "overshoot in dplot!"
+      call fill_random_gauss(image, 65000, marge)
+    endif
+
+    if (xpos .LT. width) then
+      ! scale it to the window
+      il = int((vl/65536.9) * real(height)) + height/2
+      ir = int((vr/65536.9) * real(height)) + height/2
+      ! print *, vl, il, " | ", vr, ir
+      if (is_pixel_inside(xpos, il)) then
+        call make_big_dot(image, xpos, il)
+      endif
+      if (is_pixel_inside(xpos, ir)) then
+        call make_big_dot(image, xpos, ir)
+      endif
+      xpos = xpos + 1
+    endif
+
+  enddo
+
+end subroutine
+
+!-- ------------------------------------------------------------------
+
+subroutine dessine_cadre(image, R, G, B, border)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer,intent(in)             :: R, G, B, border
+
+  integer                        :: ix, iy, foo
+  
+  foo = ubound(image, 2) - border
+  do ix=1+marge, ubound(image, 1) - border
+      image(ix, marge)%r = R
+      image(ix, marge)%g = G
+      image(ix, marge)%b = B
+      image(ix, foo)%r = R
+      image(ix, foo)%g = G
+      image(ix, foo)%b = B
+  enddo
+
+  foo = ubound(image, 1) - border
+  do iy=1+marge, ubound(image, 2)-border
+      image(marge, iy)%r = R
+      image(marge, iy)%g = G
+      image(marge, iy)%b = B
+      image(foo, iy)%r = R
+      image(foo, iy)%g = G
+      image(foo, iy)%b = B
+  enddo
+
+end subroutine
+
+!-- ------------------------------------------------------------------
+!-- ------------------------------------------------------------------
+function is_pixel_inside(ix, iy)
+  integer,intent(in)        :: ix, iy
+  logical                   :: is_pixel_inside
+ 
+  is_pixel_inside = .TRUE.
+  if ( (ix .LT. marge) .OR. (ix .GT. width-marge) ) then
+    is_pixel_inside = .FALSE.
+    return
+  endif
+  if ( (iy .LT. marge) .OR. (iy .GT. height-marge) ) then
+    is_pixel_inside = .FALSE.
+    return
+  endif
+
+end function
+
+
+!-- ------------------------------------------------------------------
+
+end program soundscope
+

GrafAnim/t_readpicz.sh

@@ -0,0 +1,7 @@
+#!/bin/bash
+
+tga_mires mircol0 mire.tga "Fortran Moderne"
+
+tga_to_text foo.tga | ./readpicz
+
+

GrafAnim/trigofest.f90

@@ -83,8 +83,8 @@ subroutine plot_a_dot(pic, ix, iy, val)
 end subroutine
 
 !-------------------------------------------------------------
-!            La premirere spirale
+!            La premiere spirale
-!            --------------------
+!            -------------------
 
 subroutine spirale(pic, inirad, param)
   implicit none

GrafAnim/utils_ga.f90

@@ -3,6 +3,7 @@
 ! -------------------------------------------------------------------
 
 module utils_ga
+
   use pixrgb
   implicit none
 
@@ -22,8 +23,8 @@ function fair_random_gauss(hilevel)
   integer             :: fair_random_gauss
   integer             :: foo, bar
 
-  foo = int(rand()*hilevel/2)
+  foo = int((rand()*hilevel)/2)
-  bar = int(rand()*hilevel/2)
+  bar = int((rand()*hilevel)/2)
   fair_random_gauss = 1 + foo + bar
 
 end function
@@ -33,9 +34,155 @@ 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
+! -------------------------------------------------------------------
+subroutine make_red_dot(image, ix, iy)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer, intent(in)            :: ix, iy
+
+  image(ix,   iy)%r = 55000
+  image(ix+1, iy)%r = 55000
+  image(ix-1, iy)%r = 55000
+  image(ix+2, iy)%r = 55000
+  image(ix-2, iy)%r = 55000
+  
+end subroutine
+!-- ------------------------------------------------------------------
+subroutine make_blue_dot(image, ix, iy)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer, intent(in)            :: ix, iy
+
+  image(ix,   iy)%b = 65000
+  image(ix, iy+1)%b = 65000
+  image(ix, iy-1)%b = 65000
+  image(ix, iy+2)%b = 65000
+  image(ix, iy-2)%b = 65000
+  
+end subroutine
+!-- ------------------------------------------------------------------
+
+
+subroutine make_big_dot(image, ix, iy)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer, intent(in)            :: ix, iy
+
+  image(ix,   iy)%g   = 65000
+
+  image(ix-1, iy)%g   = 56000
+  image(ix,   iy-1)%g = 56000
+  image(ix+1, iy)%g   = 56000
+  image(ix,   iy+1)%g = 56000
+
+  image(ix+1, iy+1)%g = 24000
+  image(ix-1, iy+1)%g = 24000
+  image(ix+1, iy-1)%g = 24000
+  image(ix-1, iy-1)%g = 24000
+
+end subroutine
+
+!-- ------------------------------------------------------------------
+
+subroutine dim_pix_rgb_sub(pix, k)
+  type(t_pixrgb), intent(inout)  :: pix(:,:)
+  integer,intent(in)             :: k
+  integer                        :: ix, iy
+
+  ! write(0, *) "dim pixrgb", k
+
+  do ix=1, ubound(pix, 1)
+    do iy=1, ubound(pix, 2)
+      if (pix(ix,iy)%r .GT. k) then
+        pix(ix,iy)%r = pix(ix,iy)%r - k
+      endif
+      if (pix(ix,iy)%g .GT. k) then
+        pix(ix,iy)%g = pix(ix,iy)%g - k
+      endif
+      if (pix(ix,iy)%b .GT. k) then
+        pix(ix,iy)%b = pix(ix,iy)%b - k
+      endif
+    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
 ! -------------------------------------------------------------------
 
+subroutine dim_pix_rgb_mul(pix, fk)
+  type(t_pixrgb), intent(inout)  :: pix(:,:)
+  real,intent(in)                :: fk
+
+  integer                        :: ix, iy
+
+  ! write(0, *) "dim pixrgb", k
+
+  do ix=1, ubound(pix, 1)
+    do iy=1, ubound(pix, 2)
+
+      pix(ix,iy)%r = int(float(pix(ix,iy)%r)*fk)
+      pix(ix,iy)%g = int(float(pix(ix,iy)%g)*fk)
+      pix(ix,iy)%b = int(float(pix(ix,iy)%b)*fk)
+
+    enddo
+  enddo
+
+end subroutine
+
+! -------------------------------------------------------------------
+subroutine fill_random_gauss(image, mval, marge)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer,intent(in)             :: mval, marge
+  integer                        :: ix, iy
+
+  ! write(0, *) "dim 1 =", ubound(image, 1)
+  ! write(0, *) "dim 2 =", ubound(image, 2)
+
+  do ix=1+marge, ubound(image, 1)-marge
+    do iy=1+marge, ubound(image, 2)-marge
+      image(ix, iy)%r = fair_random_gauss(mval)
+      image(ix, iy)%g = fair_random_gauss(mval)
+      image(ix, iy)%b = fair_random_gauss(mval)
+    enddo
+  enddo
+
+end subroutine
+
+!-- ------------------------------------------------------------------
 end module

Modules/.gitignore

@@ -1,5 +1,10 @@
 
 chkpixels
+twavm
+trnd
+t_centermag
+
+datas/
 
 *.pgm
 *.pnm

Modules/Makefile

@@ -1,29 +1,67 @@
 #
-#		* Fortraneries *
+#		* Fortraneries from tTh *
 #
-#	Makefile for the general purpose moduls
+#	Makefile for the general purpose modules
 #
 
-GFOPT  =  -Wall  -Wextra  -time  -g
+GFOPT  =  -Wall -Wextra -g -I.
 
-all:	chkpixels
+all:	chkpixels trnd twavm
 
-# -----------------------------------------------
+# ---------------------------------------------------------
 
 spitpgm.o:		spitpgm.f90 Makefile
-	gfortran $(GFOPT) -c $< -o $@
+	gfortran $(GFOPT) -c $<
 
 pixrgb.o:		pixrgb.f90 Makefile
-	gfortran $(GFOPT) -c $< -o $@
+	gfortran $(GFOPT) -c $<
+
+centermag.o:		centermag.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+dummy.o:		dummy.f90 Makefile
+	gfortran $(GFOPT) -c $<
 
 trials.o:		trials.f90 Makefile
-	gfortran $(GFOPT) -c $< -o $@
+	gfortran $(GFOPT) -c $<
 
+mathstuff2.o:	mathstuff2.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+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		wavmetrics.o
+
+libtth90modules.a:	$(OBJECTS) Makefile
+	$(AR) 	rs $@ $?
+
+#	please explain the 'ar' command line
+
+#----------------------------------------------------------
 #     programmes de testouille
 #
-OBJS = trials.o spitpgm.o pixrgb.o
 
-chkpixels:	chkpixels.f90 Makefile $(OBJS)
+chkpixels:	chkpixels.f90 Makefile libtth90modules.a
-	gfortran $(GFOPT) $<  $(OBJS) -o $@
+	gfortran $(GFOPT) -pg $<  libtth90modules.a -o $@
+
+t_centermag:	t_centermag.f90 Makefile libtth90modules.a
+	gfortran $(GFOPT) $<  libtth90modules.a -o $@
+
+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

@@ -1,14 +1,42 @@
 # General purpose modules
 
 
-## spitpgm
+## 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
 
 Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
 
-## pixrgb
+### pixrgb
 
-Write 8 bits RGB pictures to PNM format.
+Write 8 bits or 16 bits RGB pictures to PNM format.
+The width of the picture MUST be a multiple of 4 !
 
-## trials
+### trials
 
 Experimental WIPs from hell.
+
+### dummy
+
+A "do nothing" useless module.
+But you cas use it to fool an optimizing compiler,
+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.
+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
+
+- write the fscking doc !

Modules/centermag.f90

@@ -0,0 +1,67 @@
+
+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
+    integer           :: wscr, hscr      ! "physycal" screen size
+    real              :: mag = 1.0       ! magnitude factor
+    real              :: cx, cy          ! the center
+
+    integer           :: flag = 0
+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
+
+end subroutine
+!-------------------------------------------------------------------
+!-------------------------------------------------------------------
+subroutine  centermag_scr2real (sx, sy, rx, ry)
+    integer, intent(in)         ::  sx, sy
+    real, intent(out)           ::  rx, ry
+
+    print *, 'from scr :', sx, sy
+
+    rx = 999.999
+    ry = 666.666
+
+end subroutine
+!-------------------------------------------------------------------
+subroutine centermag_real2scr (rx, ry, sx, sy)
+    real, intent(in)           ::  rx, ry
+    integer, intent(out)       ::  sx, sy
+
+    print *, 'from real :', rx, ry
+
+    sx = -1
+    sy = -1
+
+end subroutine
+!-------------------------------------------------------------------
+end module

Modules/chkpixels.f90

@@ -11,8 +11,8 @@ program chkpixels
   implicit none
 
   write(0, *)  "------ CHKPIXELS ------"
-  call test_spit_as(3)
+  ! call test_spit_gray(3)
-  call test_spit_rgb(128, 222)
+  call test_spit_rgb16(1100, 512)
 
   STOP 'BECAUSE NO CPU AVAILABLE'
 
@@ -21,7 +21,7 @@ contains
 !-
 !     exerciser for the 'pixrgb' module
 !-
-  subroutine test_spit_rgb(sz, kg)
+  subroutine test_spit_rgb16(sz, kg)
     integer, intent(in)    :: sz, kg
 
     type(t_pixrgb), allocatable  :: pixrgb(:,:)
@@ -30,14 +30,17 @@ contains
     print *, "test spit rgb", sz
     allocate(pixrgb(sz, sz))
     call rgbpix_set_to_zero(pixrgb)
+
     do ix=1, sz
       do iy=1, sz
-        pixrgb(ix, iy)%r = ix
+        pixrgb(ix, iy)%r = mod(ix * iy, 65000)
-        pixrgb(ix, iy)%g = mod(ix*iy, kg)
+        if (ix.EQ.iy) pixrgb(ix, iy)%g = 65000
-        pixrgb(ix, iy)%b = iy
+        pixrgb(ix, iy)%b = mod ((ix*iy) * 13, 65000)
       end do
     end do
-    call rgbpix_spit_as_pnm_8(pixrgb, "rgb.pnm")
+    call rgbpix_spit_as_pnm_16  (pixrgb, "current-rgb16.pnm")
+    call new_spit_rgb16         (pixrgb, "experiment-rgb16.pnm")
+
     deallocate(pixrgb)
 
   end subroutine
@@ -58,8 +61,8 @@ contains
       value = value + increment
     enddo
   enddo
-  call spit_as_pgm_16 (greymap, 'a.pnm')
+!  call spit_as_pgm_16 (greymap, 'a.pnm')
-  call spit_as_pgm_eq (greymap, 'b.pnm')
+!  call spit_as_pgm_eq (greymap, 'b.pnm')
   call spit_as_pgm_8  (greymap, 'c.pnm')
   call new_spit_a     (greymap, 'x.pnm')
   end subroutine

Modules/dummy.f90

@@ -0,0 +1,9 @@
+module dummy
+    implicit none
+contains
+
+subroutine print_dummy
+    print *, 'this is the dummy subroutine'
+end subroutine
+
+end module

Modules/farbfeld.f90

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

Modules/mathstuff2.f90

@@ -0,0 +1,52 @@
+module mathstuff2
+
+! XXX This module was a copy of mathstuff.f90 fromthe BloubWorld
+! XXX                will be moved in an other place some day...
+
+  implicit none
+  contains
+
+! ----------------------------------------------------------------
+!   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
+    call srand(t3)
+
+    ! after initializing the random generator engine,
+    ! you MUST use it for initializing the initializer
+    do foo=1, tarray(1)+15
+      dummy = rand()
+    enddo
+
+  end subroutine 
+
+! ----------------------------------------------------------------
+!-
+!-      May be I can make some generic procedures ?
+!-
+logical function diff_sign(a, b)
+   integer, intent(in)     :: a, b
+
+   ! write(0, *) "diff_sign", a, b
+   if ( (a .lt. 0) .and. (b .ge. 0) ) then 
+      diff_sign = .TRUE.
+      return
+   endif
+   if ( (a .ge. 0) .and. (b .lt. 0) ) then
+      diff_sign = .TRUE.
+      return
+   endif
+   diff_sign = .FALSE.
+
+end function
+! ----------------------------------------------------------------
+end module mathstuff2
+

Modules/noisepictures.f90

@@ -0,0 +1,109 @@
+module noisepictures
+    use  pixrgb
+    implicit none
+
+    contains               ! a lot of garbage ?
+
+!-----------------------------------------------------------------------
+subroutine noise_gray8_pic(pict, nbre)
+  implicit none
+  integer, dimension(:,:), intent(inout) :: pict
+  integer, intent(in)                    :: nbre
+  integer :: quux, ix, iy, width, height
+
+  width = ubound(pict, 1)  ;  height = ubound(pict, 2)
+
+  do quux=1, nbre
+    ix = 1 + mod ( irand(), width )
+    iy = 1 + mod ( irand(), height )
+    pict(ix, iy) = mod ( irand(), 256 )
+  enddo
+
+end subroutine
+!-----------------------------------------------------------------------
+subroutine noise_gray16_pic(pict, nbre)
+  implicit none
+  integer, dimension(:,:), intent(inout) :: pict
+  integer, intent(in)                    :: nbre
+  integer :: quux, ix, iy, width, height
+
+  width = ubound(pict, 1)  ;  height = ubound(pict, 2)
+
+  do quux=1, nbre
+    ix = 1 + mod ( irand(), width )
+    iy = 1 + mod ( irand(), height )
+    pict(ix, iy) = mod ( irand(), 65536 )
+  enddo
+
+end subroutine
+!-----------------------------------------------------------------------
+subroutine noise_rgb8_pic(prgb, nbre)
+  implicit none
+  type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
+  integer, intent(in)                           :: nbre
+  integer :: quux, ix, iy, width, height
+
+  print *, 'noise_rgb_pic', nbre
+
+  width = ubound(prgb, 1)  ;  height = ubound(prgb, 2)
+
+  do quux=1, nbre
+    ix = 1 + mod ( irand(), width )
+    iy = 1 + mod ( irand(), height )
+    prgb(ix, iy)%r = mod ( irand(), 256 )
+    prgb(ix, iy)%g = mod ( irand(), 256 )
+    prgb(ix, iy)%b = mod ( irand(), 256 )
+  enddo
+
+end subroutine
+!-----------------------------------------------------------------------
+subroutine noise_rgb16_pic(prgb, nbre)
+  implicit none
+  type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
+  integer, intent(in)                           :: nbre
+  integer :: quux, ix, iy, width, height
+
+  print *, 'noise_rgb_pic', nbre
+
+  width = ubound(prgb, 1)  ;  height = ubound(prgb, 2)
+
+  do quux=1, nbre
+    ix = 1 + mod ( irand(), width )
+    iy = 1 + mod ( irand(), height )
+    prgb(ix, iy)%r = mod ( irand(), 65536 )
+    prgb(ix, iy)%g = mod ( irand(), 65536 )
+    prgb(ix, iy)%b = mod ( irand(), 65536 )
+  enddo
+
+end subroutine
+!-----------------------------------------------------------------------
+! new: Sat Jun 10 06:50:51 UTC 2023
+
+subroutine noise_range_rgb16_pic(prgb, rngs, nbre)
+  implicit none
+
+  type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
+  integer, intent(in)                           :: rngs(6)
+  integer, intent(in)                           :: nbre
+  integer                                       :: foo, ix, iy
+
+  ! print *, 'noise rgb16 range', nbre
+  ! print *, 'rngs', rngs
+
+  do foo = 1, nbre
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
+    prgb(ix, iy)%r = rngs(1) + mod(irand(), rngs(2) - rngs(1))
+
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
+    prgb(ix, iy)%g = rngs(3) + mod(irand(), rngs(4) - rngs(3))
+
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
+    prgb(ix, iy)%b = rngs(5) + mod(irand(), rngs(6) - rngs(5))
+  enddo
+
+end subroutine
+!-----------------------------------------------------------------------
+end module noisepictures

Modules/pixrgb.f90

@@ -1,5 +1,6 @@
 !-
 !	This module try to write PNM complient RGB files
+!                ONLY ASCII MODE IS SUPPORTED !
 !-
 module pixrgb
     implicit none
@@ -15,6 +16,8 @@ end type
 contains
 !-------------------------------------------------------------------
 !-
+!	try FORALL here
+!-
 subroutine rgbpix_set_to_zero(pic)
   type(t_pixrgb), intent(out)       ::  pic(:,:)
   integer                           ::  ix, iy
@@ -26,6 +29,23 @@ subroutine rgbpix_set_to_zero(pic)
     enddo
   enddo
 end subroutine
+!-------------------------------------------------------------------
+!-
+!	set all the pixels to a RGB value
+!-
+subroutine rgbpix_set_to_rgb(pic, r, g, b)
+  type(t_pixrgb), intent(out)       ::  pic(:,:)
+  integer, intent(in)               :: r, g, b
+  integer                           ::  ix, iy
+  do iy=1, ubound(pic, 2)
+    do ix=1, ubound(pic, 1)
+      pic(ix, iy)%r = r
+      pic(ix, iy)%g = g
+      pic(ix, iy)%b = b
+    enddo
+  enddo
+end subroutine
+
 !-------------------------------------------------------------------
 !-
 !		NOT TESTED !!!
@@ -59,7 +79,8 @@ subroutine rgbpix_spit_as_pnm_8(pic, fname)
 
   do iy=1, ubound(pic, 2)
     do ix=1, ubound(pic, 1)
-      write(io, "(3I5)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
+      write(io, "(I0,' ', I0,' ',I0)")            &
+              pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
     enddo
   enddo
   close(unit=io)
@@ -69,7 +90,7 @@ end subroutine
 !-
 !          CAUTION: there was NO out-of-bounds check !
 !-
-subroutine rgbpix_spit_as_pnm_16(pic, fname)
+subroutine rgbpix_spit_as_pnm_16_old(pic, fname)
 
   type(t_pixrgb), intent(in)       ::  pic(:,:)
   character (len=*), intent(in)    ::  fname
@@ -84,11 +105,61 @@ subroutine rgbpix_spit_as_pnm_16(pic, fname)
 
   do iy=1, ubound(pic, 2)
     do ix=1, ubound(pic, 1)
-      write(io, "(3I6)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
+      write(io, "(I0,' ', I0,' ',I0)")         &
+         pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
     enddo
   enddo
   close(unit=io)
 
 end subroutine
 !-------------------------------------------------------------------
-end module
+!-
+!          CAUTION: there was NO out-of-bounds check !
+!-
+!     The width of the picture MUST be a multiple of 4 !
+!-
+subroutine rgbpix_spit_as_pnm_16(pic, fname)
+
+  type(t_pixrgb), intent(in)       ::  pic(:,:)
+  character (len=*), intent(in)    ::  fname
+
+  integer                          ::  io, ix, iy
+  integer                          ::  buffer(3*4), ptr
+
+  ! write(0, *) ">>> subroutine rgbpix_spit_as_pnm_16"
+
+  open(newunit=io, file=fname)
+  write (io, '(a2)') "P3"
+  write (io, '("# rgbpix_spit_as_pnm_16")')
+  write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
+  write (io, '(i0)') 65535
+
+  buffer = 0
+  ptr = 1
+
+  do iy=1, ubound(pic, 2)
+    do ix=1, ubound(pic, 1)
+
+      buffer(ptr)   = pic(ix, iy)%r
+      buffer(ptr+1) = pic(ix, iy)%g
+      buffer(ptr+2) = pic(ix, iy)%b
+      ptr = ptr + 3
+
+      if (ptr .EQ. 13) then
+        write(io, "(i0, 11(' ', i0))") buffer
+        ptr = 1
+      endif
+    enddo    ! write(io, *) " fin iy=", iy
+  enddo
+
+! XXX  may be we have to flush our internal buffer ?
+
+  close(unit=io)
+
+end subroutine
+
+!-------------------------------------------------------------------
+
+end module
+
+

Modules/t_centermag.f90

@@ -0,0 +1,27 @@
+program t
+  use      centermag
+  implicit none
+  type(t_centermag)      :: cmag
+
+  print *, '====== programme de test centermag ======'
+  call essai_centermag(cmag)
+  print *
+
+  STOP ': PAF LE CHIEN ?'
+
+!       --------------
+contains
+!       --------------
+subroutine essai_centermag(cm)
+    type(t_centermag), intent(inout)   :: cm
+    real                               :: rx, ry
+
+    call init_centermag(cm, 800, 600, 1.0)
+    call  print_centermag (cm)
+
+    rx = 0.45   ;    ry = -1.098
+
+end subroutine
+!       --------------
+
+end program

Modules/test-wavm.sh

@@ -0,0 +1,11 @@
+#!/bin/bash
+
+WAVE="datas/wave.wav"
+
+# sndfile-info ${WAVE}
+
+echo 
+
+wav2text ${WAVE} | ./twavm
+
+echo

Modules/trials.f90

@@ -3,17 +3,15 @@
 !-
 module trials
 
+  use   pixrgb
+
     implicit none
 
-!-----------------------------------------------------------------------
-!-------------------------------------------------------------------
-
     contains
-!-----------------------------------------------------------------------
-!-
-
 !-------------------------------------------------------------------
-subroutine new_spit_a(pic, fname)
+!  please write the same thing for RGB 16bits pictures !
+
+subroutine new_spit_gray(pic, fname)
 
   integer, intent(in), dimension (:,:)  ::  pic
   character (len=*), intent(in)         ::  fname
@@ -27,7 +25,7 @@ subroutine new_spit_a(pic, fname)
 
   open(newunit=io, file=fname)
   write (io, '(a2)') "P2"
-  write (io, '("# new_spit_a")')
+  write (io, '("# new_spit_gray")')
   write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
   write (io, '(i0)') 65535
 
@@ -51,5 +49,49 @@ subroutine new_spit_a(pic, fname)
 
 end subroutine
 !-------------------------------------------------------------------
+!-
+!          CAUTION: there was NO out-of-bounds check !
+!-
+subroutine new_spit_rgb16(pic, fname)
+
+  type(t_pixrgb), intent(in)       ::  pic(:,:)
+  character (len=*), intent(in)    ::  fname
+
+  integer                          ::  io, ix, iy, ik
+  integer                          ::  buffer(3*4), ptr
+
+  write(0, *) ">>> subroutine rgbpix_spit_as_pnm_16"
+
+  open(newunit=io, file=fname)
+  write (io, '(a2)') "P3"
+  ! write (io, '("# rgbpix_spit_as_pnm_16")')
+  write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
+  write (io, '(i0)') 65535
+
+  buffer = 0
+  ptr = 1
+
+  do iy=1, ubound(pic, 2)
+    do ix=1, ubound(pic, 1)
+
+      buffer(ptr)   = pic(ix, iy)%r
+      buffer(ptr+1) = pic(ix, iy)%g
+      buffer(ptr+2) = pic(ix, iy)%b
+      ptr = ptr + 3
+
+      if (ptr .EQ. 13) then
+        write(io, "(12(' ', i0))") buffer
+        ptr = 1
+      endif
+    enddo    ! write(io, *) " fin iy=", iy
+  enddo
+
+!   may be we have to flush the buffer ?
+
+  close(unit=io)
+
+end subroutine
+!-------------------------------------------------------------------
+
+end module
 
-end module

Modules/trnd.f90

@@ -0,0 +1,93 @@
+program essai
+
+  use mathstuff2
+  use pixrgb
+  use spitpgm
+  use noisepictures
+  implicit none
+
+  ! integer                     :: foo, bar
+
+  write(0, *)   "----------------- essai -------------------"
+
+  call init_random_seed()           ! in module 'mathstuff'
+  ! call test_noisepictures_rgb()
+  call test_noisepictures_rgb_range()
+  ! call test_noisepictures_gray()
+
+contains
+!-----------------------------------------------------------------------
+
+subroutine test_noisepictures_rgb ()
+  implicit none
+
+  type(t_pixrgb), allocatable       :: pix (:,:)
+  integer                           :: nombre
+  print *, '------ test des noisepictures RGB'
+
+  allocate(pix(800, 600))
+  nombre = (800*600)/4
+
+  call rgbpix_set_to_rgb(pix, 0, 0, 0)
+  call noise_rgb8_pic(pix, nombre)
+  call rgbpix_spit_as_pnm_8(pix, 'foo8.pnm')
+
+  call rgbpix_set_to_rgb(pix, 0, 0, 0)
+  call noise_rgb16_pic(pix, nombre)
+  call rgbpix_spit_as_pnm_16(pix, 'foo16.pnm')
+
+  deallocate (pix)
+
+end subroutine
+!-----------------------------------------------------------------------
+! new: Sat Jun 10 06:50:51 UTC 2023
+
+subroutine test_noisepictures_rgb_range ()
+  implicit none
+
+  type(t_pixrgb), allocatable       :: pix (:,:)
+  integer                           :: nombre
+  integer                           :: ranges(6)
+
+  print *, '------ test des noisepictures RGB range'
+
+  allocate(pix(800, 600))
+  nombre = (800*600)/4
+
+  call rgbpix_set_to_rgb(pix, 0, 0, 0)
+  ranges(1) = 0           ;    ranges(2) = 21000
+  ranges(3) = 22000       ;    ranges(4) = 43000
+  ranges(5) = 44400       ;    ranges(6) = 63000
+
+  call noise_range_rgb16_pic(pix, ranges, nombre)
+  call rgbpix_spit_as_pnm_16(pix, 'rngs16.pnm')
+
+  deallocate (pix)
+
+end subroutine
+!-----------------------------------------------------------------------
+subroutine test_noisepictures_gray ()
+  implicit none
+
+  integer, allocatable       :: pix (:,:)
+  integer                           :: nombre
+  print *, '------ test des noisepictures GRAY'
+
+  allocate(pix(800, 600))
+  nombre = (800*600)/4
+
+  pix = 0
+  call noise_gray8_pic(pix, nombre)
+  call spit_as_pgm_8(pix, 'bar8.pgm')
+
+  pix = 0
+  call noise_gray16_pic(pix, nombre)
+  call spit_as_pgm_16(pix, 'bar16.pgm')
+
+  deallocate (pix)
+
+end subroutine
+
+!-----------------------------------------------------------------------
+
+end program

Modules/twavm.f90

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

Modules/wavmetrics.f90

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

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

RandomStuff/Makefile

@@ -4,17 +4,13 @@
 
 GFOPT = -Wall -Wextra -g -time
 
-all:		essai displaykinds
+all:		displaykinds
 
 # -----------------------------------------------------
 
-mathstuff2.o:	mathstuff2.f90 Makefile
-	gfortran $(GFOPT) -c $<
 
 # -----------------------------------------------------
 
-essai:		essai.f90 Makefile mathstuff2.o
-	gfortran $(GFOPT) $< mathstuff2.o -o $@
 
 displaykinds:	displaykinds.f90 Makefile
 	gfortran $(GFOPT) $< -o $@

RandomStuff/essai.f90

@@ -1,21 +0,0 @@
-program essai
-
-  use mathstuff2
-  implicit none
-
-  integer                     :: foo, bar
-  real                        :: quux
-  double precision            :: somme
-
-  write(0, *)   "----------------- essai -------------------"
-
-  call init_random_seed()           ! in module 'mathstuff'
-  somme = 0.0
-  do foo=1, 500
-    quux = rand() + rand()
-    somme = somme + quux
-    bar = mod(irand(), 7)
-    print *, foo, quux, somme/foo, bar
-  enddo
-
-end program

RandomStuff/mathstuff2.f90

@@ -1,33 +0,0 @@
-module mathstuff2
-
-! XXX This module was a copy of mathstuff.f90 fromthe BloubWorld
-! XXX                wil be moved in an other place some day...
-
-  implicit none
-  contains
-
-  ! ----------------------------------------------------------------
-  !   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
-    call srand(t3)
-
-    ! after initializing the random generator engine,
-    ! you MUST use it for initializing the initializer
-    do foo=1, tarray(1)+5
-      dummy = rand()
-    enddo
-
-  end subroutine 
-
-  ! ----------------------------------------------------------------
-end module mathstuff2
-

SoundBrotching/c-tools/Makefile

@@ -2,7 +2,7 @@
 #     tth@konrad:~/Devel/Fortraneries/SoundBrotching/c-tools$
 #
 
-COPT = -Wall -Wextra -g -DDEBUG_LEVEL=1
+COPT = -std=c11 -Wall -Wextra -g -DDEBUG_LEVEL=1
 
 all:	text2wav wav2text text2ao
 

SoundBrotching/c-tools/README.md

@@ -4,11 +4,18 @@ Support utilities for SoundBrotching.
 
 ### wav2text
 
-Conversion d'un fichier son en text machinable.
+Conversion d'un fichier son en texte machinable, actuellement
+en *space separated*, directement utilisable par `Awk`.
+Un export `csv` est planifié. Ce programme ne prend
+pas (encore) d'options.
+
+Usage : `wav2txt 1337.wav > fichier.txt`
 
 ### text2wav
 
 Conversion d'un fichier texte en fichier son.
+En principe, réalise l'opération inverse de celle que
+fait *wav2text*.
 
 ### text2ao
 

SoundBrotching/c-tools/support.c

@@ -10,14 +10,20 @@
 #include  "support.h"
 
 /* --------------------------------------------------------------- */
-int display_sf_info(SF_INFO *psf, char *text)
+int display_sf_info(SF_INFO *psf, char *text, int bla)
 {
 
-fprintf(stderr, "    +-- sf info [%s]    %p\n", text, psf);
+if (bla) {
-fprintf(stderr, "    |   samplerate          %d\n", psf->samplerate);
+	fprintf(stderr, "    +-- sf info [%s]    %p\n", text, psf);
-fprintf(stderr, "    |   channels            %d\n", psf->channels);
+	fprintf(stderr, "    |   samplerate          %d\n", psf->samplerate);
-fprintf(stderr, "    |   frames              %ld\n", psf->frames);
+	fprintf(stderr, "    |   channels            %d\n", psf->channels);
-fprintf(stderr, "    |   format              0x%x\n", psf->format);
+	fprintf(stderr, "    |   frames              %ld\n", psf->frames);
+	fprintf(stderr, "    |   format              0x%x\n", psf->format);
+	}
+else	{
+	fprintf(stderr, "%-25s %6d  %2d %10ld    0x%x\n", text,	\
+		psf->samplerate, psf->channels, psf->frames, psf->format);
+	}
 
 return 0;
 }

SoundBrotching/c-tools/support.h

@@ -6,7 +6,7 @@
 
 /* --------------------------------------------------------- */
 
-int display_sf_info(SF_INFO *psf, char *text);
+int display_sf_info(SF_INFO *psf, char *text, int bla);
 
 void print_version(char *title);
 

SoundBrotching/c-tools/wav2text.c

@@ -41,7 +41,7 @@ if (sndf==NULL)
 	exit(1);
 	}
 
-foo = display_sf_info(&sfinfo, infname);
+foo = display_sf_info(&sfinfo, infname, 0);
 if (foo) {
 	fprintf(stderr, "%s: corrupted sf_info ?\n", __func__);
 	abort();
@@ -83,6 +83,7 @@ int main(int argc, char *argv[])
 {
 int			foo;
 int			format = 0;
+
 print_version(argv[0]);
 
 if (2 != argc)		usage();