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
-OBJS  = bloubspace.o povstuff.o mathstuff.o
+GFOPT = -Wall -Wextra -g -time  -I../Modules
+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
-
-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.
+la structure d'un bloub est (presque) 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
-les bloubs, gérer les rebonds avec la boudary-box, éliminer les
-bloubs usés par les chocs, et faire naitre de nouveaux bloubs
+Il ne fait que deux choses : à chaque tick, va déplacer
+les bloubs 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
-juste de passage dans un pipeline.
+### mergebloubs
+
+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.
-
-### mergebloubs
-
-Alors, celui-ci, il n'est pas vraiment au point. Il faut tout ré-écrire
-et faire gaffe à l'explosion quadratique.
+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,
+par exemple le barycentre des bloubs. Et c'est très facile
+à faire avec un [script Awk](toinc.awk).
 
 ## 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)
-    blb%py = 2.66 * (rand() - 0.50)
-    blb%pz = 3.57 * (rand() - 0.50)
+    ! write(0, *) "coef xyz = ", coefxyz
+    blb%px = coefxyz * (rand() - 0.50)
+    blb%py = coefxyz * (rand() - 0.50)
+    blb%pz = coefxyz * (rand() - 0.50)
 
-    blb%vx = (rand()) / 2.500
-    if (blb%px .LT. 0.0) blb%vx = -blb%vx
+    blb%vx = (rand() / 9.000)
+    ! if (blb%px .LT. 0.0) blb%vx = -blb%vx
 
-    blb%vy = (rand()) / 4.000
-    if (blb%py .LT. 0.0) blb%vy = -blb%vx
+    blb%vy = -0.10 + (rand() / 11.000)
+    ! if (blb%py .LT. 0.0) blb%vy = -blb%vy
 
-    blb%vz = (rand()) / 2.500
-    if (blb%pz .LT. 0.0) blb%vz = -blb%vz
+    blb%vz =  (rand() / 10.000)
+    ! 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")')     &
-                        towrite, trim(fname)
+    ! write (0, '(" spitting", (I6), " bloubs to ", (A), " file")')     &
+    !                     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%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
-conneries.
+Un bloub est une entité mathématique qui vit
+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
-dans l'espace, le rayon (pour nous, un bloub est
-une entité abstraite assimilable à une bubulle)
-ou la vitesse sur les trois axes.
-D'autres, comme `alive`, sont
-plus délicates à expliquer, sauf si l'on considère que les
-bloubs sont zombifiables.
+Certains champs sont assez explicites, comme le *nick*,
+la position dans l'espace, le rayon (pour nous, un bloub est
+une entité abstraite assimilable à une bubulle) ou la vitesse
+sur les trois directions de l'espace bloubeux.
+D'autres, comme `alive`, sont plus délicates à expliquer,
+sauf si l'on considère que les 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 mathstuff
+!  use bloubspace
+  use mathstuff2
   implicit none
 
-  type(t_boundingbox)    :: bbox
-
-  call load_boundingbox("WS/boundinboxes.dat", bbox, "cube    ")
-
-  print *, bbox
-
-
-  ! call test_random(20)
-
+  call test_random(10)
 
   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
-  real                        :: quux
+  integer                     :: foo
+  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)
-    print *, foo, quux, somme/foo, bar
+    bar = quux ** (.1/.3)
+    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)
-    bloub%radius  = 0.035 + (0.03*rand())
+    call make_a_random_bloub(bloub, 11.80)
+    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,10 +8,12 @@ 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
@@ -19,7 +21,7 @@ module mathstuff
 
     ! 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
-      bloub%radius = bloub%radius * 0.996
+    if (bloub%radius .GT. 3.50) then
+      bloub%radius = bloub%radius * 0.999
     endif
 
-    call green_soylent (bloub)
-    if (.NOT. bloub%alive) then
-      ! write(0, '(A)') "   KILL!"
-      killed = killed  + 1
-    endif
+    ! if (bloub%radius .LT. 0.00015) then
+    !   bloub%alive = .FALSE.
+    ! 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
+    write (0, '(1X,I0,A)') killed, " bloubs killed"
+  endif
 
-  ! ok, we have read all the bloubs in the input file
+  ! ok, we have read all the bloubs from the input file
 
   ! insert some fancy conditional here
-  if (compteur .LT.  200) then
-    call add_more_bloubs(outu, 4, 0.1056)
+  if (compteur .LT. 50) then
+    call add_more_bloubs(outu, 5, 0.046)
   endif
 
-  ! insert some very fancy conditional here
-  if (compteur .LT. 800) then
   rnd = rand()
-    write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd
-    if (rnd .LT. 0.0604) then
-      call add_more_bloubs(outu, 11, 0.099)
-    endif
+  ! 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)
-  write(0, '(A,I4,1X,A)') "adding", count, "bloubs"
+  count = nbre+mod(irand(), 2)
+  write(0, '(1X,A,I0,1X,A)') "movebloubs: adding ", count, " bloubs"
 
   do foo=1, count
 
     bloub%nick = 'newbie  '
-    call random_pv(bloub)
-    bloub%radius = rayon + (0.15*rand())
+    call make_a_random_bloub(bloub, 10.00)
+    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')
-	hi=$(printf "#%05d" $idx)
-	count=$(tail -1 "WS/log.nb_bloubs")
+	td=$(date -u +'%F %R' | tr '01' 'ol')
+	hi=$(printf "#%04d" $idx | tr '01' 'ol')
+	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
-	sleep 90
+	echo "### run done"
+	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 	}
 	plane	{ <1, 0, 0>,  37	}
 	plane	{ <0, 1, 0>, -27	}
 	plane	{ <0, 1, 0>,  27	}
 	plane	{ <0, 0, 1>,  69 	}
-
 	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 }
 		}
 	}
 }
 
-// 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 BR = 0.034;
+#declare BV = 6;		// V = taille en vertical
+#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 { Une_Borne translate < BH, 0, -BH> pigment { color Green } }
-	object { Une_Borne translate <-BH, 0,  BH> pigment { color Green } }
-	object { Une_Borne translate < BH, 0,  BH> pigment { color Red }   }
+	object { Montants }
+
+	#local G = Green * 0.80;
+	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 { <11,  14-NormClock,   9> color Gray60 }
+light_source { < 19,  12+NormClock, -17> color Gray80 }
+light_source { <-14,  10-NormClock, -29> color Gray70 }
 
-#declare XCAM = 8 - ( 15 * NormClock);
-#declare YCAM = -1.1 + (0.95 * NormClock);
-#declare ZCAM = -13.10;
+#declare XCAM = 5 - ( 10 * NormClock);
+#declare YCAM = -1.1 + (1.25 * NormClock);
+#declare ZCAM = -19.20;
 
-#declare XLAT = Bary_X;
-#declare YLAT = Bary_Y;
-#declare ZLAT = Bary_Z;
-
-// object { Repere scale 2.5 translate <XLAT, YLAT, ZLAT> }
+#declare XLAT = 0;
+#declare YLAT = 0;
+#declare ZLAT = 0;
 
 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"
-		else		color = "Red"
+		if (age > 150)	color = "Orange"
+		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, ";";

C_Binding/Makefile

@@ -0,0 +1,9 @@
+
+all:	single_function.o single_subroutine.o
+
+single_function.o:	single_function.c Makefile
+	gcc -Wall -g -c $< 
+
+single_subroutine.o:	single_subroutine.c Makefile
+	gcc -Wall -g -c $< 
+

C_Binding/README.md

@@ -0,0 +1,6 @@
+
+
+`Sat Feb 11 15:46:25 UTC 2023`
+
+Il serait temps de s'y mettre.
+

C_Binding/single_function.c

@@ -0,0 +1,10 @@
+#include  <stdio.h>
+
+
+long tth_getpid(int option)
+{
+
+fprintf(stderr, ">>> %s ( %d )\n", __func__, option);
+
+return 42L;
+}

C_Binding/single_subroutine.c

@@ -0,0 +1,9 @@
+#include  <stdio.h>
+
+void tth_dumpmem(int option, void *ptr)
+{
+
+fprintf(stderr, ">>> %s ( %d %p )\n", __func__, option, ptr);
+
+/* It's a subroutine so NO return */
+}

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

@@ -1,10 +1,12 @@
 
-julia
+mkjulia
 pickover
-lorentz
+mklorentz
+mkmandel
 voxelize
 evolvopick
 henon
+mkhenon
 essai
 plotcolmap
 
