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
+      blb%px = SH - blb%radius
+      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

@@ -1,4 +1,4 @@
-program genbloubs
+program exportbloubs
 
   use bloubspace
   implicit none
@@ -11,7 +11,7 @@ program genbloubs
   !       parsing command line
   i = IARGC()
   if (1 .ne. i) then
-    STOP ' :BAD COMMAND LINE'
+    STOP ' : BAD COMMAND LINE'
   endif
   call getarg(1, filename)
   
@@ -34,12 +34,13 @@ program genbloubs
     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,18 +8,20 @@ module mathstuff
   !                  not really tested yet...
 
   subroutine init_random_seed()
+    implicit none
 
     integer, dimension(3) :: tarray
     integer               :: t3, foo
     real                  :: dummy
+
     call itime(tarray)
     t3 = 3600*tarray(1) + 60*tarray(2) + tarray(3)
-    ! write(0, '(A,3I3,A,I6)') "sranding: ", tarray, " --> ", t3
+    ! write(0, '(A,3I3,A,I6)') " sranding: ", tarray, " --> ", t3
     call srand(t3)
 
     ! after initializing the random generator engine,
     ! you MUST use it for initializing the initializer
-    do foo=1, tarray(1)+5
+    do foo=1, tarray(1)+15
       dummy = rand()
     enddo
 

BloubWorld/mergebloubs.f90

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

BloubWorld/movebloubs.f90

@@ -2,7 +2,7 @@ program movebloubs
 
   use bloubspace
   use povstuff
-  use mathstuff
+  use mathstuff2
 
   implicit none
 
@@ -14,8 +14,6 @@ program movebloubs
   ! logical                  :: add_new_bloub = .TRUE.
   real                     :: rnd
 
-  call init_random_seed()
-
   i = IARGC()
   if (i .ne. 2) then
     STOP ": BAD ARGS ON COMMAND LINE"
@@ -26,6 +24,8 @@ program movebloubs
   write (0, '(A)') &
   "### moving bloubs from "//trim(infile)//" to "//trim(outfile)
 
+  call init_random_seed()
+
   open(newunit=inu,                                          &
                   file=trim(infile), form='unformatted',     &
                   iostat=errcode,                            &
@@ -48,6 +48,9 @@ program movebloubs
   compteur = 0
   killed   = 0
 
+!-
+!		begin of bigloop
+!-
   do
     read (unit=inu, iostat=errcode) bloub
     if (0 .ne. errcode) then
@@ -58,15 +61,19 @@ program movebloubs
     ! moving, morphing and boundingboxing
     call move_bloub     (bloub, 0.185)
     call bound_a_bloub  (bloub)
-    if (bloub%radius .GT. 0.0238) then
-      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 {
-	union {
+#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 }
 		}
 	}
+}
+
+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>
   }
 
-// object { cylinder { <0, 0, 0>, <10, 0, 0>, 0.05 pigment { color Cyan } } }
+//  ----------------------------------------------------------
+
+#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,18 +1,24 @@
 
-julia
+mkjulia
 pickover
-lorentz
+mklorentz
+mkmandel
 voxelize
 evolvopick
 henon
+mkhenon
 essai