@@ -13,7 +15,10 @@ WS/*.dat
 WS/*.txt
 WS/*.inc
 
+toto
+
 *.pgm
+*.pnm
 *.gif
 *.asc
 *.png

Fraktalism/Makefile

@@ -1,5 +1,6 @@
 
-all:	voxelize evolvopick pickover julia lorentz essai
+all:	essai voxelize evolvopick pickover 	\
+	mkjulia mklorentz mkmandel
 
 GFOPT  = -Wall -Wextra -time -g -Imods/ -I../Modules
 
@@ -16,8 +17,16 @@ mods/xperiment.o:	mods/xperiment.f90 Makefile
 fraktals.o:	fraktals.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-OBJDEP  = mods/points3d.o mods/xperiment.o fraktals.o mods/fractcolmap.o
-OBJS    = $(OBJDEP) ../Modules/spitpgm.o
+mandelbrots.o:	mandelbrots.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+julias.o:	julias.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+OBJDEP  = mods/points3d.o mods/xperiment.o mods/fractcolmap.o	\
+	  fraktals.o mandelbrots.o julias.o
+
+OBJS    = $(OBJDEP) ../Modules/pixrgb.o ../Modules/spitpgm.o 
 
 # ---------------------------------------------
 
@@ -29,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 $@
 
-julia:		julia.f90 Makefile $(OBJDEP)
+mkhenon:	mkhenon.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
+# ---------------------------------------------
+
 pickover:	pickover.f90 Makefile $(OBJDEP) 
 	gfortran $(GFOPT) $<  $(OBJS)   -o $@
 
@@ -44,7 +63,7 @@ evolvopick:	evolvopick.f90 Makefile $(OBJDEP)
 voxelize:	voxelize.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-lorentz:	lorentz.f90 Makefile $(OBJDEP)
+mklorentz:	mklorentz.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
 mkmandel:	mkmandel.f90 Makefile $(OBJDEP)
@@ -52,8 +71,8 @@ mkmandel:	mkmandel.f90 Makefile $(OBJDEP)
 
 # ---------------------------------------------
 
-lorentz.pgm:	lorentz Makefile
-	./lorentz $@ > /dev/null
+lorentz.pgm:	mklorentz Makefile
+	./mklorentz $@ > /dev/null
 
 pickover.pgm:	pickover Makefile
 	./pickover $@ > /dev/null

Fraktalism/README.md

@@ -6,11 +6,25 @@ 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`,
-et la gestion des pixels 'physiques' est faite par le
-module externe `spitpgm`.
+et la gestion des pixels 'physiques' est faite par les
+modules externes `spitpgm` et `pixrgb`.
 
 Les fonctions d'usage général sont dans
 [mods/](répertoire mods/) ave trop peu
@@ -34,7 +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

@@ -12,13 +12,34 @@ SDIR="$1"
 FNAME="$2"
 echo "Encoding from " $SDIR " to " $FNAME
 
+#
+#  trying to guess the format of inoput files
+#
+firstfile=$(ls -1 $SDIR/* | head -1)
+echo "first file :" $firstfile
+filetype=$(file $firstfile | awk '{ print $2 }')
+echo "file type  :" $filetype
+
+#
+# this is BOGUS, replace file by identify ?
+#
+case  $filetype in
+        PNG)            extension=".png"                ;;
+        Netpbm)         extension=".pgm"                ;;
+        *)              extension=".binary"             ;;
+esac
+echo "extension  :" $extension
+
+
+
 TITLE='---{ experimental }---'
 
 ffmpeg  -nostdin					\
 	-loglevel warning				\
-	-y -r 25 -f image2 -i $SDIR/%05d.png 		\
+	-y -r 30 -f image2 -i $SDIR/%05d.png 		\
 	-metadata artist='---{ tTh }---'		\
 	-metadata title="${TITLE}"			\
+ 	-preset veryslow				\
 	-c:v libx264 -pix_fmt yuv420p			\
 	$FNAME
 

Fraktalism/fraktals.f90

@@ -1,7 +1,5 @@
 module fraktals
-
   use points3d
-
   implicit none
   contains
 
@@ -12,18 +10,13 @@ module fraktals
 !
 subroutine parasites_0(pic, cx, cy, maxiter)
     implicit none
-
-    ! here is the wtf
     integer, intent(inout), dimension (:,:)  ::  pic
-
     real, intent(in)                         ::  cx, cy
     integer, intent(in)                      ::  maxiter
 
     integer      ::  ix, iy, width, height
     real         ::  fx, fy, coef
     logical      ::  burps
-    ! write(0, *) "subroutine parasites_0" , maxiter
-    ! write(0, *) "constantes", cx, cy
  
     width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
     coef   = float(maxiter) / 12.3456789
@@ -33,87 +26,28 @@ subroutine parasites_0(pic, cx, cy, maxiter)
       burps = (RAND() .lt. 0.01)
       do iy = 1, height
         fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
-
         if (burps) then
           pic(ix, iy) = mod(int(fx * fy * coef * 1.005), 250)
         else
           pic(ix, iy) = mod(int(fx * fy * coef), 250)
         endif
-
       enddo
     enddo
 
 end subroutine parasites_0
-
 !===============================================================
-
-subroutine simple_julia(pic, cx, cy, maxiter)
-    implicit none
-    integer, intent(inout), dimension (:,:)  ::  pic
-    real, intent(in)                         ::  cx, cy
-    integer, intent(in)                      ::  maxiter
-
-    integer      ::  ix, iy, width, height
-    real         ::  fx, fy
-    complex      ::  Z, C
-    integer      ::  iter
-    logical      ::  over_iter
-
-    width  = ubound(pic, 1)
-    height = ubound(pic, 2)
-
-    C = complex(cx, cy)
-    print *, "Const = ", C
-
-    ! ready ? ok, clear the picture
-    pic = 0
-
-    do ix = 1, width
-      fx = (float(ix) / (float(width)/4.0) - 2.0)
-      do iy = 1, height
-        fy = (float(iy) / (float(height)/4.0) - 2.0)
-
-          ! ------ traitement du pixel
-          iter = 0  ; over_iter = .FALSE.
-          Z = complex(fx, fy)
-          do while (modulus2(Z) .LT. 4.0) 
-
-            Z = (Z * Z) + C
-            iter = iter + 1
-
-            if (iter .GE. maxiter) then
-              over_iter = .TRUE.
-              exit
-            endif
-
-          end do
-
-          if (over_iter) then
-            pic(ix, iy) = 0
-          else
-            pic(ix, iy) = iter*12
-          endif
-      enddo      ! iy
-    enddo        ! ix
-
-end subroutine simple_julia
-!===============================================================
- 
+!-
 !  d'après les pages 91/92 du livre de Roger T Stevens
 !                             "Fractal programming in C"
-! 
+!-
 subroutine compute_pickover(array, coefs)
     type(t_point3d), dimension(:)    :: array
     double precision, dimension(4)   :: coefs
 
     double precision      :: xa, ya, za, xb, yb, zb
     integer               :: i
-    ! print *, "coefs ", coefs
-
-    ! write(0, '(1X, A18, I9)') "compute pickover ", ubound(array, 1)
 
     xa = 1.0  ; ya = 1.0  ; za = 1.0
-
     do i=1, ubound(array, 1)
       xb = sin(coefs(1)*ya) - za*cos(coefs(2)*xa)
       yb = za*sin(coefs(3)*xa) - cos(coefs(4)*ya)
@@ -126,7 +60,6 @@ subroutine compute_pickover(array, coefs)
     enddo
 
 end subroutine
-
 !-----------------------------------------------------
 ! 
 !  d'après les pages 91/92 du livre de Roger T Stevens
@@ -190,7 +123,8 @@ end subroutine lorentz_0
 !===============================================================
 !           -- some support functions --
 !-----------------------------------------------------------
-!       usage : evolvopick & voxelize
+!       usage in : evolvopick & voxelize
+!-
 subroutine interp4dp (ina, inb, out, dpk)
     double precision, dimension(4), intent(in)   :: ina, inb
     double precision, dimension(4), intent(out)  :: out
@@ -203,6 +137,7 @@ subroutine interp4dp (ina, inb, out, dpk)
 
 end subroutine
 !-----------------------------------------------------------
+!-
 
 function dist0 (x, y)
   implicit none
@@ -212,6 +147,8 @@ function dist0 (x, y)
 end function
 
 !-----------------------------------------------------------
+!-
+
 function modulus2(pt)
   implicit none
   complex, intent(in)    ::   pt
@@ -219,5 +156,4 @@ function modulus2(pt)
   modulus2 = real(pt)*real(pt) + imag(pt)*imag(pt)
 end
 !-----------------------------------------------------
-
 end module fraktals

Fraktalism/henon.f90

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

Fraktalism/julias.f90

@@ -0,0 +1,114 @@
+module julias
+
+  use fraktals
+  implicit none
+  contains
+
+!===============================================================
+!-
+!      some problems with color mapping, need more work
+!-
+subroutine simple_julia(pic, cx, cy, maxiter)
+    implicit none
+    integer, intent(inout), dimension (:,:)  ::  pic
+    real, intent(in)                         ::  cx, cy
+    integer, intent(in)                      ::  maxiter
+
+    integer      ::  ix, iy, width, height
+    real         ::  fx, fy
+    complex      ::  Z, C
+    integer      ::  iter
+    logical      ::  over_iter
+
+    width  = ubound(pic, 1)
+    height = ubound(pic, 2)
+    C = complex(cx, cy)
+    print *, "Const = ", C
+    ! ready ? ok, clear the picture
+    pic = 0
+    do ix = 1, width
+      fx = (float(ix) / (float(width)/4.0) - 2.0)
+      do iy = 1, height
+        fy = (float(iy) / (float(height)/4.0) - 2.0)
+          ! ------ 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) 
+            Z = (Z * Z) + C
+            iter = iter + 1
+            if (iter .GE. maxiter) then
+              over_iter = .TRUE.
+              exit
+            endif
+          end do
+          if (over_iter) then
+            pic(ix, iy) = 0
+          else
+            pic(ix, iy) = mod(iter*13, 256)
+          endif
+      enddo      ! iy
+    enddo        ! ix
+
+end subroutine simple_julia
+!===============================================================
+!-
+!	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, mag
+    integer, intent(in)                             ::  maxiter
+
+    integer      ::  ix, iy, width, height, iter
+    real         ::  fx, fy, div, off
+    complex      ::  Z, C
+    logical      ::  over_iter
+    integer      ::  under, over
+
+    pic = t_pixrgb(0, 0, 0)
+
+    width  = ubound(pic, 1)
+    height = ubound(pic, 2)
+    C = complex(cx, cy)
+
+    div = mag * 10.0    ;     off = mag * 2.5
+    under = 0          ;     over = 0
+    print *, "mag:", mag, " -> ", div, off
+
+    ! print *, "Color julia, const = ", C
+    do ix = 1, width
+      fx = (float(ix) / (float(width*2)/div) - off)
+      do iy = 1, height
+        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) 
+            Z = (Z * Z) + C
+            iter = iter + 1
+            if (iter .GE. maxiter) then
+              over_iter = .TRUE.
+              exit
+            endif
+          end do
+          if (over_iter) then
+            pic(ix, iy)%r = mod(int(modulus2(Z)*2000.0), 255)
+            pic(ix, iy)%g = mod(abs(int(real(Z) *11.0)), 255)
+            pic(ix, iy)%b = mod(abs(int(aimag(Z)*11.0)), 255)
+            print *, ix, iy, Z, modulus2(Z)
+            over = over + 1
+          else
+            pic(ix, iy)%r = mod(iter*11, 255)
+            pic(ix, iy)%g = mod(iter*14, 255)
+            pic(ix, iy)%b = mod(iter*17, 255)
+            under = under + 1
+          endif
+      enddo      ! iy
+    enddo        ! ix
+
+    print *, "under", under, "over", over
+
+end subroutine 
+!===============================================================
+end module

Fraktalism/mandelbrots.f90

@@ -0,0 +1,83 @@
+!-----------------------------------------------------
+!		MANDELBROT SET
+!-
+!    refactored Thu 29 Dec 2022 03:21:16 PM CET
+!    refactored Sat 31 Dec 2022 12:37:03 PM CET
+!-
+!-----------------------------------------------------
+!-
+module mandelbrots
+    implicit none
+contains
+!-----------------------------------------------------------------------
+
+subroutine mandelbrot_one(pic, start)
+    ! use cmplxmath
+    ! use imagetools
+    use pixrgb
+
+    implicit none
+
+    type(t_pixrgb), intent(inout), dimension (:,:)  ::  pic
+    complex, intent(in)                             ::  start
+    ! type (CenterMag), intent(in)             :: cz
+
+    integer   :: ix, iy, width, height
+    real      :: fx, fy, mod2, rval
+    complex   :: za, zb, cste
+    integer   :: iter, maxiter
+    logical   :: escape
+
+    ! write(0,*) "> plotsomething"
+
+    width  = ubound(pic, 1)
+    height = ubound(pic, 2)
+    ! print *, "  pic size ", width, height
+    print *, real(start), aimag(start)
+
+    !   initialise constants
+    ! 
+    maxiter =  3456
+
+    !   enter megaloop
+    ! 
+    do iy = 1, height
+        fy = (float(iy) / float(height/3)) - 1.5
+        !! print *, "line  ", iy, fy
+        do ix = 1, width
+            fx = (float(ix) / float(width/3)) - 2.0
+            !-------------------------------------
+            !     working on the current pixel
+            za   = start
+            cste = complex ( fx, fy )
+            iter = 0
+            escape = .FALSE.
+            do while (iter .lt. maxiter)
+                zb = (za * za) + cste
+                mod2 =  real(zb)*real(zb) + aimag(zb)*aimag(zb)
+                !! print *, "mod2  ", mod2
+                if (mod2 .GT. 4.0) then
+                    escape = .TRUE.
+                    exit
+                endif
+                za = zb
+                iter = iter + 1
+                !! print *, "ZA ITER ESCAPE", za, iter, escape
+            enddo
+            if (escape) then
+                pic(ix, iy)%r = mod(iter*12, 255)
+                pic(ix, iy)%b = mod(iter*7,  255)
+            else
+                rval = (sqrt(mod2) + abs(real(start)*aimag(start))) * 9e2
+                pic(ix, iy)%g = mod(int(rval), 210) 
+                ! pic(ix, iy)%g = mod(iter, 255)
+                ! pic(ix, iy)%b = mod(iter*11, 255)
+            endif
+            !-------------------------------------
+        end do           ! fin boucle sur X
+    end do
+
+end subroutine
+!-----------------------------------------------------
+end module
+!-----------------------------------------------------

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

@@ -7,26 +7,33 @@
 program julia
 
     use spitpgm
-    use fraktals
+    use JULIAS
+    use PIXRGB
 
     implicit none
 
-    integer, dimension(512, 342)    ::    picz
+    type(t_pixrgb), allocatable     ::    picz(:,:)
     integer                         ::    argc
     character(200)                  ::    filename, string
     real                            ::    cx, cy
 
     argc = IARGC()
     if (3 .NE. argc) then
-      STOP ": JULIA PROGGY NEED PARAMETERS !"
+      STOP ": MKJULIA PROGGY NEED 3 PARAMETERS !"
     endif
 
     call getarg(1, filename)
     call getarg(2, string)       ;   read (string, *) cx
     call getarg(3, string)       ;   read (string, *) cy
 
-    call simple_julia(picz, cx, cy, 2500)
-    call spit_as_pgm_8(picz, trim(filename))
+    allocate(picz(1280, 1024))
+
+    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,31 +3,59 @@
 #
 #	build the prog
 #
-
-make julia
+make mkjulia
 if [ $? -ne 0 ] ; then
 	echo
 	echo "Make error " $?
 	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
 #
-for foo in $(seq 0 99)
+workdir="frames/julia/"
+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 "frames/julia/%05d.pgm" $foo)
-	bar=$(echo "$foo / 247.0"      | bc -l)
-	cx=$(echo "0.3 * c($foo/3)"     | bc -l)
-	cy=$(echo "0.3 * s($foo/2)"   | bc -l)
+	# make mkjulia
 
-	./julia $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
 
 echo ; echo "Encoding, please wait..."
 
-convert -delay 10 frames/julia/*.pgm foo.gif
-animate foo.gif &
-
+./encode.sh frames/julia/ foo.mp4

Fraktalism/mklorentz.f90

@@ -16,12 +16,12 @@ program lorentz
 
     argc = IARGC()
     if (1 .NE. argc) then
-      STOP ": LORENTZ NEED A FILENAME !"
+      STOP ": MKLORENTZ NEED A FILENAME !"
     endif
 
     call getarg(1, filename)
 
-    write (0, "(A)") "Lorentz -> "//trim(filename)
+    write (0, "(A)") "Mk Lorentz -> "//trim(filename)
 
     call lorentz_0(picz, 50000)
     call spit_as_pgm_8(picz, trim(filename))

Fraktalism/mkmandel.f90

@@ -1,130 +1,48 @@
 !-----------------------------------------------------
-!		IMAGE PROCESSING
-!-----------------------------------------------------
-!-----------------------------------------------------
-
-subroutine plotsomething(pic, start, cz)
-    ! use cmplxmath
-    ! use imagetools
-
-    implicit none
-
-    integer, intent(inout), dimension (:,:)  ::  pic
-    complex, intent(in)                      ::  start
-    type (CenterMag), intent(in)             :: cz
-
-    integer   :: ix, iy, width, height
-    real      :: fx, fy, mod2
-    complex   :: za, zb, cste
-    integer   :: iter, maxiter
-    logical   :: escape
-
-    print *, "> plotsomething"
-
-    width  = ubound(pic, 1)
-    height = ubound(pic, 2)
-    print *, "  pic size ", width, height
-    print *, "  start ", start
-    call print_centermag(cz)
-
-    !   initialise constants
-    ! 
-    maxiter =  999;
-
-    !   enter megaloop
-    ! 
-    do iy = 1, height
-        fy = (float(iy) / float(height/3)) - 1.5
-        !! print *, "line  ", iy, fy
-        do ix = 1, width
-            fx = (float(ix) / float(width/3)) - 2.0
-
-            !! print *, "pixel ", ix, iy, " at ", fx, fy
-            !-------------------------------------
-            !     working on the current pixel
-            za   = start
-            cste = complex ( fx, fy )
-            iter = 0
-            escape = .FALSE.
-            do while (iter .lt. maxiter)
-                zb = (za * za) + cste
-                ! if (modulus2(zb) .gt. 4.0) then
-                mod2 =  real(zb)*real(zb) + aimag(zb)*aimag(zb)
-                !! print *, "mod2  ", mod2
-                if (mod2 .GT. 4.0) then
-                    escape = .TRUE.
-                    exit
-                endif
-                za = zb
-                iter = iter + 1
-                !! print *, "ZA ITER ESCAPE", za, iter, escape
-            enddo
-
-            if (escape) then
-                pic(ix, iy) = mod(iter, 333)
-            else
-                ! esoteric computation here
-                ! pic(ix, iy) = mod(8*floor(mod2*11.11), 24)
-                pic(ix, iy) = mod(iter, 222)
-            endif
-            !-------------------------------------
-        end do           ! fin boucle sur X
-
-    end do
-
-end
-
+!		MANDELBROT SET
+!-
+!    refactored Thu 29 Dec 2022 03:21:16 PM CET
+!    refactored Sat 31 Dec 2022 12:37:03 PM CET
+!        all generative parts are now in 'mandelbrots.f90' module
+!-
 !-----------------------------------------------------
 ! 
 !    this is the main programm
 ! 
 program mkmandel
-
-    use imagetools
+    use pixrgb
+    use mandelbrots
 
     implicit none
 
-    interface
-      subroutine plotsomething (pic, start, cz)
-          use imagetools
-          integer,   intent(inout), dimension (:,:) ::  pic
-          complex,   intent(in)                     ::  start
-          type (CenterMag), intent(in)              :: cz
-      end subroutine plotsomething
-    end interface
-
-    integer, dimension(512, 512)    ::    picz
-    type (CenterMag)                ::    cm
+    type(t_pixrgb), allocatable     ::    pic(:,:)
     integer                         ::    angle
     real                            ::    radangle, radius
     real                            ::    stx, sty
     character (len=80)              ::    filename
 
-    cm%cx    = 0.0 ; cm%cy    = 0.0 ;  cm%mag   = 3.0
-    picz = 0                ! clear screen
+    write(0, *) "-------- making some mandelbrot -------"
 
-    print *, "-------- making some mandelbrot -------"
+    allocate(pic(640, 480))
 
-    do angle = 0, 1800
+    do angle = 0, 2000
 
-        radangle = float(angle) * 0.017453292522222
+        call rgbpix_set_to_zero(pic)
+
+        radangle = float(angle) * 0.01664
         radius   = float(angle) / 2000.0
-        write (filename, "(a, i5.5, a)") "img/", angle, ".pnm"
+        write (filename, "(a, i5.5, a)") "frames/mandel/", angle, ".pnm"
         ! filename = trim(filename)
-        print *, "#### passe ", angle, radangle, trim(filename)
+        write(0,*) "passe ", angle, radangle, trim(filename)
 
-        stx = radius * sin(radangle*4.0)
-        sty = radius * cos(radangle*3.0)
+        stx = radius * (sin(radangle*4.07) + 0.2131*sin(radangle*11.36))
+        sty = radius * (cos(radangle*6.21) + 0.2725*cos(radangle*10.99))
 
-        call plotsomething (picz, complex(stx, sty), cm)
-        call spitaspnm (picz, trim(filename))
-
-        print *
+        call mandelbrot_one(pic, complex(stx, sty))
+        call rgbpix_spit_as_pnm_8 (pic, trim(filename))
 
     enddo
 
-    print *, "[DONE]"
-
 end
 
 !-----------------------------------------------------

Fraktalism/mods/fractcolmap.f90

@@ -58,17 +58,20 @@ subroutine fcolm_plot_mapfile(fname)
   write(0, *) ' -> fractcolmap plot map to [', fname, ']'
 
   allocate(prgb(512, 128), stat=errcode)
-  ! Please, add a molly-guard
   if (0 .NE. errcode) then
     write(0, *) "errcode allocate in plot_map: ", errcode
     STOP 'ABEND'
   endif
 
-  print *, ' FILE ', fname
+  call rgbpix_set_to_zero(prgb)
+
+  ! print *, ' FILE ', fname
   do ix = 1, 255
-     call fcolm_get_rgb(ix-1, rgb)
+     call fcolm_get_rgb(ix, rgb)
+
      xx = ix * 2
      ! print *, ix, xx, "  =>  ", rgb
+
      do iy=1, 128
        prgb(  xx, iy)%r = rgb(1)
        prgb(1+xx, iy)%r = rgb(1)
@@ -79,7 +82,9 @@ subroutine fcolm_plot_mapfile(fname)
      enddo
   enddo
 
-  ! push all the colred dats to disk
+  ! write(0, *) 'first pixel', prgb(1, 1)
+
+  !- push all the colred dats to disk
   call rgbpix_spit_as_pnm_8(prgb, fname)
 
   deallocate(prgb)

Fraktalism/mods/headache.map

@@ -0,0 +1,256 @@
+  0   0   0	  headache.map contributed by Daniel Egnor
+240   0   0
+  0 252   0
+240   0   0
+  0 252   0
+240   0   0
+  0 248   4
+240   4   0
+  0 248   4
+240   4   0
+  0 244   8
+240   8   0
+  0 244   8
+240   8   0
+  0 240  12
+240  12   0
+  0 240  12
+240  12   0
+  0 236  16
+240  16   0
+  0 236  16
+240  16   0
+  0 232  20
+240  20   0
+  0 232  20
+240  20   0
+  0 228  24
+240  24   0
+  0 228  24
+240  24   0
+  0 224  28
+240  28   0
+  0 224  28
+240  28   0
+  0 220  32
+240  32   0
+  0 220  32
+240  32   0
+  0 216  36
+240  36   0
+  0 216  36
+240  36   0
+  0 212  40
+240  40   0
+  0 212  40
+240  40   0
+  0 208  44
+240  44   0
+  0 208  44
+240  44   0
+  0 204  48
+240  48   0
+  0 204  48
+240  48   0
+  0 200  52
+240  52   0
+  0 200  52
+240  52   0
+  0 196  56
+240  56   0
+  0 196  56
+240  56   0
+  0 192  60
+240  60   0
+  0 192  60
+240  60   0
+  0 188  64
+240  64   0
+  0 188  64
+240  64   0
+  0 184  68
+240  68   0
+  0 184  68
+240  68   0
+  0 180  72
+240  72   0
+  0 180  72
+240  72   0
+  0 176  76
+240  76   0
+  0 176  76
+240  76   0
+  0 172  80
+240  80   0
+  0 172  80
+240  80   0
+  0 168  84
+244  84   0
+  0 168  84
+244  84   0
+  0 164  88
+244  88   0
+  0 164  88
+244  88   0
+  0 160  92
+244  92   0
+  0 160  92
+244  92   0
+  0 156  96
+244  96   0
+  0 156  96
+244  96   0
+  0 152 100
+244 100   0
+  0 152 100
+244 100   0
+  0 148 104
+244 104   0
+  0 148 104
+244 104   0
+  0 144 108
+244 108   0
+  0 144 108
+244 108   0
+  0 140 112
+244 112   0
+  0 140 112
+244 112   0
+  0 136 116
+244 116   0
+  0 136 116
+244 116   0
+  0 132 120
+244 120   0
+  0 132 120
+244 120   0
+  0 128 124
+244 124   0
+  0 128 124
+244 124   0
+  0 124 128
+244 128   0
+  0 124 128
+244 128   0
+  0 120 132
+244 132   0
+  0 120 132
+244 132   0
+  0 116 136
+244 136   0
+  0 116 136
+244 136   0
+  0 112 140
+244 140   0
+  0 112 140
+244 140   0
+  0 108 144
+244 144   0
+  0 108 144
+244 144   0
+  0 104 148
+244 148   0
+  0 104 148
+244 148   0
+  0 100 152
+244 152   0
+  0 100 152
+244 152   0
+  0  96 156
+244 156   0
+  0  96 156
+244 156   0
+  0  92 160
+244 160   0
+  0  92 160
+244 160   0
+  0  88 164
+244 164   0
+  0  88 164
+244 164   0
+  0  84 168
+248 168   0
+  0  84 168
+248 168   0
+  0  80 172
+248 172   0
+  0  80 172
+248 172   0
+  0  76 176
+248 176   0
+  0  76 176
+248 176   0
+  0  72 180
+248 180   0
+  0  72 180
+248 180   0
+  0  68 184
+248 184   0
+  0  68 184
+248 184   0
+  0  64 188
+248 188   0
+  0  64 188
+248 188   0
+  0  60 192
+248 192   0
+  0  60 192
+248 192   0
+  0  56 196
+248 196   0
+  0  56 196
+248 196   0
+  0  52 200
+248 200   0
+  0  52 200
+248 200   0
+  0  48 204
+248 204   0
+  0  48 204
+248 204   0
+  0  44 208
+248 208   0
+  0  44 208
+248 208   0
+  0  40 212
+248 212   0
+  0  40 212
+248 212   0
+  0  36 216
+248 216   0
+  0  36 216
+248 216   0
+  0  32 220
+248 220   0
+  0  32 220
+248 220   0
+  0  28 224
+248 224   0
+  0  28 224
+248 224   0
+  0  24 228
+248 228   0
+  0  24 228
+248 228   0
+  0  20 232
+248 232   0
+  0  20 232
+248 232   0
+  0  16 236
+248 236   0
+  0  16 236
+248 236   0
+  0  12 240
+248 240   0
+  0  12 240
+248 240   0
+  0   8 244
+248 244   0
+  0   8 244
+248 244   0
+  0   4 248
+248 248   0
+  0   4 248
+252 252   0
+252 128   0
+  0 128 128

Fraktalism/mods/t.f90

@@ -14,6 +14,9 @@ program t
   call fcolm_load_mapfile('chroma.map')
   call fcolm_plot_mapfile('chroma.pnm')
  
+  call fcolm_load_mapfile('headache.map')
+  call fcolm_plot_mapfile('headache.pnm')
+ 
   STOP 'BECAUSE YOU WAS OUMPFED.'
 
 contains

Fraktalism/mods/xperiment.f90

@@ -8,8 +8,6 @@ module xperiment
 
 subroutine parasites_1(pic, cx, cy, maxiter)
     implicit none
-
-    ! here is the wtf
     integer, intent(inout), dimension (:,:)  ::  pic
 
     real, intent(in)                         ::  cx, cy
@@ -23,22 +21,18 @@ subroutine parasites_1(pic, cx, cy, maxiter)
  
     width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
     coef   = float(maxiter)
-
     do ix = 1, width
       fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
       burps = (RAND() .lt. 0.01)
       do iy = 1, height
         fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
-
         if (burps) then
           pic(ix, iy) = int(fx * fy * coef * 1.005)
         else
           pic(ix, iy) = int(fx * fy * coef)
         endif
-
       enddo
     enddo
-
 end subroutine parasites_1
 
 !---------------------------------------------------------------
@@ -52,13 +46,9 @@ subroutine loop_of_parasites_1(nbre, mode)
     integer                   :: idx
 
     if (mode .NE. 0)  STOP "BAD MODE"
-
     do idx = 0, nbre
-
       write(0, *) "popcorn loop ", idx
-
     enddo
-
 end subroutine loop_of_parasites_1
 
 !===============================================================

Fraktalism/tagpicz.sh

@@ -0,0 +1,27 @@
+#!/bin/bash
+
+#
+#	THIS IS JUST A QUICK'N'DIRTY HACK !
+#	       DO NOT USE IT IN REAL LIFE !
+#
+
+set -e
+
+SDIR="frames/spool/"
+if [ $# -eq 1 ] ; then
+	SDIR="$1"
+fi
+
+for img in $SDIR/*.pnm
+do
+
+	mogrify						\
+		-gravity South-East			\
+		-font Courier-Bold			\
+		-pointsize 12				\
+		-fill Black				\
+		-annotate +10+4 "Konrad+tTh 2024"	\
+		$img
+	echo "tagging " $img
+
+done

GrafAnim/.gitignore

@@ -1,8 +1,21 @@
 
 essai
 doubledice
+doublegauss
+trigofest
+noisepic
+geowaves
+soundscope
+readpicz
 
 *.scratch
+*.genplot
 *.tga
 F/*.tga
 *.gif
+*.pnm
+*.pgm
+*.data
+*.png
+log.txt
+

GrafAnim/Makefile

@@ -2,14 +2,48 @@
 # Fortraneries by tTh - Graf Anim
 #
 
-GFOPT = -Wall -Wextra -g -time 
+GFOPT = -Wall -Wextra -g -time  -I../Modules
+MYLIB = '../Modules/libtth90modules.a'
 
-essai:	essai.f90 usegenplot.o Makefile
-	gfortran $(GFOPT) $< usegenplot.o -o $@
+# ---- programmes
 
-doubledice:	doubledice.f90 usegenplot.o Makefile
-	gfortran $(GFOPT) $< usegenplot.o -o $@
+essai:	essai.f90 Makefile
+	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) $<  $(MYLIB)  utils_ga.o -o $@
+
+trigofest:	trigofest.f90 Makefile vue3axes.o utils_ga.o
+	gfortran $(GFOPT) $<  $(MYLIB) utils_ga.o -o $@
+
+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 $<
 
+utils_ga.o:	utils_ga.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+vue3axes.o:	vue3axes.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+

GrafAnim/README.md

@@ -1,6 +1,36 @@
 # GrafAnim
 
 Quelques essais approximatifs pour faire des graphiques inutiles,
-dans une démarche mettant en avant la techno-futilité, une notion
-bien définie par le collectif Interhack.
+dans une démarche mettant en avant la
+[techno-futilité](https://wiki.interhacker.space/index.php?title=Techno-futilit%C3%A9),
+une notion bien définie par le collectif **Interhack**.
+
+Actuellement, certains des logiciels que vous voyez ici utilisent un backend graphique brassé
+[à la maison](https://git.tetalab.org/tTh/libtthimage)
+et nommé `genplot2`. Hélas, celui-ci est
+un peu foireux sur les tracés de ligne...
+
+## geowaves
+
+Une idée en l'air, probablement...
+
+## trigofest
+
+Distorsions approximatives de la courbe de Lissajous.
+Expériences inspirées par [ce site](https://bleuje.com/tutorial1/)
+que c'est d'la balle !
+
+## doubledice
+
+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.
+
 

GrafAnim/doubledice.f90

@@ -1,9 +1,61 @@
 program doubledice
   use usegenplot
+  use utils_ga
+
   implicit none
 
-  call init_genplot("essai.genplot")
+  integer                   :: nbarg, numframe
+  character(len=256)        :: arg
+  integer                   :: idx, foo, bar, xpos
+  integer                   :: buckets(12)
 
-  call end_genplot("OK boomer")
+  nbarg = IARGC()
+  if (nbarg .GT. 0) then
+       call GETARG(1, arg)
+       ! write (0, '(A40, A5)') "argument = ",  arg
+       read (arg, *) numframe
+  endif
+
+  write(0, '(" ------------- DOUBLE DICE ----------")')
+  write(0, '(" --> frame number:", I5)') numframe
+  call init_genplot("dummy.genplot")
+  call gplt_rect(0, 0, 800, 600)
+  call gplt_setcol(3)
+  call gplt_rect(8, 8, 48, 38)
+  call gplt_setcol(2)
+
+  buckets = 0
+  do idx=1, numframe
+    call jouer_un_tour(buckets, idx)
+    foo = maxval(buckets)
+    ! write(0, *) "max value", foo
+  enddo
+
+  call gplt_line(5, 40, 795, 40)
+  do bar=1, 12
+    xpos = bar*50 + 25
+    ! write(0, *) bar, xpos, buckets(bar)
+    call gplt_rect(xpos, 41, xpos+50, 41+15*buckets(bar))
+  enddo
+
+  call end_genplot("OK boomer...")
+
+contains
+
+! ---------------------------------------------------------
+
+subroutine jouer_un_tour(table, compte)
+  integer,intent(inout)   :: table(12)
+  integer, intent(in)     :: compte
+
+  integer                 :: DA, DB, valeur
+
+  DA = fair_random_dice()
+  DB = fair_random_dice()
+  valeur = DA + DB
+  ! write(0, *) "pass ", compte, "  =  ", DA, DB, valeur
+  table(valeur) = table(valeur) + 1
+
+end subroutine
 
 end program

GrafAnim/doublegauss.f90

@@ -0,0 +1,33 @@
+program doublegauss
+  use pixrgb
+  use utils_ga
+  implicit none
+
+  type(t_pixrgb), allocatable     ::    pic(:,:)
+  character (len=280)             ::    filename
+  integer                         ::    pass, iter
+  integer                         ::    xrnd, yrnd
+
+  write(0, *) "----- making a doublegauss picture ----"
+
+  allocate(pic(320, 240))
+  call rgbpix_set_to_zero(pic)
+
+  do pass=0, 99
+    do iter=1, 15000
+      xrnd = fair_random_gauss(320)
+      yrnd = fair_random_gauss(240)
+      ! print *, xrnd, yrnd
+      pic(xrnd,yrnd)%r = pic(xrnd,yrnd)%r + 1
+      pic(xrnd,yrnd)%g = pic(xrnd,yrnd)%g + 2
+      pic(xrnd,yrnd)%b = pic(xrnd,yrnd)%b + 3
+    end do
+
+    write (filename, "(a, i5.5, a)") "F/DBG/", pass, ".pnm"
+    print *, trim(filename)
+    call rgbpix_spit_as_pnm_8 (pic, trim(filename))
+
+  end do
+
+end program
+

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")
-  call do_frame(7)
+  do seqnum = 0, param0
+    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
-  do foo=20, 620, 50
-    call gplt_line(foo, 20, bar, 460)
-    call gplt_line(bar, 20, foo, 460)
+    write (filename, "(a, i5.5, a)") "./F/np/", seqnum, ".pnm"
+    write(0, *)  seqnum, kx, ky, trim(filename)
+    call rgbpix_spit_as_pnm_16(pix, trim(filename))
   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)
-  integer, intent(in)           :: color
-  integer                       :: savecol
+  ix = 600 - int (300.0 * x)
+  iy = 600 - int (300.0 * y)
 
-  savecol = gplt_getcol()
-  call gplt_setcol(color)
-  call gplt_rect(0, 0, 640, 480)
-  call gplt_setcol(savecol)
+  ! print *, ix, iy
+
+  if ( (ix .gt. lbound(pic, 1)) .and. (ix .lt. ubound(pic, 1))    &
+               .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)
-	echo $fname
-	genplot2 -s 640x480 a.scratch $fname
+
+	./noisepic $foo
 
 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/runme.sh

@@ -0,0 +1,19 @@
+#!/bin/bash
+
+set -e
+
+SCRATCH="dummy.genplot"
+
+make doubledice
+
+rm -f F/????.tga
+
+for foo in $(seq 1 250)
+do
+	rm -f dummy.genplot
+	./doubledice $foo 
+	filename=$(printf "F/%04d.tga" $foo)
+	genplot2 -s 640x480 ${SCRATCH} $filename
+done
+
+convert -delay 10 F/????.tga foo.gif

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

@@ -0,0 +1,128 @@
+program trigofest
+
+!-
+!      ces divagations me viennent de superbes codes en Processing
+!      allez visiter https://bleuje.com/tutorial1/ c'est d'la balle
+!-
+
+  use      spitpgm            ! in ../Modules 
+  implicit none
+
+  integer, dimension(:,:), allocatable    ::  picz
+  integer                                 ::  W, H
+  integer                                 ::  errcode
+  integer                                 ::  loop
+  character(200)                          ::  filename
+  real                                    ::  blouber
+!-------------------------------------------------------------
+
+  W = 512     ;       H = 342
+  allocate(picz(W,H), stat=errcode)
+
+  blouber = 0.1
+  do loop=0, 359
+    call spirale(picz, blouber, loop*9)
+    blouber = blouber + 0.3333
+    write (filename, "(a, i5.5, a)") "F/spi/", loop, ".pgm"
+    call spit_as_pgm_8(picz, trim(filename))
+    print *, loop, blouber
+  enddo
+
+  deallocate(picz)
+
+  STOP ': WORLD FINISHED'
+
+contains        !------------------------------------------
+!-------------------------------------------------------------
+!       Lowlevel functions
+!       ------------------
+
+subroutine plot_a_dot(pic, ix, iy, val)
+  implicit none
+  integer, dimension(:,:), intent(out)   :: pic
+  integer, intent(in)                    :: ix, iy, val
+
+  integer             :: lx, ly, ux, uy
+
+  lx = lbound(pic, 1)     ;     ux = ubound(pic, 1)
+  ly = lbound(pic, 2)     ;     uy = ubound(pic, 2)
+
+  ! write(0, *) 'plot dot ' , ix, iy
+  ! write(0, *) '  X size ' , lx, ux
+  ! write(0, *) '  Y size ' , ly, uy
+
+  if ( ix .LT. lx ) then
+    ! write(0, *) 'UNDER, IX', ix, 'LX', lx
+    ! STOP ': UNDER ZERO'
+    return
+  endif
+  if ( ix .GT. ux )  then
+    ! write(0, *) 'OVER, IX',  ix, 'UX', ux
+    ! STOP ': OVER9000 '
+    return
+  endif
+
+  if ( iy .LT. ly ) then
+    ! write(0, *) 'UNDER, IY', iy, 'LY', ly
+    ! STOP ': UNDER ZERO'
+    return
+  endif
+  if ( iy .GT. uy )  then
+    ! write(0, *) 'OVER, IY',  iy, 'UY', uy
+    ! STOP ': OVER9000 '
+    return
+  endif
+
+  if ( (val .LT. 0) .OR. (val .GT. 255) ) then
+    write(0, *) 'VAL = ', val
+    STOP ': BAD PIXEL VALUE'
+  endif
+
+  pic(ix, iy) = val
+
+end subroutine
+
+!-------------------------------------------------------------
+!            La premiere spirale
+!            -------------------
+
+subroutine spirale(pic, inirad, param)
+  implicit none
+  integer, dimension(:,:), intent(out)   :: pic
+  real, intent(in)                       :: inirad
+  integer, intent(in)                    :: param
+
+  real                                   ::    angle, radius, rx, ry
+  real                                   ::    kx, ky
+  integer                                ::    foo, ix, iy
+
+  pic = 0        ! clear the picture
+
+  radius = inirad
+
+  do foo=0, 360*15
+    angle = real(foo) * 0.01745329252
+
+    ! rx = radius * sin(angle) * 1.21
+    kx = 1.55 * sin(angle+(0.04*radius))
+    rx = radius * kx
+
+    ! ry = radius * cos(angle)
+    ky = cos(angle) + (0.5*cos(angle*6.0))
+    ry = radius * ky
+    radius = radius + 0.0245
+    ix = int(rx) + W/2
+    iy = int(ry) + H/2
+
+    ! print *, foo, ix, iy
+    call plot_a_dot(picz, ix, iy, 255-mod(foo+param, 255));
+
+  enddo
+
+end subroutine
+
+!-------------------------------------------------------------
+!-------------------------------------------------------------
+
+end program
+

GrafAnim/usegenplot.f90

@@ -3,26 +3,40 @@ module usegenplot
   implicit none
 
     integer, private           :: color = 4
+    integer, private           :: iochannel = -1
     logical, private           :: initialised = .FALSE.
+
   contains
 
 ! -------------------------------------------------------------------
 
 subroutine init_genplot(filename)
-
   character(*), intent(in)    :: filename
+
+  integer                     :: errcode
+
   write(0, *)   '--> init genplot "', filename, '"'
+  open(newunit=iochannel, file=filename, iostat=errcode)
+  write(0, *)   'iochannel', iochannel, 'errcode', errcode
+
   initialised = .TRUE.
   color = 4
 
+  ! XXX STOP 'ABEND'
+
 end subroutine
 
 subroutine end_genplot(message)
-
   character(*), intent(in)    :: message
+
+  integer                     :: errcode
+
   write(0, *)   '--> end genplot "', message, '"'
   initialised = .FALSE.
 
+  close(unit=iochannel, iostat=errcode)
+  write(0, *)   'close errcode', errcode
+
 end subroutine
 
 ! -------------------------------------------------------------------
@@ -38,7 +52,7 @@ subroutine do_initialise_once(motif)
 end subroutine
 
 ! -------------------------------------------------------------------
-
+!-    getter, setter, wtf ?
 subroutine gplt_setcol(col)
   integer, intent(in)           :: col
   color = col
@@ -55,8 +69,7 @@ subroutine gplt_move(x, y)
   if (.NOT. initialised) then
     call do_initialise_once('in gplt_move')
   endif
-
-  print *, x, y, 0
+  write(iochannel, '(3I8)') x, y, 0
 end subroutine
 
 ! -------------------------------------------------------------------
@@ -66,7 +79,7 @@ subroutine gplt_draw(x, y)
   if (.NOT. initialised) then
     call do_initialise_once('in gplt_draw')
   endif
-  print *, x, y, color
+  write(iochannel, '(3I8)') x, y, color
 end subroutine
 
 ! -------------------------------------------------------------------
@@ -78,10 +91,23 @@ subroutine gplt_line(x1, y1, x2, y2)
 end subroutine
 
 ! -------------------------------------------------------------------
+!-
+!                           sx, sy
+!        +-------------------+
+!        |             x2,y2 |
+!        |                   |
+!        |                   |
+!        | x1,y1             |
+!        +-------------------+
+!       0,0
 
 subroutine gplt_rect(x1, y1, x2, y2)
    integer, intent(in)           :: x1, y1, x2, y2
 
+  if (.NOT. initialised) then
+    call do_initialise_once('in gplt_rect')
+  endif
+
    call gplt_move(x1, y1)
    call gplt_draw(x2, y1)
    call gplt_draw(x2, y2)

GrafAnim/utils_ga.f90

@@ -0,0 +1,188 @@
+! -------------------------------------------------------------------
+!-      fonctions diverses pour faire des images bizarres
+! -------------------------------------------------------------------
+
+module utils_ga
+
+  use pixrgb
+  implicit none
+
+  contains
+
+! -------------------------------------------------------------------
+function fair_random_dice()
+  integer            :: fair_random_dice
+
+  fair_random_dice = 1 + int(rand()*6.0)
+
+end function
+! -------------------------------------------------------------------
+!     usage  -->  see doublegauss.f90
+function fair_random_gauss(hilevel)
+  integer, intent(in) :: hilevel
+  integer             :: fair_random_gauss
+  integer             :: foo, bar
+
+  foo = int((rand()*hilevel)/2)
+  bar = int((rand()*hilevel)/2)
+  fair_random_gauss = 1 + foo + bar
+
+end function
+! -------------------------------------------------------------------
+!     usage  -->  see doublegauss.f90
+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

GrafAnim/vue3axes.f90

@@ -0,0 +1,12 @@
+module vue3axes
+  use pixrgb
+  implicit none
+!-------------------------------------------------------------
+
+
+!-------------------------------------------------------------
+!-
+!-	ouf, c'est fini
+!-
+end module
+

GravityField/.gitignore

@@ -1,6 +1,7 @@
 
 essai
 animation
+realdump2png
 
 WS/*.pgm
 WS/*.png
@@ -8,6 +9,7 @@ WS/*/*.pgm
 WS/*/*.png
 WS/*/*.gif
 WS/data/*
+WS/log.*
 
 *.pgm
 *.pnm

GravityField/Makefile

@@ -5,7 +5,7 @@
 GFOPT   = -Wall -Wextra -g -time -I../Modules
 MODOBJ  = ../Modules/spitpgm.o ../Modules/pixrgb.o
 
-all:	essai animation
+all:	essai animation realdump2png
 
 # ----------- modules
 
@@ -20,4 +20,7 @@ essai:	essai.f90  Makefile realfield.o
 animation:	animation.f90  Makefile realfield.o
 	gfortran $(GFOPT) $< realfield.o $(MODOBJ) -o $@
 
-#-
+realdump2png:	realdump2png.f90  Makefile realfield.o
+	gfortran $(GFOPT) $< realfield.o $(MODOBJ) -o $@
+
+#- remember bro: yolo forever :)

GravityField/WS/field/README.md

@@ -1,2 +0,0 @@
-
-# placeholder

GravityField/WS/nanim/README.md

@@ -1,2 +0,0 @@
-
-# placeholder

GravityField/WS/troid/README.md

@@ -1,2 +0,0 @@
-
-# placeholder

GravityField/animation.f90

@@ -13,18 +13,16 @@ program animation
   implicit none
 
   ! some configuration constants
-  integer, parameter      :: S_WIDTH  = 1024
-  integer, parameter      :: S_HEIGHT = 1024
-  integer, parameter      :: NB_BODY  = 51
+  integer, parameter      :: S_WIDTH  = 2048
+  integer, parameter      :: S_HEIGHT = 2048
+  integer, parameter      :: NB_BODY  = 250
 
   !!! WARNING : global variable !!!
   type(massbody)          :: planets(NB_BODY)
 
   call init_random()
   call create_some_planets(planets, 1664e3, S_WIDTH , S_HEIGHT)
-  call print_barycentre_bodies(planets)
-
-  ! STOP 'BEFORE CRASH'
+  call print_barycentre_bodies(planets, 'begin')
 
   call la_grande_boucle(0, 2000, planets)
 
@@ -33,7 +31,7 @@ program animation
 !-----------------------------------------------------------------------
 contains
 !-
-!         fabrication d'une de la sequence complete
+!         fabrication de la sequence complete
 !-
 subroutine la_grande_boucle(start, nbre, moons)
   integer, intent(in)            :: start, nbre
@@ -47,19 +45,21 @@ subroutine la_grande_boucle(start, nbre, moons)
     !                     else     use ?????ing
     call deplace_les_planetes(moons, .TRUE.)
   
+    ! computing the field (used as a HF in Povray
     write (filename, "(a, i5.5, a)") 'WS/nanim/', pass, '.pgm'
     write(0, '(3I5, "    *  ", a20)') start, nbre, pass, filename
     call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
 
-    write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
-    call save_bodies_to_txt_file (planets, filename)
+    ! save the current bodies positions (can be used in gnuplot)
+    ! write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
+    ! call save_bodies_to_txt_file (planets, filename)
 
     write (filename, "(a, i5.5, a)") 'WS/colmap/', pass, '.pnm'
     call make_color_map(planets, filename, S_WIDTH, S_HEIGHT)
 
   enddo
 
-call print_barycentre_bodies(moons)
+call print_barycentre_bodies(moons, 'end')
 
 end subroutine
 
@@ -107,14 +107,14 @@ subroutine make_color_map(moons, fname, width, height)
         endif
       end do    ! loop on all the moons, ipl index
 
-      cmap(ix, iy)%r = mod(near*13, 255)
-      cmap(ix, iy)%g = mod(near*14, 255)
-      cmap(ix, iy)%b = mod(near*15, 255)
+      cmap(ix, iy)%r = mod(near*3, 255)
+      cmap(ix, iy)%g = mod(near*4, 255)
+      cmap(ix, iy)%b = mod(near*5, 255)
 
     enddo
   enddo
 
-  call rgbpix_spit_as_pnm(cmap, fname)
+  call rgbpix_spit_as_pnm_8(cmap, fname)
 
   deallocate(cmap)
 
@@ -131,9 +131,9 @@ subroutine deplace_les_planetes(moons, clipit)
   logical, intent(in)              :: clipit
 
   integer                 :: foo
-  real                    :: depx, depy
+  real                    :: depx, depy, coef
 
-  integer, parameter      :: EE = 51
+  integer, parameter      :: EE = 100
   integer                 :: SW = S_WIDTH  - EE
   integer                 :: SH = S_HEIGHT - EE
 
@@ -162,7 +162,12 @@ subroutine deplace_les_planetes(moons, clipit)
       if (moons(foo)%posy .LT. EE)     moons(foo)%posy = SH
     endif
 
-    moons(foo)%heading = moons(foo)%heading + (0.78*(rand()-0.50))
+    if (rand() .LT. 0.15) then
+      coef = 1.63
+    else
+      coef = 0.78
+    endif
+    moons(foo)%heading = moons(foo)%heading + (coef*(rand()-0.42))
     if (moons(foo)%heading .GT. 6.283185307) moons(foo)%heading = 0.0
     if (moons(foo)%heading .LT. 0.000000001) moons(foo)%heading = 0.0
 

GravityField/encode.sh

@@ -23,7 +23,7 @@ echo "file type  :" $filetype
 case  $filetype in
 	PNG)		extension=".png"		;;
 	Netpbm)		extension=".pgm"		;;
-	*)		extension=".binary"		;;
+	*)		extension=".pnm"		;;
 esac
 echo "extension  :" $extension
 

GravityField/essai.f90

@@ -12,7 +12,7 @@ program essai
 
   call init_random()
 
-  call essai_near_planet(1024, 1024)
+  call essai_near_planet(2048, 2048)
 
   STOP 'BECAUSE YOLO'
 
@@ -74,7 +74,7 @@ subroutine essai_near_planet(nbplanets, szfield)
 
   enddo
 
-  call rgbpix_spit_as_pnm(cmap, "rgb.pnm")
+  call rgbpix_spit_as_pnm_8(cmap, "rgb.pnm")
 
 end subroutine
 !-----------------------------------------------------------------------

GravityField/raytrace.sh

@@ -2,7 +2,7 @@
 
 set -e
 
-POVOPT=" -q9 +a -W1024 -H768 +WT2 -d -v "
+POVOPT=" -q9 +a -W1280 -H1024 +WT2 -d -v "
 SOURCE="vision.pov"
 TMPF="/dev/shm/gravfield.png"
 
@@ -24,15 +24,17 @@ outfile=$(printf "WS/troid/%05d.png" $clock)
 echo  $timestamp $texte $outfile
 
 convert	${TMPF}				\
-	-pointsize 22			\
+	-pointsize 24			\
 	-font Courier-Bold		\
-	-fill Orange			\
-	-annotate +15+22  "$timestamp"	\
-	-annotate +15+48  "$texte"	\
+	-fill Yellow			\
+	-annotate +20+32  "$timestamp"	\
+	-annotate +20+58  "$texte"	\
 	-pointsize 16			\
 	-gravity south-west		\
 	-annotate +15+9 "tTh & Konrad"	\
 	${outfile}
+
+sleep 6
 }
 
 #		---------------------------------------
@@ -51,5 +53,6 @@ ffmpeg  -nostdin					\
 	-metadata artist='---{ tTh and Konrad }---'	\
 	-metadata title="Experiment on Gravity Field"	\
 	-c:v libx264 -pix_fmt yuv420p			\
-	bar.mp4
+ 	-preset veryslow				\
+	gravity-field.mp4
 

GravityField/realdump2png.f90

@@ -0,0 +1,23 @@
+!-----------------------------------------------------------------------
+!-
+!       convertir un dum de champ de reel en .PNG
+!	nouveau 17 decembre 2022
+!-
+!-----------------------------------------------------------------------
+program realdump2png
+  use  realfield
+  implicit none
+
+  stop "BECAUSE I'M TIRED *NOW*"
+
+contains
+!-----------------------------------------------------------------------
+
+subroutine load_a_dump_file(fname, location)
+  character(len=*), intent(in)         :: fname
+  real, dimension(:,:), intent(inout)  :: location
+
+end subroutine
+!-----------------------------------------------------------------------
+end program
+!-----------------------------------------------------------------------

GravityField/realfield.f90

@@ -29,7 +29,7 @@ subroutine compute_barycentre_bodies(astres, bcx, bcy)
   integer                        :: foo
   real                           :: cx, cy
 
-  !   May be we have to use DOUBLE RPECSION here ?
+  !   May be we have to use DOUBLE PRECSION here ?
   cx = 0.0
   cy = 0.0
   do foo=1, ubound(astres, 1)
@@ -40,12 +40,13 @@ subroutine compute_barycentre_bodies(astres, bcx, bcy)
   bcy = cy / real(ubound(astres, 1))
 end subroutine
 !-----------------------------------------------------------------------
-subroutine print_barycentre_bodies(astres)
+subroutine print_barycentre_bodies(astres, title)
   type(massbody), intent(in)     :: astres(:)
-  real                           :: cx, cy
+  character(len=*), intent(in)   :: title
 
+  real                           :: cx, cy
   call compute_barycentre_bodies(astres, cx, cy)
-  print *, "barycentre :   ", cx, cy
+  print *, "barycentre {", title, "}  ", cx, cy
 
 end subroutine
 !-----------------------------------------------------------------------
@@ -81,8 +82,8 @@ subroutine create_some_planets(planets, coef, sx, sy)
       !-
       planets(foo)%posx     = rand() * real(sx-1)
       planets(foo)%posy     = rand() * real(sy-1)
-      planets(foo)%mass     = 7e6 + coef*foo
-      planets(foo)%heading  = 2 * 3.14159 * rand()
+      planets(foo)%mass     = 7.12e6 + coef*foo*3
+      planets(foo)%heading  = 2 * 3.141592654 * rand()
       if (rand() .LT. 0.15) planets(foo)%speed = 3.14159
       planets(foo)%serial   = foo*2 + 120
     endif

GravityField/runme.sh

@@ -4,9 +4,13 @@ set -e				# stop on error
 
 make animation
 
-date > animation.log
+LOG="WS/log.animation"
 
-time ./animation | tee animation.log
+date >> $LOG
 
-./encode.sh WS/nanim/ quux.mp4
-./encode.sh WS/colmap/ zzz.mp4
+time ./animation | tee -a $LOG
+
+./encode.sh WS/nanim/    gravity-field.mp4
+./encode.sh WS/colmap/   gravity-colmap.mp4
+
+ls -rtl *.mp4 >> $LOG

GravityField/vision.pov

@@ -45,29 +45,34 @@ texture {
 	}
 }
 
-object { GravityField scale <4, 0.60, 4> }
+object { GravityField scale <4.10, 0.60, 4.10> }
 
 // ----------------------------------------------------------------------
 
-/* XXX
+#if (0)
 merge {
 	cylinder { <0, -0.5, 0>, <0, 1, 0>, 0.0175  }
 	sphere   { <0, 1, 0>, 0.0175  }
 	pigment { color Red }
 	}
-XXX */
+#end
 
-light_source { < -2, 9.3, -7>	color Gray90			}
-light_source { < -6, 9.3, -8>	color Orange*0.75		}
-light_source { < -15, 2.3, 17>	color Green*0.25			}
+light_source { < -2, 9.3, -7>	color Gray80			}
+light_source { < -6, 9.3, -8>	color Orange*0.65		}
+light_source { < -15, 2.3, 17>	color Gray70			}
 
 // ----------------------------------------------------------------------
 
+#declare   Xcam = -5.05;
+#declare   Ycam =  2.5 - (1.7*NormClock);
+#declare   Zcam = -8 + (11.66*NormClock);
+
 camera	{
-	location	<-8, 4-(1.5*NormClock), 1 + (5*NormClock)>
+	// omnimax
+	location	<Xcam, Ycam, Zcam>
 	look_at		<0, 0, 0>
 	right		x*image_width/image_height
-	angle		33
+	angle		34
 	}
 
 // ----------------------------------------------------------------------

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)
-	gfortran $(GFOPT) $<  $(OBJS) -o $@
+chkpixels:	chkpixels.f90 Makefile libtth90modules.a
+	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,10 +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.
 
-## trials
+### pixrgb
+
+Write 8 bits or 16 bits RGB pictures to PNM format.
+The width of the picture MUST be a multiple of 4 !
+
+### 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,35 +11,35 @@ program chkpixels
   implicit none
 
   write(0, *)  "------ CHKPIXELS ------"