+plotcolmap
 
 frames/*
 WS/*.dat
 WS/*.txt
 WS/*.inc
 
+toto
+
 *.pgm
+*.pnm
 *.gif
 *.asc
 *.png

Fraktalism/Makefile

@@ -1,7 +1,8 @@
 
-all:	voxelize evolvopick pickover julia lorentz essai
+all:	essai voxelize evolvopick pickover 	\
+	mkjulia mklorentz mkmandel
 
-GFOPT  = -Wall -Wextra -time -g -O -Imods/ -I../Modules
+GFOPT  = -Wall -Wextra -time -g -Imods/ -I../Modules
 
 # ---------------------------------------------
 # the module 'spitpgm' is now in $PROJECT/Modules
@@ -16,35 +17,62 @@ mods/xperiment.o:	mods/xperiment.f90 Makefile
 fraktals.o:	fraktals.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-OBJS  = mods/points3d.o mods/xperiment.o fraktals.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 
 
 # ---------------------------------------------
 
-essai:		essai.f90 Makefile $(OBJS)
+essai:		essai.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-henon:		henon.f90 Makefile $(OBJS)
+plotcolmap:	plotcolmap.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-julia:		julia.f90 Makefile $(OBJS)
+# ---------------------------------------------
+
+mkjulia:	mkjulia.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-pickover:	pickover.f90 Makefile $(OBJS) 
+xjulia.pnm:	mkjulia Makefile
+	./mkjulia $@ -0.204365 0.321463
+
+# ---------------------------------------------
+
+henon:		henon.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-evolvopick:	evolvopick.f90 Makefile $(OBJS)
+mkhenon:	mkhenon.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+# ---------------------------------------------
+
+pickover:	pickover.f90 Makefile $(OBJDEP) 
+	gfortran $(GFOPT) $<  $(OBJS)   -o $@
+
+evolvopick:	evolvopick.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS) $(DOT_O)   -o $@
 
-voxelize:	voxelize.f90 Makefile $(OBJS)
+voxelize:	voxelize.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-lorentz:	lorentz.f90 Makefile $(OBJS)
+mklorentz:	mklorentz.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+mkmandel:	mkmandel.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
 # ---------------------------------------------
 
-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,10 +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 fait dans `mods/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
@@ -19,6 +34,8 @@ Des scripts _shell_ sont utilisés pour construire les vidéos.
 
 ## File Formats
 
+Certains programmes enregistrent des tables de points 3d dans
+des fichiers.
 
 ```
   type t_point3d
@@ -31,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/essai.f90

@@ -23,10 +23,10 @@ program essai
   allocate(picz(W,H), stat=errcode)
 
   do foo=1, 360
-    write (filename, "(a, i5.5, a)") "frames/popcorn/", foo, ".pnm"
+    write (filename, "(a, i5.5, a)") "frames/popcorn/", foo-1, ".pnm"
     write(0, *) "-------->", trim(filename), "<"
-    kx   = 50.0 * sin(real(foo)*25.133)
-    ky   = 50.0 * cos(real(foo)*25.133)
+    kx   = 50.0 * sin(real(foo)*21.133)
+    ky   = 50.0 * cos(real(foo)*26.133)
     write(0, *) foo, kx, ky
     call parasites_0(picz, kx, ky, 233)
     call spit_as_pgm_8(picz, trim(filename))

Fraktalism/fraktals.f90

@@ -1,7 +1,5 @@
 module fraktals
-
   use points3d
-
   implicit none
   contains
 
@@ -12,109 +10,44 @@ 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)
+    coef   = float(maxiter) / 12.3456789
 
     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)
+          pic(ix, iy) = mod(int(fx * fy * coef * 1.005), 250)
         else
-          pic(ix, iy) = int(fx * fy * coef)
+          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)
@@ -127,7 +60,6 @@ subroutine compute_pickover(array, coefs)
     enddo
 
 end subroutine
-
 !-----------------------------------------------------
 ! 
 !  d'après les pages 91/92 du livre de Roger T Stevens
@@ -191,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
@@ -204,6 +137,7 @@ subroutine interp4dp (ina, inb, out, dpk)
 
 end subroutine
 !-----------------------------------------------------------
+!-
 
 function dist0 (x, y)
   implicit none
@@ -213,6 +147,8 @@ function dist0 (x, y)
 end function
 
 !-----------------------------------------------------------
+!-
+
 function modulus2(pt)
   implicit none
   complex, intent(in)    ::   pt
@@ -220,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
 
 !-----------------------------------------------------
-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(768, 768)    ::    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/.gitignore

@@ -0,0 +1,5 @@
+
+t
+
+*.pnm
+

Fraktalism/mods/Makefile

@@ -2,8 +2,23 @@
 #      compiling fraktalism's modules
 #
 
-GFOPT  = -Wall -Wextra -time -g
+GFOPT  = -Wall -Wextra -time -g -I../../Modules
+
+all:		xperiment.o points3d.o fractcolmap.o
 
 points3d.o:	points3d.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
+xperiment.o:	xperiment.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+fractcolmap.o:	fractcolmap.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+#		TEST PROGGY			--------------------
+
+OBJS = fractcolmap.o xperiment.o points3d.o
+
+t:	t.f90 Makefile $(OBJS)
+	gfortran $(GFOPT) $<  $(OBJS) ../../Modules/pixrgb.o  -o $@
+

Fraktalism/mods/README.md

@@ -9,3 +9,5 @@ avec un script de build bien robuste.
 
 Troisième point : Faire la [documentation](documentation.md)
 
+Quatrilème point : Cultiver la techno-futilité.
+

Fraktalism/mods/chroma.map

@@ -0,0 +1,356 @@
+48 48 48		'chromatic' color map
+56 48 56		by Todd Hedenstrom
+64 48 64
+72 48 72
+80 48 80
+88 48 88
+96 48 96
+104 48 104
+112 48 112
+120 48 120
+128 48 128
+136 48 136
+144 48 144
+152 48 152
+160 48 160
+168 48 168
+176 48 176
+184 48 184
+192 48 192
+200 48 200
+208 48 208
+216 48 216
+224 48 224
+216 48 224
+208 48 224
+200 48 224
+192 48 224
+184 48 224
+176 48 224
+168 48 224
+160 48 224
+152 48 224
+144 48 224
+136 48 224
+128 48 224
+120 48 224
+112 48 224
+104 48 224
+96 48 224
+88 48 224
+80 48 224
+72 48 224
+64 48 224
+56 48 224
+48 48 224
+48 56 224
+48 64 224
+48 72 224
+48 80 224
+48 88 224
+48 96 224
+48 104 224
+48 112 224
+48 120 224
+48 128 224
+48 136 224
+48 144 224
+48 152 224
+48 160 224
+48 168 224
+48 176 224
+48 184 224
+48 192 224
+48 200 224
+48 208 224
+48 216 224
+48 224 224
+48 224 216
+48 224 208
+48 224 200
+48 224 192
+48 224 184
+48 224 176
+48 224 168
+48 224 160
+48 224 152
+48 224 144
+48 224 136
+48 224 128
+48 224 120
+48 224 112
+48 224 104
+48 224 96
+48 224 88
+48 224 80
+48 224 72
+48 224 64
+48 224 56
+48 224 48
+56 224 56
+64 224 64
+72 224 72
+80 224 80
+88 224 88
+96 224 96
+104 224 104
+112 224 112
+120 224 120
+128 224 128
+136 224 136
+144 224 144
+152 224 152
+160 224 160
+168 224 168
+176 224 176
+184 224 184
+192 224 192
+200 224 200
+208 224 208
+216 224 216
+224 224 224
+224 224 216
+224 224 208
+224 224 200
+224 224 192
+224 224 184
+224 224 176
+224 224 168
+224 224 160
+224 224 152
+224 224 144
+224 224 136
+224 224 128
+224 224 120
+224 224 112
+224 224 104
+224 224 96
+224 224 88
+224 224 80
+224 224 72
+224 224 64
+224 224 56
+224 224 48
+224 216 48
+224 208 48
+224 200 48
+224 192 48
+224 184 48
+224 176 48
+224 168 48
+224 160 48
+224 152 48
+224 144 48
+224 136 48
+224 128 48
+224 120 48
+224 112 48
+224 104 48
+224 96 48
+224 88 48
+224 80 48
+224 72 48
+224 64 48
+224 56 48
+224 48 48
+216 48 48
+208 48 48
+200 48 48
+192 48 48
+184 48 48
+176 48 48
+168 48 48
+160 48 48
+152 48 48
+144 48 48
+136 48 48
+128 48 48
+120 48 48
+112 48 48
+104 48 48
+96 48 48
+88 48 48
+80 48 48
+72 48 48
+64 48 48
+56 48 48
+48 48 48
+40 48 48
+48 48 48
+56 48 56
+64 48 64
+72 48 72
+80 48 80
+88 48 88
+96 48 96
+104 48 104
+112 48 112
+120 48 120
+128 48 128
+136 48 136
+144 48 144
+152 48 152
+160 48 160
+168 48 168
+176 48 176
+184 48 184
+192 48 192
+200 48 200
+208 48 208
+216 48 216
+224 48 224
+216 48 224
+208 48 224
+200 48 224
+192 48 224
+184 48 224
+176 48 224
+168 48 224
+160 48 224
+152 48 224
+144 48 224
+136 48 224
+128 48 224
+120 48 224
+112 48 224
+104 48 224
+96 48 224
+88 48 224
+80 48 224
+72 48 224
+64 48 224
+56 48 224
+48 48 224
+48 56 224
+48 64 224
+48 72 224
+48 80 224
+48 88 224
+48 96 224
+48 104 224
+48 112 224
+48 120 224
+48 128 224
+48 136 224
+48 144 224
+48 152 224
+48 160 224
+48 168 224
+48 176 224
+48 184 224
+48 192 224
+48 200 224
+48 208 224
+48 216 224
+48 224 224
+48 224 216
+48 224 208
+48 224 200
+48 224 192
+48 224 184
+48 224 176
+48 224 168
+48 224 160
+48 224 152
+48 224 144
+48 224 136
+48 224 128
+48 224 120
+48 224 112
+48 224 104
+48 224 96
+48 224 88
+48 224 80
+48 224 72
+48 224 64
+48 224 56
+48 224 48
+56 224 56
+64 224 64
+72 224 72
+80 224 80
+88 224 88
+96 224 96
+104 224 104
+112 224 112
+120 224 120
+128 224 128
+136 224 136
+144 224 144
+152 224 152
+160 224 160
+168 224 168
+176 224 176
+184 224 184
+192 224 192
+200 224 200
+208 224 208
+216 224 216
+224 224 224
+224 224 216
+224 224 208
+224 224 200
+224 224 192
+224 224 184
+224 224 176
+224 224 168
+224 224 160
+224 224 152
+224 224 144
+224 224 136
+224 224 128
+224 224 120
+224 224 112
+224 224 104
+224 224 96
+224 224 88
+224 224 80
+224 224 72
+224 224 64
+224 224 56
+224 224 48
+224 216 48
+224 208 48
+224 200 48
+224 192 48
+224 184 48
+224 176 48
+224 168 48
+224 160 48
+224 152 48
+224 144 48
+224 136 48
+224 128 48
+224 120 48
+224 112 48
+224 104 48
+224 96 48
+224 88 48
+224 80 48
+224 72 48
+224 64 48
+224 56 48
+224 48 48
+216 48 48
+208 48 48
+200 48 48
+192 48 48
+184 48 48
+176 48 48
+168 48 48
+160 48 48
+152 48 48
+144 48 48
+136 48 48
+128 48 48
+120 48 48
+112 48 48
+104 48 48
+96 48 48
+88 48 48
+80 48 48
+72 48 48
+64 48 48
+56 48 48
+48 48 48
+40 48 48

Fraktalism/mods/documention.md

@@ -1,11 +1,18 @@
-# La doc (enfin !)
+# La doc des modules (enfin !)
+
+Non, détrompez-vous, ce n'est pas vraiment une doc, parce que
+les codes des modules du fraktalisme est en perpétuelle évolution.
 
 ## Points 3d
 
 Bientôt les quaternions ?
 
-## Portable Net Map
+## Xperiment
 
-Fichiers de type `PGM` utilisés ici en version 16 bits, donc
-65536 niveaux de gris.
+Des trucs bizarres, qui migreront (un jour, peut-être...) vers
+d'autres modules.
+
+## Fractint color mapfile
+
+This is juste a [wip](fractcolmap.f90), stay tuned.
 

Fraktalism/mods/fractcolmap.f90

@@ -0,0 +1,123 @@
+module fractcolmap
+
+  use    pixrgb           ! from Modules dir
+
+  implicit none
+
+  integer                :: currmap(0:255, 3)
+  logical                :: initialized = .FALSE.
+
+  contains
+!-----------------------------------------------------
+
+subroutine fcolm_infos(msg)
+  character(*), intent(in)    :: msg
+
+  write(0, *) ' -> fractcolmap infos because [', msg, ']'
+  write(0, *) '    initialized is ', initialized
+
+end subroutine
+!-----------------------------------------------------
+subroutine fcolm_load_mapfile(fname)
+  character(*), intent(in)    :: fname
+
+  integer                     :: io, errcode, idx
+  integer                     :: ir, ig, ib
+  write(0, *) ' -> fractcolmap load file [', fname, ']'
+
+  ! trying to get access to the datas
+  open(newunit=io, file=fname, iostat=errcode, action='read')
+  if (errcode .NE. 0) then
+    write(0, *) '    errcode :', errcode
+    write(0, *) '  FILE ', fname, ' NOT FOUND'
+    STOP 'BECAUSE FULL NUCKED, SORRY'
+  endif
+  ! loop over all the data
+  do idx=0, 255
+    read(io, *) ir, ig, ib
+    ! write(*, '("idx ", I5, "   got rgb", 3I6)') idx, ir, ig, ib
+    currmap(idx, 1) = ir
+    currmap(idx, 2) = ig
+    currmap(idx, 3) = ib
+  enddo
+  ! a few cleanup
+  close(io)
+
+end subroutine
+!-----------------------------------------------------
+!-
+!            draw all the colors in a nice picture
+!-
+subroutine fcolm_plot_mapfile(fname)
+  character(*), intent(in)    :: fname
+
+  type(t_pixrgb), allocatable             ::    prgb(:,:)
+  integer                                 ::    errcode, ix, iy, xx
+  integer                                 ::    rgb(3)
+
+  write(0, *) ' -> fractcolmap plot map to [', fname, ']'
+
+  allocate(prgb(512, 128), stat=errcode)
+  if (0 .NE. errcode) then
+    write(0, *) "errcode allocate in plot_map: ", errcode
+    STOP 'ABEND'
+  endif
+
+  call rgbpix_set_to_zero(prgb)
+
+  ! print *, ' FILE ', fname
+  do ix = 1, 255
+     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)
+       prgb(  xx, iy)%g = rgb(2)
+       prgb(1+xx, iy)%g = rgb(2)
+       prgb(  xx, iy)%b = rgb(3)
+       prgb(1+xx, iy)%b = rgb(3)
+     enddo
+  enddo
+
+  ! write(0, *) 'first pixel', prgb(1, 1)
+
+  !- push all the colred dats to disk
+  call rgbpix_spit_as_pnm_8(prgb, fname)
+
+  deallocate(prgb)
+
+end subroutine
+!-----------------------------------------------------
+subroutine fcolm_get_rgb(idx, rgb)
+
+  integer, intent(in)     :: idx
+  integer, intent(out)    :: rgb(3)
+
+  rgb(1) = max(min(currmap(idx, 1), 255), 0)       ! Red
+  rgb(2) = max(min(currmap(idx, 2), 255), 0)       ! Green
+  rgb(3) = max(min(currmap(idx, 3), 255), 0)       ! Blue
+
+end subroutine
+!-----------------------------------------------------
+subroutine fcolm_make_gray()
+  integer                 :: idx
+  do idx=0, 255
+    currmap(idx, 1) = idx
+    currmap(idx, 2) = idx
+    currmap(idx, 3) = idx
+  enddo
+  initialized = .TRUE.
+end subroutine
+!-----------------------------------------------------
+subroutine fcolm_print_map()
+  integer                 :: idx
+  do idx=0, 255
+    print *, currmap(idx, 1), currmap(idx, 2), currmap(idx, 3)
+  enddo
+end subroutine
+!-----------------------------------------------------
+end module
+

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/neon.map

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

Fraktalism/mods/t.f90

@@ -0,0 +1,40 @@
+program t
+
+  use fractcolmap
+
+  call fcolm_infos('from main')
+  ! call fcolm_make_gray()
+
+  call fcolm_load_mapfile('volcano.map')
+  call fcolm_plot_mapfile('volcano.pnm')
+
+  call fcolm_load_mapfile('neon.map')
+  call fcolm_plot_mapfile('neon.pnm')
+ 
+  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
+
+!------------------- 
+
+subroutine print_boundaries()
+  integer          :: foo
+  integer          :: cmp(3)
+  do foo=-2, 5
+    call fcolm_get_rgb(foo, cmp)
+    print *, foo, '     --> ', cmp
+  enddo
+  do foo=252, 257
+    call fcolm_get_rgb(foo, cmp)
+    print *, foo, '     --> ', cmp
+  enddo
+end subroutine
+
+end program
+

Fraktalism/mods/volcano.map

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

Fraktalism/mods/xperiment.f90

@@ -6,10 +6,8 @@ module xperiment
 !===============================================================
 ! nouveau 24 mai 2022
 
-subroutine parasites_0(pic, cx, cy, maxiter)
+subroutine parasites_1(pic, cx, cy, maxiter)
     implicit none
-
-    ! here is the wtf
     integer, intent(inout), dimension (:,:)  ::  pic
 
     real, intent(in)                         ::  cx, cy
@@ -23,43 +21,35 @@ subroutine parasites_0(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_0
+end subroutine parasites_1
 
 !---------------------------------------------------------------
 !
 !    aucune idee de l'utilisation de ce truc !
 !
-subroutine loop_of_parasites_0(nbre, mode)
+subroutine loop_of_parasites_1(nbre, mode)
     implicit none
     integer, intent(in)       :: 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_0
+end subroutine loop_of_parasites_1
 
 !===============================================================
 end module xperiment

Fraktalism/plotcolmap.f90

@@ -0,0 +1,23 @@
+program plotcolmap
+
+  use spitpgm
+  use fractcolmap
+
+  implicit none
+
+  integer             :: argc
+  character(200)      :: mapname, plotname
+
+! -------check for command line arguments
+  argc = IARGC()
+  if (2 .NE. argc) then
+    STOP 'BECAUSE I NEED TWO ARGS'
+  endif
+  call getarg(1, mapname)
+  call getarg(2, plotname)
+
+  call fcolm_infos('from plotcolmap')
+  call fcolm_load_mapfile(trim(mapname))
+  call fcolm_plot_mapfile(trim(plotname))
+
+end program

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,18 +1,27 @@
 
 essai
 animation
+realdump2png
 
 WS/*.pgm
 WS/*.png
 WS/*/*.pgm
 WS/*/*.png
+WS/*/*.gif
+WS/data/*
+WS/log.*
 
+*.pgm
+*.pnm
+*.png
 *.gif
 *.log
 *.mp4
+*.dump
 
-pov.stderr
+*.stderr
 
 foo.pgm
 bar.pgm
+planets.txt
 

GravityField/Makefile

@@ -3,9 +3,9 @@
 #
 
 GFOPT   = -Wall -Wextra -g -time -I../Modules
-MODOBJ  = '../Modules/spitpgm.o'
+MODOBJ  = ../Modules/spitpgm.o ../Modules/pixrgb.o
 
-all:	essai
+all:	essai animation realdump2png
 
 # ----------- modules
 
@@ -20,3 +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/README.md

@@ -1,5 +1,27 @@
-# Gravity Field
+# Gravity Field Experiment
 
-Some crude experiments to make fancy picture of a useless gravaity field.
+_Some crude experiments to make fancy picture of a useless gravity field._
 
 Expect bug party.
+
+## Le module `realfield`
+
+Les mécaniques sous-jacentes. Sans la moindre rigueur mathématique.
+
+## Le commandeur en chef
+
+C'est le logiciel sobrement nommé `animation` qui n'est absolument
+pas fini. Par exemple, il n'est absolument pas paramétrable sans
+passer per une recompilation.
+
+## Le raytracing
+
+Vous vous en doutez, c'est du POVray. 
+
+## Sortie graphique
+
+Actuellement, un script pour enrober gnuplot, what else ?
+
+## Conclusion
+
+Enjoy !

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

@@ -6,21 +6,23 @@
 program animation
 
   use realfield
-  use spitpgm               
+
+  use spitpgm             ! extern module
+  use pixrgb              ! extern module
+              
   implicit none
 
   ! some configuration constants
-  integer, parameter      :: S_WIDTH  = 1024
-  integer, parameter      :: S_HEIGHT = 1024
-  integer, parameter      :: NB_BODY  = 150
+  integer, parameter      :: S_WIDTH  = 2048
+  integer, parameter      :: S_HEIGHT = 2048
+  integer, parameter      :: NB_BODY  = 250
 
-  !!! WARNING : global variables !!!
+  !!! WARNING : global variable !!!
   type(massbody)          :: planets(NB_BODY)
-  ! integer                 :: foo
 
   call init_random()
-  call create_some_planets(planets, 1337e3, S_WIDTH , S_HEIGHT)
-  call barycentre_bodies(planets)
+  call create_some_planets(planets, 1664e3, S_WIDTH , S_HEIGHT)
+  call print_barycentre_bodies(planets, 'begin')
 
   call la_grande_boucle(0, 2000, planets)
 
@@ -29,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
@@ -39,24 +41,101 @@ subroutine la_grande_boucle(start, nbre, moons)
   integer                 :: pass 
 
   do pass=start, start+nbre-1
+    ! if second parameter is TRUE, use clipping,
+    !                     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, *) filename
-
+    write(0, '(3I5, "    *  ", a20)') start, nbre, pass, filename
     call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
 
-    call deplace_les_planetes(moons)
+    ! 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, 'end')
+
 end subroutine
 
 !-----------------------------------------------------------------------
-subroutine deplace_les_planetes(moons)
+!-
+!      this is going to go very complex
+!-
+subroutine make_color_map(moons, fname, width, height)
+  type(massbody), intent(in)       :: moons(:)
+  character(len=*), intent(in)     :: fname
+  integer, intent(in)              :: width, height
+
+  type(t_pixrgb), dimension(:,:), allocatable  :: cmap
+  integer                                      :: ix, iy, near, ipl
+  integer                                      :: errcode
+  real                                         :: curdist, smalldist 
+  real                                         :: fx, fy, dx, dy
+
+  write(0, *) "colmap ", ubound(moons, 1), "moons to ", trim(fname)
+  ! write(0, *) "mapsize ", width, height
+
+  allocate (cmap(width, height), stat=errcode)
+  ! write(0, *) "errcode allocate ", errcode
+
+  ! map = -1       ! invalidate colmap
+
+  !             DO SOME GOOD STUFF HERE
+  do ix=1, width
+    fx = real(ix)
+    do iy=1, height
+      fy = real(iy)
+
+      near      = -1
+      smalldist = 1e37
+
+      ! loop over all the planet's bodies
+      do ipl=1, ubound(moons, 1)
+        ! compute the pseudo distance
+        dx = fx - moons(ipl)%posx
+        dy = fy - moons(ipl)%posy
+        curdist = (dx*dx) + (dy*dy)
+        if (curdist .LT. smalldist) then
+          near = ipl
+          smalldist = curdist
+        endif
+      end do    ! loop on all the moons, ipl index
+
+      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_8(cmap, fname)
+
+  deallocate(cmap)
+
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!     C'est ici que se passe le deplacement des choses mouvantes
+!-
+!     Il y a deux manieres d'aborder les bords de l'univers (non, le combo
+!     segfault/coredump n'en fait pas partie).
+!-
+subroutine deplace_les_planetes(moons, clipit)
   type(massbody), intent(inout)    :: moons(:)
+  logical, intent(in)              :: clipit
 
   integer                 :: foo
-  real                    :: depx, depy
+  real                    :: depx, depy, coef
+
+  integer, parameter      :: EE = 100
+  integer                 :: SW = S_WIDTH  - EE
+  integer                 :: SH = S_HEIGHT - EE
 
   do foo=1, ubound(moons, 1)
 
@@ -68,15 +147,29 @@ subroutine deplace_les_planetes(moons)
 
     !-
     !   ici se pose une question pertinente sur la gestion des
-    !   bords du chanmp. Cclippin or Boucing ?
+    !   bords du chanmp. Clipping, Toring or Boucing ?
     !-
-    if (moons(foo)%posx .GT. S_WIDTH)   moons(foo)%posx = 0.0
-    if (moons(foo)%posy .GT. S_HEIGHT)  moons(foo)%posy = 0.0
-    if (moons(foo)%posx .LT. 0)         moons(foo)%posx = S_WIDTH
-    if (moons(foo)%posy .LT. 0)         moons(foo)%posy = S_HEIGHT
+    if (clipit) then
+      if (moons(foo)%posx .GT. SW)     moons(foo)%posx = SW
+      if (moons(foo)%posy .GT. SH)     moons(foo)%posy = SH
+      if (moons(foo)%posx .LT. EE)     moons(foo)%posx = EE
+      if (moons(foo)%posy .LT. EE)     moons(foo)%posy = EE
+      ! STOP 'BECAUSE WE ARE TOTALY FUCKED'
+    else
+      if (moons(foo)%posx .GT. SW)     moons(foo)%posx = EE
+      if (moons(foo)%posy .GT. SH)     moons(foo)%posy = EE
+      if (moons(foo)%posx .LT. EE)     moons(foo)%posx = SW
+      if (moons(foo)%posy .LT. EE)     moons(foo)%posy = SH
+    endif
 
-    moons(foo)%heading = moons(foo)%heading + (0.08*rand())
-    if (moons(foo)%heading .GT. 6.2831853) moons(foo)%heading = 0.0
+    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
 
   enddo
 

GravityField/encode.sh

@@ -23,11 +23,11 @@ echo "file type  :" $filetype
 case  $filetype in
 	PNG)		extension=".png"		;;
 	Netpbm)		extension=".pgm"		;;
-	*)		extension=".binary"		;;
+	*)		extension=".pnm"		;;
 esac
 echo "extension  :" $extension
 
-TITLE='---{ experimental gravity field }---'
+TITLE=$(printf -- '---{ experimental gravity field %d }---' $$)
 
 ffmpeg  -nostdin					\
 	-loglevel warning				\
@@ -37,6 +37,6 @@ ffmpeg  -nostdin					\
 	-c:v libx264 -pix_fmt yuv420p			\
 	$FNAME
 
-echo
+echo $FNAME ' ..... [done]'
 
 

GravityField/essai.f90

@@ -6,56 +6,77 @@
 program essai
   use  realfield
   use  spitpgm               ! XXX
+  use  pixrgb
 
   implicit none
 
-  ! some configuration constants
-  integer, parameter      :: S_WIDTH  = 800
-  integer, parameter      :: S_HEIGHT = 600
-  integer, parameter      :: NB_BODY  = 51
-
-  type(massbody)          :: planets(NB_BODY)
-  integer                 :: foo
-  character(len=100)      :: filename
-
   call init_random()
-  call create_some_planets(planets, 45e5, S_WIDTH, S_HEIGHT)
 
-  do foo=0, 1999
-    write (filename, "(a, i5.5, a)") 'WS/field/', foo, '.pgm'
-    call build_and_write_a_field(S_WIDTH, S_HEIGHT, planets, filename)
-    ! print *, trim(filename)
-    ! OMG! two magic numbers, wtf?
-    planets(1)%posx = planets(1)%posx + 3 + (4.5*rand())
-    planets(1)%posy = planets(1)%posy + 3 + (2.1*rand())
-    if (planets(1)%posx .GT. S_WIDTH)   planets(1)%posx = 0.0
-    if (planets(1)%posy .GT. S_HEIGHT)  planets(1)%posy = 0.0
-
-    call boulegue_les_astres(planets, 2.21)
-
-  enddo
+  call essai_near_planet(2048, 2048)
 
   STOP 'BECAUSE YOLO'
 
 contains
 !-----------------------------------------------------------------------
 !-
-!    Et si on bougeait un peu tous ces corps planétaires ?
+!     computation of thr nearest planet
 !-
-subroutine boulegue_les_astres(astres, factor)
-  type(massbody), intent(inout)     :: astres(:)
-  real, intent(in)                  :: factor
+subroutine essai_near_planet(nbplanets, szfield)
+  integer, intent(in)       :: nbplanets, szfield
 
-  integer                           :: foo
+  type(t_pixrgb), dimension(:,:), allocatable   :: cmap
+  integer                                       :: ix, iy
+  real                                          :: fx, fy, dx, dy
+  integer                                       :: near, ipl, errcode
+  real                                          :: curdist, smalldist 
+  type(massbody)                                :: planets(nbplanets)
+
+  print *, "near planets test", nbplanets, szfield
+
+  allocate(cmap(szfield, szfield), stat=errcode)
+  ! map = -1
+
+  ! create some random bodies
+  do ipl=1, nbplanets
+    planets(ipl)%posx   = rand() * szfield
+    planets(ipl)%posy   = rand() * szfield
+    planets(ipl)%serial = ipl
+  end do
+  ! call save_bodies_to_txt_file(planets, "planets.txt")
+
+  ! loop over all the location of the field
+  do ix=1, szfield
+    fx = real(ix)
+    do iy=1, szfield
+      fy = real(iy)
+
+      near      = -1
+      smalldist = 1e37
+      ! loop over all the planet's bodies
+      do ipl=1, nbplanets
+        ! compute the "fake" distance
+        dx = fx - planets(ipl)%posx
+        dy = fy - planets(ipl)%posy
+        curdist = (dx*dx) + (dy*dy)
+        if (curdist .LT. smalldist) then
+          near = ipl
+          smalldist = curdist
+        endif
+      end do    ! loop on ipl  
+
+      cmap(ix, iy)%r = mod(near*4,  255)
+      cmap(ix, iy)%g = mod(near*7,  255)
+      cmap(ix, iy)%b = mod(near*11, 255)
 
-  do foo = 2, ubound(astres, 1)
-      astres(foo)%posx = astres(foo)%posx + factor*(rand() - 0.5)
-      astres(foo)%posy = astres(foo)%posy + factor*(rand() - 0.5)
     enddo
 
+    write(0, *) "row", ix, "     on", szfield
+
+  enddo
+
+  call rgbpix_spit_as_pnm_8(cmap, "rgb.pnm")
 
 end subroutine
 !-----------------------------------------------------------------------
-!-----------------------------------------------------------------------
 
 end program

GravityField/plotation.sh

@@ -0,0 +1,42 @@
+#!/bin/bash
+
+set -e
+
+SRC=WS/data/00013.txt
+DST=graph.png
+
+rm WS/graph/*.png
+
+# ----------------------------------------------------------
+plot_a_map ()
+{
+NUMERO=$1
+
+SRC=$(printf "WS/data/%05d.txt"    $NUMERO)
+DST=$(printf "WS/graph/%05d.png"   $NUMERO)
+TXT=$(printf "mb #%05d"            $NUMERO)
+
+echo "    " $SRC $DST "      " $TXT
+
+gnuplot << __EOC__
+set term png    size 512,512
+set xrange    [ 0.0 : 1024 ]
+set yrange    [ 0.0 : 1024 ]
+set output      "${DST}"
+set ytics       128
+set xtics       128
+set grid        front
+set title       "${TXT}"
+plot            "$SRC"  using 1:2 title "loc"
+__EOC__
+}
+# ----------------------------------------------------------
+
+for foo in $(seq 0 5 1999)
+do
+	plot_a_map $foo
+done
+
+convert -delay 10 WS/graph/0????.png displacement.gif
+
+# ----------------------------------------------------------

GravityField/raytrace.sh

@@ -6,12 +6,16 @@ POVOPT=" -q9 +a -W1280 -H1024 +WT2 -d -v "
 SOURCE="vision.pov"
 TMPF="/dev/shm/gravfield.png"
 
+date > pov.stderr
+
 #		---------------------------------------
 
 une_passe ()
 {
 clock=$1
 
+cp pov.stderr old.stderr
+
 povray -i${SOURCE} -K${clock} $POVOPT -O${TMPF} 2> pov.stderr
 
 timestamp=$(date -u +'%F %H:%M' | tr '01' 'Ol')
@@ -20,31 +24,35 @@ outfile=$(printf "WS/troid/%05d.png" $clock)
 echo  $timestamp $texte $outfile
 
 convert	${TMPF}				\
-	-pointsize 16			\
+	-pointsize 24			\
 	-font Courier-Bold		\
-	-fill Orange			\
-	-annotate +10+16  "$timestamp"	\
-	-annotate +10+34  "$texte"	\
-	-pointsize 8			\
+	-fill Yellow			\
+	-annotate +20+32  "$timestamp"	\
+	-annotate +20+58  "$texte"	\
+	-pointsize 16			\
 	-gravity south-west		\
-	-annotate +10+6 "tTh & Konrad"	\
+	-annotate +15+9 "tTh & Konrad"	\
 	${outfile}
+
+sleep 6
 }
 
 #		---------------------------------------
 
+# 	main loop, build all that nice picz
+
 for foo in $(seq 0 1999)
 do
 	echo '............' $foo
 	une_passe $foo
-	exit
 done
 
 ffmpeg  -nostdin					\
 	-loglevel warning				\
-	-y -r 30 -f image2 -i WS/trid/%05d.png 		\
+	-y -r 30 -f image2 -i WS/troid/%05d.png 	\
 	-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

@@ -9,11 +9,12 @@ module realfield
   implicit none
 
 !-----------------------------------------------------------------------
+!-
 !      definition of structures
 !-
 type massbody
-  real                  :: posx, posy
-  real                  :: heading       = 0.21
+  real                  :: posx = 0, posy = 0
+  real                  :: heading       = 0.29
   real                  :: speed         = 1.017
   real                  :: mass          = 1.0
   integer               :: serial        = 666
@@ -22,63 +23,78 @@ end type
 !-----------------------------------------------------------------------
 contains
 !-----------------------------------------------------------------------
-subroutine barycentre_bodies(astres)
+subroutine compute_barycentre_bodies(astres, bcx, bcy)
   type(massbody), intent(in)     :: astres(:)
-
-  real                           :: cx, cy
+  real, intent(out)              :: 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)
     cx = cx + astres(foo)%posx
     cy = cy + astres(foo)%posy
   enddo
-  cx = cx / real(ubound(astres, 1))
-  cy = cy / real(ubound(astres, 1))
-  print *, 'barycentre:', cx, cy
+  bcx = cx / real(ubound(astres, 1))
+  bcy = cy / real(ubound(astres, 1))
+end subroutine
+!-----------------------------------------------------------------------
+subroutine print_barycentre_bodies(astres, title)
+  type(massbody), intent(in)     :: astres(:)
+  character(len=*), intent(in)   :: title
+
+  real                           :: cx, cy
+  call compute_barycentre_bodies(astres, cx, cy)
+  print *, "barycentre {", title, "}  ", cx, cy
 
 end subroutine
 !-----------------------------------------------------------------------
 !-
 !              make a few solid body to play with...
 !-     
+!       planets    :   an array of type(massbody) to be filled
+!       coef       :   for setting the mass of the body
+!       sx, sy     :   borders of the universe
+!-
 subroutine create_some_planets(planets, coef, sx, sy)
   type(massbody), intent(inout)     :: planets(:)
   real, intent(in)                  :: coef
   integer, intent(in)               :: sx, sy
-
   integer                           :: foo
   character(100)                    :: fmt
 
   fmt = "(I4, '  | ', 2(F10.2, '  '), ' | ', 2F9.3, '  ', e12.3, I7)"
 
   do foo=1, ubound(planets, 1)
+    if (foo .EQ. 1) then
       !-
       !   the first planet is the home of Johnny Root
       !-
-    if (foo .EQ. 1) then
       planets(1)%posx   = sx / 2
       planets(1)%posy   = sy / 2
-      planets(1)%mass   = 37e8
+      planets(1)%mass   = 31e8
       planets(1)%serial = 1337
+      planets(1)%speed  = 6.666
     else
+      !-
+      !   others are planets for peones
+      !-
       planets(foo)%posx     = rand() * real(sx-1)
       planets(foo)%posy     = rand() * real(sy-1)
-      planets(foo)%mass     = 7e6 + coef*foo
-      planets(foo)%heading  = 3.14159 * rand()
-      if (rand() .LT. 0.01) planets(foo)%speed = 2.718
+      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
+
     write (*, fmt) foo, planets(foo)
   enddo
-
 end subroutine
 !-----------------------------------------------------------------------
-
+!-
+!           the basis of the kluge
+!-
 function compute_gravity(fx, fy, body)
   real, intent(in)              :: fx, fy
   type(massbody), intent(in)    :: body
@@ -87,20 +103,40 @@ function compute_gravity(fx, fy, body)
 
   rx = fx - body%posx
   ry = fy - body%posy
-  dist = sqrt( (rx*rx) + (ry*ry) )
-  if (dist .LT. 0.11) then
+  ! ??? dist = sqrt( (rx*rx) + (ry*ry) )
+  dist = (rx*rx) + (ry*ry)
+  if (dist .LT. 0.08) then
     ! write (0, *) "dist too small ", dist
     compute_gravity = 0e0
   else
-    compute_gravity = body%mass / (dist ** 2)
+    ! ??? compute_gravity = body%mass / (dist ** 2)
+    compute_gravity = body%mass / dist
   endif
 
 end function
+!-----------------------------------------------------------------------
+!-
+!   Export a massbody area to a text file. no error check, wtf ?
+!-
+subroutine save_bodies_to_txt_file (astres, fname)
+  type(massbody), intent(in)        :: astres(:)
+  character(len=*), intent(in)      :: fname
 
+  character(50)                     :: fmt
+  integer                           :: io, idx
+
+  write(0, "('saving planets to ', A20)") fname
+  fmt = "( 2(F9.3, ' ')   2(F9.3, '  '), F14.3,  I8)"
+  open(newunit=io, file=fname)
+  do idx = 1, ubound(astres, 1)
+    write(io, fmt) astres(idx)
+  enddo
+  close(io)
+end subroutine
 !-----------------------------------------------------------------------
 !-
 !   Compute the gravity field in a pre-allocated array relative
-!   to the massbody 'moon'. Nobody know where the magic number
+!   to the massbody 'moon'. Nobody know where the magic numbers
 !   come from, sorry.
 !-
 subroutine compute_a_field(field, moon)
@@ -144,7 +180,7 @@ subroutine build_and_write_a_field(szx, szy, moons, fname)
   field = 0.0
   do foo=1, ubound(moons, 1)
     call compute_a_field(tmpf, moons(foo))
-    tmpf = tmpf * 0.019
+    tmpf = tmpf * 0.018
     field = field + tmpf
   enddo
 
@@ -185,9 +221,67 @@ subroutine init_random()
   ! you MUST use it for initializing the initializer
   do t3=1, 4
     dummy = rand()
-    write(0, *) 'dummy ', t3, dummy
+    write(0, '("   dummy", I4, F9.6)') t3, dummy
   enddo
 
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!    dump a field of reals numbers to disk - preliminary version
+!-
+subroutine dump_a_field_to_file(field, fname)
+  real, dimension(:,:), intent(in)  :: field
+  character(len=*), intent(in)      :: fname
+
+  integer                         :: header(8)
+  integer                         :: io
+
+  print *, "D) field size  ", ubound(field, 1), "W", ubound(field, 2), "H"
+  print *, "D) filename    ", fname
+
+  header     = 0
+  header(1)  = 574908040             ! magic number
+  header(2)  = 1                     ! this is a dump of real field
+  header(3)  = ubound(field, 1)
+  header(4)  = ubound(field, 2)
+  header(5)  = 666
+
+  open(newunit=io, file=fname, form='unformatted')
+  
+  write(io) header
+  write(io) field
+
+  close(io)
+
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!    load a real field from file  - preliminary version
+!-
+subroutine load_a_field_from_file(field, fname)
+  real, dimension(:,:), intent(in)  :: field
+  character(len=*), intent(in)      :: fname
+
+  integer                         :: header(8)
+  integer                         :: io, foo
+
+  print *, "L) field size  ", ubound(field, 1), "W", ubound(field, 2), "H"
+
+  !-
+  ! how to check if the field array was valid ?
+  !-
+
+  open(newunit=io, file=fname, form='unformatted', status='old',     &
+                                                   action='read')
+  read(io) header
+  do foo=1, 8
+    print *, foo, header(foo)
+  enddo
+
+  STOP ' --- FUCKED UP BEYOND ALL REPAIR ---'
+
+  close(io)
+
 end subroutine
 !-----------------------------------------------------------------------
 !-----------------------------------------------------------------------

GravityField/runme.sh

@@ -2,9 +2,15 @@
 
 set -e				# stop on error
 
-make essai
+make animation
 
-time ./essai | tee essai.log
+LOG="WS/log.animation"
 
-./encode.sh WS/field/ foo.mp4
+date >> $LOG
 
+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

@@ -14,13 +14,18 @@ global_settings {
 #include  "colors.inc"
 
 #declare NormClock = clock / 2000.01;
+#debug concat("- - - - - - - ", str(NormClock, 7, 5), "\n")
 
 // ----------------------------------------------------------------------
 
 #declare HFDIR  = "WS/nanim/";
 #declare HFCK   = mod(clock, 2000);
 #declare HFNAME = concat(HFDIR, str(HFCK , -5, 0), ".pgm");
-#debug concat("- - - - - - - ", HFNAME, "\n")
+
+#declare CMDIR  = "WS/colmap/";
+#declare CMNAME = concat(CMDIR, str(HFCK , -5, 0), ".pnm");
+
+#debug concat("- - - - - - - ", HFNAME, "  ", CMNAME, "\n")
 
 #declare GravityField = object
 {
@@ -30,25 +35,41 @@ height_field {
         translate <-0.5, 0, -0.5>
 	}
 texture {
-	pigment { color Gray80 }
-	finish { phong 0.50 }
+	pigment {
+		image_map { ppm CMNAME }
+		// image_map { png "WS/mire1024.png" }
+		rotate x*90
+		translate <-0.5, 0, -0.5>
+		}
+	finish { phong 0.45 }
 	}
 }
 
-object { GravityField scale <4, 0.70, 4> }
+object { GravityField scale <4.10, 0.60, 4.10> }
 
 // ----------------------------------------------------------------------
 
-cylinder { <0, -0.5, 0>, <0, 1, 0>, 0.0175 pigment { color Red } }
+#if (0)
+merge {
+	cylinder { <0, -0.5, 0>, <0, 1, 0>, 0.0175  }
+	sphere   { <0, 1, 0>, 0.0175  }
+	pigment { color Red }
+	}
+#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-NormClock, 1 + 3*NormClock>
+	// omnimax
+	location	<Xcam, Ycam, Zcam>
 	look_at		<0, 0, 0>
 	right		x*image_width/image_height
 	angle		34

Modules/.gitignore

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

Modules/Makefile

@@ -1,18 +1,67 @@
 #
-#		* Fortraneries *
+#		* Fortraneries from tTh *
 #
-#	Makefile for the general purpose moduls
+#	Makefile for the general purpose modules
 #
 
-GFOPT  = -Wall -Wextra -time -g -O 
+GFOPT  =  -Wall -Wextra -g -I.
+
+all:	chkpixels trnd twavm
+
+# ---------------------------------------------------------
 
 spitpgm.o:		spitpgm.f90 Makefile
-	gfortran $(GFOPT) -c $< -o $@
+	gfortran $(GFOPT) -c $<
 
+pixrgb.o:		pixrgb.f90 Makefile
+	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 $<
+
+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
 #
 
-chkpixels:	chkpixels.f90 Makefile spitpgm.o
-	gfortran $(GFOPT) $< spitpgm.o -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,4 +1,42 @@
 # General purpose modules
 
 
-* spitpgm
+## Modules disponibles
+
+### wavmetrics
+
+This module try to make some computations on *stereo* buffers.
+
+This is just a [WIP](./wavmetrics.f90), see [twavm](./twavm.f90) for a no-use case.
+
+### spitpgm
+
+Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
+
+### pixrgb
+
+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

@@ -1,34 +1,70 @@
+!-------------------------------------------------------------------
+!-
+
 program chkpixels
 
   use   spitpgm              
+  use   pixrgb
+
+  use   trials                ! experiments, ymmv.
+
   implicit none
 
-
   write(0, *)  "------ CHKPIXELS ------"
-  call test_alpha()
+  ! call test_spit_gray(3)
+  call test_spit_rgb16(1100, 512)
 
   STOP 'BECAUSE NO CPU AVAILABLE'
 
 contains
 !-------------------------------------------------------------------
 !-
-  subroutine test_alpha()
+!     exerciser for the 'pixrgb' module
+!-
+  subroutine test_spit_rgb16(sz, kg)
+    integer, intent(in)    :: sz, kg
 
-  integer, parameter          :: SZ = 32
+    type(t_pixrgb), allocatable  :: pixrgb(:,:)
+    integer                      :: ix, iy
+
+    print *, "test spit rgb", sz
+    allocate(pixrgb(sz, sz))
+    call rgbpix_set_to_zero(pixrgb)
+
+    do ix=1, sz
+      do iy=1, sz
+        pixrgb(ix, iy)%r = 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_16  (pixrgb, "current-rgb16.pnm")
+    call new_spit_rgb16         (pixrgb, "experiment-rgb16.pnm")
+
+    deallocate(pixrgb)
+
+  end subroutine
+!-------------------------------------------------------------------
+!-
+  subroutine test_spit_as(increment)
+  integer, intent(in)         :: increment
+
+  integer, parameter          :: SZ = 40
   integer, dimension(SZ, SZ)  :: greymap
   integer                     :: ix, iy, value
 
+  print *, "test spit as", sz
   value = 0
   do iy=1, SZ
     do ix=1, SZ
       greymap(ix, iy) = value
-      value = value + 1
+      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 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

@@ -0,0 +1,165 @@
+!-
+!	This module try to write PNM complient RGB files
+!                ONLY ASCII MODE IS SUPPORTED !
+!-
+module pixrgb
+    implicit none
+!-----------------------------------------------------------------------
+!-
+!      definition of structures
+!-
+type t_pixrgb
+  integer           :: r, g, b
+  integer           :: alpha = 0
+end type
+!-------------------------------------------------------------------
+contains
+!-------------------------------------------------------------------
+!-
+!	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
+
+  integer                               ::  io, ix, iy
+
+  open(newunit=io, file=fname)
+  write (io, '(a2)') "P3"
+  write (io, '("# rgbpix_spit_as_pnm_8")')
+  write (io, '(i0,"  ",i0)')  size(pic, 1), size(pic, 2)
+  write (io, '(i0)') 255
+
+  do iy=1, ubound(pic, 2)
+    do ix=1, ubound(pic, 1)
+      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 !
+!-
+subroutine rgbpix_spit_as_pnm_16_old(pic, fname)
+
+  type(t_pixrgb), intent(in)       ::  pic(:,:)
+  character (len=*), intent(in)    ::  fname
+
+  integer                               ::  io, ix, iy
+
+  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
+
+  do iy=1, ubound(pic, 2)
+    do ix=1, ubound(pic, 1)
+      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

@@ -1,5 +1,5 @@
 !-
-!	This module try to write PNM complient files - ymmv
+!	This module try to write PGM complient gray level files
 !-
 module spitpgm
 
@@ -8,8 +8,9 @@ module spitpgm
 
 !-------------------------------------------------------------------
 !-
-!   This subroutine try to scale the values to fit the 16 bit range
-!
+!   This subroutine try to scale the values to fit the 16 bit range.
+!   XXX may be add a third parameter : the max value required ?
+!-
 subroutine spit_as_pgm_eq(pic, fname)
 
     integer, intent(in), dimension (:,:)  ::  pic
@@ -19,7 +20,7 @@ subroutine spit_as_pgm_eq(pic, fname)
     integer   :: ix, iy
     real      :: fk, fpix
 
-    write(0, '(1X, A)') "> spit_as_pgm_eq to " // trim(fname)
+    ! write(0, '(1X, A)') "  spit_as_pgm_eq to " // trim(fname)
 
     open(newunit=io, file=fname)
     write (io, '(a2)') "P2"
@@ -34,7 +35,7 @@ subroutine spit_as_pgm_eq(pic, fname)
         enddo
     else
         fk = float(foo)  / 65535.01
-        write (0, *) "  max pix value", foo, " fk  ", fk
+        ! write (0, *) "  max pix value", foo, " fk  ", fk
         do iy = 1, ubound(pic, 2)
             do ix = 1, ubound(pic, 1)
                  fpix = float(pic(ix, iy)) / fk
@@ -48,6 +49,7 @@ end subroutine
 !-------------------------------------------------------------------
 !-
 !     16 bits - 65535 levels portable grey map file
+!     no data conversion except upper clippin.
 !-
 subroutine spit_as_pgm_16(pic, fname)
     integer, intent(in), dimension (:,:)  ::  pic
@@ -58,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
 
@@ -85,6 +88,7 @@ subroutine spit_as_pgm_8(pic, fname)
     ! XXX print *, "      max = ", foo
     open(newunit=io, file=fname)
     write (io, '(a2)') "P2"
+    write (io, '(A)')  "# spit_as_pgm_8"
     write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
     write (io, '(i0)') 255
 

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