-  ! call test_spit_as(3)
-  call test_spit_rgb(256)
+  ! call test_spit_gray(3)
+  call test_spit_rgb16(1100, 512)
 
   STOP 'BECAUSE NO CPU AVAILABLE'
 
 contains
 !-------------------------------------------------------------------
 !-
-  subroutine test_spit_rgb(sz)
-    integer, intent(in)    :: sz
+!     exerciser for the 'pixrgb' module
+!-
+  subroutine test_spit_rgb16(sz, kg)
+    integer, intent(in)    :: sz, kg
 
     type(t_pixrgb), allocatable  :: pixrgb(:,:)
     integer                      :: ix, iy
 
     print *, "test spit rgb", sz
     allocate(pixrgb(sz, sz))
-    ! pixrgb = 0
+    call rgbpix_set_to_zero(pixrgb)
 
     do ix=1, sz
       do iy=1, sz
-
-        pixrgb(ix, iy)%r = ix
-        pixrgb(ix, iy)%g = 0
-        pixrgb(ix, iy)%b = iy
-
+        pixrgb(ix, iy)%r = mod(ix * iy, 65000)
+        if (ix.EQ.iy) pixrgb(ix, iy)%g = 65000
+        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)
 
@@ -53,6 +53,7 @@ contains
   integer, dimension(SZ, SZ)  :: greymap
   integer                     :: ix, iy, value
 
+  print *, "test spit as", sz
   value = 0
   do iy=1, SZ
     do ix=1, SZ
@@ -60,12 +61,10 @@ contains
       value = value + increment
     enddo
   enddo
-
-  call spit_as_pgm_16 (greymap, 'a.pgm')
-  call spit_as_pgm_eq (greymap, 'b.pgm')
-  call spit_as_pgm_8  (greymap, 'c.pgm')
-  call new_spit_a     (greymap, 'x.pgm')
-
+!  call spit_as_pgm_16 (greymap, 'a.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
 
 end program

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 PGM complient gray level files
+!	This module try to write PNM complient RGB files
+!                ONLY ASCII MODE IS SUPPORTED !
 !-
 module pixrgb
     implicit none
@@ -15,8 +16,56 @@ end type
 contains
 !-------------------------------------------------------------------
 !-
-subroutine rgbpix_spit_as_pnm_8(pic, fname)
+!	try FORALL here
+!-
+subroutine rgbpix_set_to_zero(pic)
+  type(t_pixrgb), intent(out)       ::  pic(:,:)
+  integer                           ::  ix, iy
+  do iy=1, ubound(pic, 2)
+    do ix=1, ubound(pic, 1)
+      pic(ix, iy)%r = 0
+      pic(ix, iy)%g = 0
+      pic(ix, iy)%b = 0
+    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 !!!
+!-
+subroutine rgb_pix_clamp_at_8(pic)
+  type(t_pixrgb), intent(inout)     ::  pic(:,:)
+  integer                           ::  ix, iy
+  do iy=1, ubound(pic, 2)
+    do ix=1, ubound(pic, 1)
+      pic(ix, iy)%r = max(0, min(pic(ix, iy)%r, 255))
+      pic(ix, iy)%g = max(0, min(pic(ix, iy)%g, 255))
+      pic(ix, iy)%b = max(0, min(pic(ix, iy)%b, 255))
+    enddo
+  enddo
+end subroutine
+!-------------------------------------------------------------------
+!-
+!          CAUTION: there was NO out-of-bounds check !
+!-
+subroutine rgbpix_spit_as_pnm_8(pic, fname)
   type(t_pixrgb), intent(in)       ::  pic(:,:)
   character (len=*), intent(in)    ::  fname
 
@@ -30,9 +79,8 @@ subroutine rgbpix_spit_as_pnm_8(pic, fname)
 
   do iy=1, ubound(pic, 2)
     do ix=1, ubound(pic, 1)
-
-    write(io, "(3I4)") 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)
@@ -40,7 +88,9 @@ subroutine rgbpix_spit_as_pnm_8(pic, fname)
 end subroutine
 !-------------------------------------------------------------------
 !-
-subroutine rgbpix_spit_as_pnm_16(pic, fname)
+!          CAUTION: there was NO out-of-bounds check !
+!-
+subroutine rgbpix_spit_as_pnm_16_old(pic, fname)
 
   type(t_pixrgb), intent(in)       ::  pic(:,:)
   character (len=*), intent(in)    ::  fname
@@ -55,13 +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
 !-------------------------------------------------------------------
+!-
+!          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/spitpgm.f90

@@ -60,7 +60,8 @@ subroutine spit_as_pgm_16(pic, fname)
 
     open(newunit=io, file=fname)
     write (io, '(a2)') "P2"
-    write (io, '("# size:", I9)') size(pic)
+    write (io, '(A)')  "# spit_as_pgm_16"
+    ! write (io, '("# size:", I9)') size(pic)
     write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
     write (io, '(i0)') 65535
 

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
 
@@ -49,7 +47,51 @@ subroutine new_spit_a(pic, fname)
 
   close(io)
 
+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
+

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,17 +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 !
 
-## hotline
+## Utilisation
+
+- 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
 
 - 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/.gitignore

@@ -9,9 +9,9 @@
 text2wav
 wav2text
 text2ao
-essai
 
 panoramix
 genwaves
 soundbrotch
+essai
 

SoundBrotching/README.md

@@ -1,6 +1,6 @@
 # SoundBrotching
 
-Stay tuned, film at 11.
+Stay tuned, film at 440.
 
 ## Cheat Code
 
@@ -10,9 +10,9 @@ de ce sous-projet fortranique sont
 ecrits en C, pour un accès facile à des bibliothèques tierces
 comme `libsndfile` ou `libao`, composants essentiels du SoundBrotching.
 
-## Serious game
+## Not so serious game
 
-Quelques exemples simple, mais bruyants...
+Quelques exemples simple, mais bruyants... `runme.sh`
 
 ### genwaves
 
@@ -20,5 +20,5 @@ Génération de sons qui arrachent les oreilles.
 
 ### panoramix
 
-Conversion de l'entrée en mono, et dépacement en sinus d'un
-coté à l'autre.
+Conversion de l'entrée en mono, et déplacement en sinusoïdale d'un
+coté de l'univers à l'autre.

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