dernier commit avant le Gers

BloubWorld/.gitignore

@@ -6,6 +6,9 @@ nbimg.inc
 *.blbs
 *.mp4
 *.lst
+*.wav
+*.xyz
+*.ssv
 frames/*
 log.*
 
@@ -16,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 $@
 
 # ------------------------------------------------------------
 
@@ -31,30 +32,27 @@ out.lst:	out.blbs exportbloubs Makefile
 # ------------------------------------------------------------
 
 bloubspace.o:	bloubspace.f90 Makefile
-	gfortran $(GFOPT) -pg -c $<
-
-povstuff.o:	povstuff.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-mathstuff.o:	mathstuff.f90 Makefile
+povstuff.o:	povstuff.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,29 +7,16 @@ 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 !
-
-```
-  type t_bloubs
-    character(8)         :: nick
-    logical              :: alive
-    integer              :: state
-    real                 :: px, py, pz
-    real                 :: vx, vy, vz
-    real                 :: radius
-    integer              :: age
-  end type t_bloubs
-```
-
-C'est simple, en fait. Le plus compliqué, c'est de savoir quoi en faire.
-
-On peut en fabriquer des gazillions, et ensuite
+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,
-ils vont mourir. C'est comme ça.
+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 ?
 
@@ -37,44 +24,57 @@ 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.
 
-Ces opérations agissent sur des fichiers de type `.blsb` qui sont,
+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.
-Les règles de génération devraient être paramétrables.
+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
 
 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,53 +70,91 @@ 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 = 4.33 * (rand() - 0.50)
-    blb%py = 3.70 * (rand() - 0.50)
-    blb%pz = 4.51 * (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.000
-    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()) / 3.200
-    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.000
-    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 = 500
+    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)
 
+  subroutine spit_bloubs_to_file (fname, blbarray, towrite)
+    implicit none
     character(*), intent(in)       :: fname
     type(t_bloubs), dimension(:)   :: blbarray
     integer, intent(in)            :: towrite
 
-    write (0, '(" spiting", (I6), "bloubs to", (A), "file")')     &
-                        towrite, trim(fname)
+    integer                :: errcode, output, foo, spitted
+    character(200)         :: chaine
  
-    STOP ' : NOT IMPLEMENTED'
+    ! write (0, '(" spitting", (I6), " bloubs to ", (A), " file")')     &
+    !                     towrite, trim(fname)
 
-  end subroutine
+    open(      newunit=output,                            &
+               file=trim(fname), form='unformatted',      &
+               iostat=errcode, iomsg=chaine,              &
+               action='write', status='replace')
+    if (0 .ne. errcode) then
+      write(0, '(" errcode ", I8, 2X, A)') errcode, chaine
+      STOP " : CAN'T OPEN FILE " // trim(fname)
+    endif
+
+    spitted = 0
+    do foo=1, towrite
+      if (blbarray(foo)%alive) then
+        write(output, iostat=errcode) blbarray(foo) 
+        if (0 .ne. errcode) then
+          STOP " : WRITE ERROR TO " // trim(fname)
+        endif
+        spitted = spitted + 1
+      endif
+    enddo
+
+    close(output)
+    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
 
     character(200)      :: chaine
     integer             :: input, errcode, idx
+    integer             :: capacity
     type(t_bloubs)      :: bloub
 
     write(0, '(" slurping from file [", (A), "]")') trim(infile)
@@ -128,13 +169,14 @@ module bloubspace
     endif
     ! write(0, '((A, I3))') " slurping from unit ", input
 
+    capacity = ubound(blbarray, 1)
     nbread = 0
     idx = 1;
     do
       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
@@ -143,16 +185,20 @@ module bloubspace
         blbarray(idx) = bloub
         idx = idx + 1
       endif
+      if (idx .GT. capacity) then
+        exit
+      endif
     enddo
 
     close(input)        ! no error checking ?
+    ! write(0, '(" have read ", (I8), " bloubs")') nbread
 
-   write(0, '(" read ", (I8), " bloubs")') nbread
-  end subroutine
+  end subroutine slurp_bloubs_file_in_array
   ! ----------------------------------------------------------------
   !        Display a bloub content to stderr
 
   subroutine display_bloub (blb, message)
+    implicit none
     type(t_bloubs), intent (in)  :: blb
     character(*),   intent (in)  :: message
 
@@ -172,64 +218,91 @@ 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
 
     ! we must check that this bloub is alive ?
-
     blb%px  = blb%px + (blb%vx * coef)
     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_blob (blb)
+  subroutine bound_a_bloub (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
 
-    if ( 5.0 .lt. (blb%px + blb%radius)) then
+    real, parameter      :: SH = 6.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 = 5.0
-      blb%age = blb%age + 1
+      blb%px = SH - blb%radius
+      flag = .TRUE.
     endif
-    if (-5.0 .gt. (blb%px + blb%radius)) then
+    if ((blb%px - blb%radius) .LT. -SH) then
       blb%vx = -1.0 * blb%vx
-      blb%px = -5.0
-      blb%age = blb%age + 1
+      blb%px = -SH + blb%radius
+      flag = .TRUE.
     endif
 
-    ! vertical axe
-    if (-4.99 .gt. (blb%py + blb%radius)) then
+    ! vertical axe Y
+    if ((blb%py - blb%radius) .LT. -SV) then
       blb%vy = -1.0 * blb%vy
-      blb%py = blb%radius
-      blb%age = blb%age + 1
+      blb%py = -SV + blb%radius
+      flag = .TRUE.
     endif
-    if ( 4.99 .lt. (blb%py + blb%radius)) then       ! overshoot ?
+    if ((blb%py + blb%radius) .GT. SV) then       ! overshoot ?
       blb%vy = -1.0 * blb%vy
-      blb%age = blb%age + 1
-      blb%py = 5.0 - blb%radius                            !!
+      blb%py = SV - blb%radius
+      flag = .TRUE.
     endif
 
-    if ( 5.0 .lt. (blb%pz + blb%radius)) then
+    !    Z axis
+    if ((blb%pz + blb%radius) .GT. SH) then
       blb%vz = -1.0 * blb%vz
-      blb%age = blb%age + 1
-      blb%pz = 5.0
+      blb%pz = SH - blb%radius
+      flag = .TRUE.
     endif
-    if (-5.0 .gt. (blb%pz + blb%radius)) then
+    if ((blb%pz + blb%radius) .LT. -SH) then
       blb%vz = -1.0 * blb%vz
+      blb%pz = -SH + blb%radius
+      flag = .TRUE.
+    endif
+
+    if (flag) then
       blb%age = blb%age + 1
-      blb%pz = -5.0
+      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
 
@@ -247,21 +320,21 @@ module bloubspace
   !          kill a bloub under condition(s)
 
   subroutine green_soylent (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
 
-    if (blb%age .gt. 18) 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
   ! ----------------------------------------------------------------
 
-
 end module
 
 

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
@@ -15,7 +15,7 @@ program genbloubs
   endif
   call getarg(1, filename)
   
-  write (0, '(A, A)') "*** exporting from ", trim(filename)
+  write (0, '(A, A)') "### exporting from ", trim(filename)
 
   open(unit=idu, file=trim(filename), form='unformatted',     &
                  iostat=errcode,                              &
@@ -32,11 +32,15 @@ program genbloubs
     if (0 .ne. errcode) then
       exit
     endif
-    print *, bloub%px, bloub%py, bloub%pz, bloub%radius, bloub%age
+    if (bloub%alive) then
+      print *, bloub%px, bloub%py, bloub%pz, bloub%radius,     &
+               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,6 +1,7 @@
 program genbloubs
 
   use bloubspace
+  use mathstuff2
 
   integer               :: nbbloubs
   integer               :: i
@@ -21,6 +22,8 @@ program genbloubs
   write (0, '(A,I8,A)') &
   "*** generating ", nbbloubs, " bloubs to "//trim(filename)
 
+  call init_random_seed()
+
    open(newunit=idu, file=trim(filename),            &
                  form='unformatted',                 &
                  access="sequential",                &
@@ -30,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
@@ -18,12 +18,13 @@ program movebloubs
   call getarg(1, infile)
 
   write (0, '(A)') &
-            "*** listing bloubs from "//trim(infile)
+            "***** listing bloubs from "//trim(infile)
 
   allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY"
   endif
+  ! run a molly-guard
   do i = 1, NB_MAX_BLOUBS
     bloubs(i)%alive = .FALSE.
   enddo
@@ -32,13 +33,13 @@ program movebloubs
   write(0, '(A,I6,1X,A)') "slurped ", nbgot, "bloubs"
 
   do i=1, nbgot
-    write(6, '(A8, 1X, 1L, 1X, I2, 3X, F8.3, 3X, 3F8.3, 3X, 3F8.3, 1X, I4)')  &
+    write(6, '(A8, 1X, 1L, 1X, I2, 1X, F8.3, 1X, 3F8.3, 1X, 3F8.3, 1X, 2I4)')  &
           bloubs(i)%nick, bloubs(i)%alive,               &
           bloubs(i)%state,                               &
           bloubs(i)%radius,                              &
           bloubs(i)%px, bloubs(i)%py, bloubs(i)%pz,      &
           bloubs(i)%vx, bloubs(i)%vy, bloubs(i)%vz,      &
-          bloubs(i)%age
+          bloubs(i)%age, bloubs(i)%agemax
   enddo
 
 end program

BloubWorld/mathstuff.f90

@@ -8,10 +8,12 @@ module mathstuff
   !                  not really tested yet...
 
   subroutine init_random_seed()
+    implicit none
 
     integer, dimension(3) :: tarray
     integer               :: t3, foo
     real                  :: dummy
+
     call itime(tarray)
     t3 = 3600*tarray(1) + 60*tarray(2) + tarray(3)
     ! write(0, '(A,3I3,A,I6)') " sranding: ", tarray, " --> ", t3
@@ -19,7 +21,7 @@ module mathstuff
 
     ! after initializing the random generator engine,
     ! you MUST use it for initializing the initializer
-    do foo=1, tarray(1)+5
+    do foo=1, tarray(1)+15
       dummy = rand()
     enddo
 

BloubWorld/mergebloubs.f90

@@ -5,18 +5,18 @@ program mergebloubs
           !-------------------------------------------!
 
   use bloubspace
+  use mathstuff2
   implicit none
 
-  integer, parameter       :: NB_MAX_BLOUBS = 25000
+  integer, parameter       :: NB_MAX_BLOUBS = 250000
 
   character(200)           :: infile, outfile
-  type(t_bloubs)           :: bloub, newbloub
-  integer                  :: inu, outu, errcode
-
-  type(t_bloubs), dimension(:), allocatable  :: les_bloubs
-  integer                                    :: i, idx, nbr_merge
-  real                                       :: rval
-  logical                                    :: merged
+  ! type(t_bloubs)           :: bloub, newbloub
+  integer                  :: errcode, nbgot
+  type(t_bloubs), dimension(:), allocatable  :: bloubs
+  integer                  :: ia, ib, contacts
+  real                     :: dist,radd
+  type(t_bloubs)           :: merged
 
 ! --------------- check command line parameters
   if (IARGC() .ne. 2) then
@@ -25,132 +25,71 @@ program mergebloubs
   call getarg(1, infile)
   call getarg(2, outfile)
 
-  write(0, '(A, 2A20, I8)') "*** mergebloubs ",        &
+  write(0, '(A, A, 1X, A, 1X, I6)') "### mergebloubs ",        &
                  trim(infile), trim(outfile), NB_MAX_BLOUBS
 
-! --------------- allocate memory for the people
+  call init_random_seed()
 
-  allocate (les_bloubs(NB_MAX_BLOUBS), stat=errcode)
+  allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY"
   endif
 
-  do i = 1, NB_MAX_BLOUBS
-    les_bloubs(i)%alive = .FALSE.
+  call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
+  write(0, '(A,I0,1X,A)') " slurped ", nbgot, "bloubs"
+
+  contacts = 0
+  do ia = 1, nbgot
+    ! print *, ia, "  =   ", les_bloubs(ia)%nick, les_bloubs(ia)%num
+    do ib = ia+1, nbgot
+      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
 
-! --------------- open / creat the files
-
-  open(newunit=inu,                                          &
-                  file=trim(infile), form='unformatted',     &
-                  iostat=errcode,                            &
-                  action='read', status='old')
-  if (0 .ne. errcode) then
-    STOP " : CAN'T OPEN FILE " // trim(infile)
+  call spit_bloubs_to_file (outfile, bloubs, nbgot)
+  if (contacts .GT. 0) then
+    write(0, '(A,I0,A,I0,A)') &
+          " merge: ", contacts, " contacts pour ", nbgot, " bloubs"
   endif
 
-  open(newunit=outu,                                         &
-                  file=trim(outfile), form='unformatted',    &
-                  iostat=errcode,                            &
-                  action='write', status='replace')
-  if (0 .ne. errcode) then
-    STOP " : CAN'T OPEN " // trim(outfile) // "FOR WRITE"
-  endif
+  ! STOP 'mergebloubs [done]'
 
-! --------------- read the first bloub
+! ==============================================================
 
-  idx = 1
-
-  read (unit=inu, iostat=errcode) bloub
-    if (0 .ne. errcode) then
-      STOP " : ERR READING FIRST BLOUB"
-    endif
-  call display_bloub (bloub, "first bloub")
-  write(outu, iostat=errcode) bloub
-  if (0 .ne. errcode) then
-    STOP " : FIRST BLOUB, WRITE ERROR TO " // trim(outfile)
-  endif
-
-  les_bloubs(idx) = bloub
-  idx = idx + 1
-
-! --------------- loop over the other bloubs
-  nbr_merge = 0
-
-  do                 ! infinite loop
-
-    ! print *, "============ PASS ", idx
-    if (idx .EQ. NB_MAX_BLOUBS) then
-      write(0, '(I8, A)') idx, " max number of bloubs reached"
-      exit
-    endif
-
-    ! read the next bloub from input file
-    read (unit=inu, iostat=errcode) bloub
-      if (0 .ne. errcode) then
-        exit
-      endif
-    !! call display_bloub (bloub, "next bloub")
-
-    if (.NOT. bloub%alive) then
-      STOP " : I HAVE READ A DEAD BLOUB"
-    endif
-
-    ! check with all the previuous blobs
-    merged = .FALSE.
-    do i = 1, idx-1
-      if (.NOT. les_bloubs(i)%alive) then
-        ! print *, "dead bloub at ", i, " on ", idx
-        ! call display_bloub(les_bloubs(i), "DEAD ? WTF ?")
-        cycle
-      endif
-      rval = distance_of_bloubs(les_bloubs(i), bloub)
-      if (rval .LT. (les_bloubs(i)%radius + bloub%radius)) then
-        print *, "contact : ", i, idx, rval
-        call merge_two_bloubs(les_bloubs(i), bloub, newbloub)
-        les_bloubs(i)%alive = .FALSE.
-        nbr_merge = nbr_merge + 1
-        merged = .TRUE.
-      endif
-    enddo
-
-    if (merged) then
-      les_bloubs(idx) = newbloub
-      bloub = newbloub
-    else
-      ! put old bloub in the list
-      les_bloubs(idx) = bloub
-    endif
-
-    write(outu, iostat=errcode) bloub
-    if (0 .ne. errcode) then
-      STOP " : WRITE ERROR TO " // trim(outfile)
-    endif
-
-    idx = idx + 1
-
-    ! print *, "idx = ", idx
-
-  enddo              ! end of infinit... WHAT?
-
-! --------------- is the job done ?
-
-  close(inu)    ;    close(outu)
-
-  write(0, '()')
-  write(0, '(I5, A)') nbr_merge, " merges"
-  write(0, '(A)') "--- mergebloubs . . . . . . .  [done]"
-
-! --------------------------------------------------------------
 contains
 
   subroutine merge_two_bloubs(bla, blb, blr)
+      implicit none
       type(t_bloubs), intent(in)   :: bla, blb
       type(t_bloubs), intent(out)  :: blr
 
-      blr%nick     = "newbie  "
+      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
@@ -158,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.718
+      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"
@@ -24,7 +22,9 @@ program movebloubs
   call getarg(2, outfile)
 
   write (0, '(A)') &
-  "*** moving bloubs from "//trim(infile)//" to "//trim(outfile)
+  "### moving bloubs from "//trim(infile)//" to "//trim(outfile)
+
+  call init_random_seed()
 
   open(newunit=inu,                                          &
                   file=trim(infile), form='unformatted',     &
@@ -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
@@ -57,78 +60,77 @@ program movebloubs
 
     ! moving, morphing and boundingboxing
     call move_bloub     (bloub, 0.185)
-    call bound_a_blob  (bloub)
-    if (bloub%radius .GT. 0.0155) then
-      bloub%radius = bloub%radius * 0.9970
+    call bound_a_bloub  (bloub)
+    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
-      ! cycle   ! ???
-    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)
     by = by + dble(bloub%py)
     bz = bz + dble(bloub%pz)
 
-    write(outu, iostat=errcode) bloub     ! no error control ?
+    if (bloub%alive) then
+      write(outu, iostat=errcode) bloub   
       if (0 .ne. errcode) then
         STOP " : WRITE ERROR TO " // trim(outfile)
       endif
       compteur = compteur + 1
+    endif
 
   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, 5, 0.1333)
+  if (compteur .LT. 50) then
+    call add_more_bloubs(outu, 5, 0.046)
   endif
 
-  ! insert some very fancy conditional here
-  if (compteur .LT. 3000) then
   rnd = rand()
-    write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd
-    if (rnd .LT. 0.0455) then
-      call add_more_bloubs(outu, 24, 0.0999)
-    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(), 9)
-  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="RosyBrown"
+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,48 +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 24			\
+			-pointsize 32			\
 			-fill "$TXTCOLOR"		\
 			-gravity south-east		\
 			-annotate +25+5 "$td"		\
 			-gravity south-west		\
 			-annotate +25+5 "$hi"		\
-			-pointsize 48			\
 			-gravity north-east		\
-			-annotate +25+5 "$count"	\
+			-annotate +45+5 "$count"	\
 			-gravity north-west		\
-			-annotate +25+5 "BloubWorld"	\
+			-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
+	./mergebloubs ${BLBS_OUT} ${BLBS_IN}
+	# mv ${BLBS_OUT} ${BLBS_IN}
+
+	echo "### run done"
+	sleep 35
 
 done
 

BloubWorld/scene.pov

@@ -11,8 +11,6 @@ global_settings {
 
 #include  "colors.inc"
 
-
-
 #include  "WS/nbimg.inc"
 
 #declare NormClock = clock / NbImg;
@@ -28,61 +26,115 @@ global_settings {
 
 object	{
 	Bloubs
-	finish { phong 0.55 specular 0.55 }
+	finish { phong 0.57 specular 0.57 }
 	}
 
-object {
+#declare La_Boite = object
+{
 union {
-		plane	{ <1, 0, 0>, -32 	}
-		plane	{ <1, 0, 0>,  32	}
-		plane	{ <0, 1, 0>, -24	}
-		plane	{ <0, 1, 0>,  24	}
-		plane	{ <0, 0, 1>,  50 	}
-
+	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>
+  }
+
 //  ----------------------------------------------------------
 
-#declare BH = 5;		// H = taille en horizontal
-#declare BV = 5;		// V = taille en vertical
-#declare BR = 0.032;
+#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 = 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.012, 0>, <0, -0.012, 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.002;
+	#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, -17> color Gray80 }
-light_source { <11,  14,   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 + (0.75 * NormClock);
-#declare ZCAM = -17.5;
+#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		66
+	angle		64
 	}

BloubWorld/toinc.awk

@@ -1,4 +1,6 @@
 
+#
+#    Input for this script is generated by 'exportbloubs.f90'
 #
 #            this code is (C) 2022 tTh
 #
@@ -7,26 +9,42 @@ 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{"
 	}
 
 	{
 	age = $5
-	if (age < 2)		color = "Orange"
-	else if (age > 8)	color = "Gray70"
-	else			color = "Sienna"
+	merged = $6
+
+	color = "Cyan"
+	if (merged) {
+		if (age > 150)	color = "Orange"
+		else		color = "Yellow"
+		}
+	else	{
+		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,9 +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,34 +1,80 @@
 
-GFOPT  = -Wall -Wextra -time -g -Imods/
+all:	essai voxelize evolvopick pickover 	\
+	mkjulia mklorentz mkmandel
+
+GFOPT  = -Wall -Wextra -time -g -Imods/ -I../Modules
 
 # ---------------------------------------------
+# the module 'spitpgm' is now in $PROJECT/Modules
+#
 
-spitpgm.o:	spitpgm.f90 Makefile
-	gfortran $(GFOPT) -c $<
+mods/points3d.o:	mods/points3d.f90 Makefile
+	gfortran $(GFOPT) -c $< -o $@
+
+mods/xperiment.o:	mods/xperiment.f90 Makefile
+	gfortran $(GFOPT) -c $< -o $@
 
 fraktals.o:	fraktals.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-OBJS  = spitpgm.o fraktals.o 
-DOT_O = mods/points3d.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 
 
 # ---------------------------------------------
 
-julia:		julia.f90 Makefile $(OBJS)
+essai:		essai.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-pickover:	pickover.f90 Makefile $(OBJS)
+plotcolmap:	plotcolmap.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+# ---------------------------------------------
+
+mkjulia:	mkjulia.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+xjulia.pnm:	mkjulia Makefile
+	./mkjulia $@ -0.204365 0.321463
+
+# ---------------------------------------------
+
+henon:		henon.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+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 $@
 
-lorentz:	lorentz.f90 Makefile $(OBJS)
+voxelize:	voxelize.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+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
-	time ./pickover $@ > /dev/null
+	./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 XXX, et la gestion
-des pixels 'physiques' est fait dans YYY
+Le gros des calculs de fractales est fait dans `mods/fraktals.f90`,
+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
+- 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/WS/.gitignore

@@ -1 +1,4 @@
 *.inc
+*.err
+*.dat
+*.log

Fraktalism/common.sh

@@ -0,0 +1,4 @@
+
+
+POVOPT=" -d +q9 +a +W1920 +H1080 -v +WT4"
+

Fraktalism/encode.sh

@@ -0,0 +1,46 @@
+#!/bin/bash
+
+if [ $# -ne 2 ] ; then
+	echo
+	echo "need two arguments:"
+	echo "    source dir"
+	echo "    mp4 filename"
+	exit 1
+fi
+
+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 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

@@ -0,0 +1,36 @@
+!-----------------------------------------------------
+program essai
+
+  use spitpgm            ! XXX moved in ../Modules 
+  use fraktals
+  use points3d
+  use xperiment
+
+  implicit none
+
+  integer, dimension(:,:), allocatable    ::    picz
+  integer                                 ::    W, H, foo
+  integer                                 ::    errcode
+  character(200)                          ::    filename
+  real                                    ::    kx, ky
+
+  write(0, *) "============= essai =============="
+
+  W = 320     ;       H = 240
+
+  call srand(666)
+
+  allocate(picz(W,H), stat=errcode)
+
+  do foo=1, 360
+    write (filename, "(a, i5.5, a)") "frames/popcorn/", foo-1, ".pnm"
+    write(0, *) "-------->", trim(filename), "<"
+    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))
+  enddo
+
+!-----------------------------------------------------
+end program

Fraktalism/evolvopick.f90

@@ -0,0 +1,64 @@
+program evolvopick
+
+  use spitpgm
+  use points3d 
+  use fraktals
+
+!-----------------------------------------------------
+
+  implicit none
+
+  double precision, dimension(4)    ::  KA, KB, KI
+  integer                           ::  tick, nbsteps
+  double precision                  ::  dptick
+  type(t_point3d), dimension(:), allocatable ::  points
+  integer                                    ::  nbpoints
+  integer                                    ::  fd, errcode
+  character (len=200)                        ::  command
+
+  KA(1) = -1.42      ;     KA(2) =  1.62
+  KA(3) =  1.08      ;     KA(4) = -2.43
+
+  KB(1) =  1.51      ;     KB(2) = -1.89
+  KB(3) =  1.69      ;     KB(4) =  0.79
+
+  nbsteps  = 1800
+  nbpoints = 70000
+  allocate(points(nbpoints), stat=errcode)
+  if (0 .NE. errcode) then
+    STOP " : EVOLVOPICK, NO ENOUGH MEMORY"
+  endif
+
+  do tick = 0, nbsteps-1
+
+    dptick = DBLE(tick) / DBLE(nbsteps)
+    ! print *, tick, "      ", dptick
+    call interp4dp(KA, KB, KI, dptick)
+    ! print *, KI(1), KI(2), KI(3), KI(4)
+    write(0, '(1X, I8, 3X, 4F11.6)') tick, KI
+
+    !  mmmm, not optimal
+    open (newunit=fd, file='WS/k-pick.txt',            &
+          status='unknown', position='append',         &
+          action='write', iostat=errcode)
+    if (0 .NE. errcode) then
+      STOP ' : FUBAR ON OUTPUT FILE'
+    endif
+    write(fd, '(I5, 4X, 4F8.4)') tick, KI
+    close(fd)
+    !            
+
+    call compute_pickover(points, KI)
+    call write_points3d(points, 27, 69900, 'WS/pick.dat')
+
+    write(command, '(A, I6)') './tracepick.sh ', tick
+    call execute_command_line (command, exitstat=errcode)
+    if (0 .NE. errcode) then
+      STOP ' : ERR RUN TRACE COMMAND !'
+    endif
+
+  enddo
+
+!-----------------------------------------------------
+
+end program evolvopick

Fraktalism/fraktals.f90

@@ -1,98 +1,65 @@
 module fraktals
-
   use points3d
-
   implicit none
-!-----------------------------------------------------
-
-!-----------------------------------------------------
   contains
 
-!-----------------------------------------------------
-subroutine simple_julia(pic, cx, cy, maxiter)
+!===============================================================
+!	nouveau 28 mai 2022 (again) 
+! source:
+!    Fractal Creation with FRACTINT
+!
+subroutine parasites_0(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
+    real         ::  fx, fy, coef
+    logical      ::  burps
  
-    width  = ubound(pic, 1)
-    height = ubound(pic, 2)
-
-    C = complex(cx, cy)
-    print *, "Const = ", C
+    width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
+    coef   = float(maxiter) / 12.3456789
 
     do ix = 1, width
-      fx = (float(ix) / (float(width)/4.0) - 2.0)
+      fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
+      burps = (RAND() .lt. 0.01)
       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
+        fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
+        if (burps) then
+          pic(ix, iy) = mod(int(fx * fy * coef * 1.005), 250)
         else
-            pic(ix, iy) = iter
+          pic(ix, iy) = mod(int(fx * fy * coef), 250)
         endif
-
       enddo
     enddo
 
-end subroutine simple_julia
-!-----------------------------------------------------
-! 
+end subroutine parasites_0
+!===============================================================
+!-
 !  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 = 0.00 ; ya = 0.00 ; za = 0.0
 
+    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)
       zb = sin(xa)
-
       array(i)%x   = xb
       array(i)%y   = yb
       array(i)%z   = zb
       array(i)%seq = i
-
       xa = xb ; ya = yb ; za = zb 
-
-      ! print *, xb, yb, zb
-
     enddo
 
 end subroutine
-
 !-----------------------------------------------------
 ! 
 !  d'après les pages 91/92 du livre de Roger T Stevens
@@ -114,6 +81,9 @@ subroutine plot_pickover(pic, count)
       STOP " : NO ENOUGH MEMORY"
     endif
 
+    ! Clear the picture
+    pic = 0
+
     coefs(1) = 2.24     ;     coefs(2) = 0.43
     coefs(3) = -0.65    ;     coefs(4) = -2.43
     call compute_pickover(points, coefs)
@@ -122,18 +92,16 @@ subroutine plot_pickover(pic, count)
     h  = ubound(pic, 2)
 
     do i=1, ubound(points, 1)
-
-      px = (points(i)%x * (w/4.09)) + (w / 2)
-      py = (points(i)%y * (h/4.09)) + (h / 2)
-      pic(px, py) = 255               ! WARNING COREDUMP
-
+      px = int((points(i)%x * (w/4.09)) + (w / 2))
+      py = int((points(i)%y * (h/4.09)) + (h / 2))
+      pic(px, py) = 255               ! WARNING COREDUMP ?
     enddo
 
     deallocate(points)
 
 end subroutine plot_pickover
 
-!-----------------------------------------------------
+!===============================================================
 ! 
 !  d'après les pages NN/NN du livre de Roger T Stevens
 !       "Fractal programming in C"
@@ -147,16 +115,29 @@ subroutine lorentz_0(pic, count)
 ! XXX    double precision      :: ka, kb, kc, kd
 ! XXX    integer               :: i, w, h, px, py
 
-
+   write(0, *) "lorentz_0, picz  is ", ubound(pic)
+   write(0, *) "lorentz_0, count is ", count
 
 end subroutine lorentz_0
 
-!-----------------------------------------------------------
+!===============================================================
 !           -- some support functions --
 !-----------------------------------------------------------
+!       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
+    double precision, intent(in)                 :: dpk
+    integer                                      :: foo
 
+    do foo=1, 4
+      out(foo) = (ina(foo) * (1.0-dpk)) + (inb(foo) * (dpk))
+    enddo
 
+end subroutine
 !-----------------------------------------------------------
+!-
 
 function dist0 (x, y)
   implicit none
@@ -166,6 +147,8 @@ function dist0 (x, y)
 end function
 
 !-----------------------------------------------------------
+!-
+
 function modulus2(pt)
   implicit none
   complex, intent(in)    ::   pt
@@ -173,5 +156,4 @@ function modulus2(pt)
   modulus2 = real(pt)*real(pt) + imag(pt)*imag(pt)
 end
 !-----------------------------------------------------
-
 end module fraktals

Fraktalism/henon.f90

@@ -0,0 +1,45 @@
+module henon
+
+  implicit none
+  contains
+
+!-----------------------------------------------------
+
+subroutine compute_pixel_henon(a, b, maxpasse, passe, limit, rx, ry)
+  implicit none
+  double precision, intent(in)         :: a, b, limit
+  integer, intent(in)                  :: maxpasse
+  integer, intent(out)                 :: passe
+  double precision, intent(out)        :: rx, ry
+
+  double precision                     :: x, y, x2, y2
+
+  write(0, fmt="('compute pixel:', (2F8.3, I6, F8.3))")       &
+                              a, b, maxpasse, limit
+
+  x = 0.0
+  y = 0.0
+
+  do passe=1, maxpasse
+
+    x2 = 1d0 + y - (a * x * x)
+    y2 = b * x
+    x = x2
+    y = y2
+    write(0, fmt="(i4, 2F8.3)") passe, x, y
+    if (x .lt. -limit) exit
+    if (x .gt.  limit) exit
+    if (y .lt. -limit) exit
+    if (y .gt.  limit) exit
+
+  enddo
+
+  rx = x
+  ry = y
+
+end subroutine
+
+!-----------------------------------------------------
+
+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/map_henon.f

@@ -0,0 +1,149 @@
+c----------------------------------------------------------------
+c           *****************************************
+c           *   THIS FILE IS ARCHIVED FOR HISTORY   *
+c           *      DON'T TRY TO USE IT AT HOME      *
+c           *****************************************
+c----------------------------------------------------------------
+
+c       	mapping of the Henon Diagram
+c       a escape time fractal from 'Oulala Software'
+c       http://www.chez.com/oulala/g77/map_henon.html
+c
+c----------------------------------------------------------------
+        program	map_henon
+c
+c       control the image dimension
+c
+      integer		w, h
+      parameter	(w=2000, h=1600)
+
+c       maximum number of iterations by pixel
+c       around 5000 seems a good value
+c
+      integer  maxpasse
+      parameter (maxpasse=17000)
+
+      double precision amp, limite
+      parameter  (amp=1.42d0, limite=4.0d9)
+
+c	control the position of the view window
+c
+      double precision a, b
+      parameter  (a=0.65d0, b=0.15d0)
+
+      integer 	x, y, image, passe
+      integer 	masque, flag
+      integer 	valr, valg, valb
+      integer 	in, out
+      double precision dx, dy, rx, ry
+      double precision minrx, minry, maxrx, maxry
+      real 	temps
+
+      integer IMG_CREATE
+c	---------------------------------------------------------
+
+      image = IMG_CREATE(w, h, 3)
+      masque = IMG_CREATE(w, h, 3)
+
+      in = 0
+      out = 0
+      minrx = -9d99
+      minry = -9d99
+      maxrx =  9d99
+      maxry =  9d99
+
+      do 5 x=0, w-1
+          dx = (a-amp) + (amp*2/(w-1)*x)
+          do 4 y=0, h-1
+              dy = (b-amp) + (amp*2/(h-1)*y)
+
+             call henon(dx, dy, maxpasse, passe, limite, rx, ry)
+
+       if (passe .gt. maxpasse) then
+           in = in + 1
+           valr = 128
+           valg = abs(int(rx*1d2))
+           valb = abs(int(ry*1d2))
+           flag = 0
+       else
+           out = out + 1
+           if (passe .le. 2) then
+        valr = 0
+        valg = 80 * passe
+        valb = 10
+               flag = 255
+           else
+            valg = (passe*255)/maxpasse
+            valr = mod(passe,255)
+            valb = (255-((passe*255)/maxpasse))/3
+               flag = 128
+           endif
+       endif
+
+C	        write(6,101) x, y, dx, dy, passe, valr, valg, valb, rx, ry
+
+          	call IMG_PLOT(image, x, y, valr, valg, valb)
+          	call IMG_PLOT(masque, x, y, flag, flag, flag)
+
+4	    continue
+      write(6,107) x, w, in, out
+5	continue
+
+c
+c	Here, you can change the name of the saved TGA file.
+c	Just modify the second parameter...
+c
+      call IMG_TGA_SA(image, "map_henon.tga", 0)
+      call IMG_TGA_SA(masque, "msq_henon.tga", 0)
+
+      temps = second() / 60.0
+      write(6,120) temps
+
+101   format(2i4, 2(2x,f9.5), i7, 3(i4), 2(2x,f9.5))
+107   format(i5, ' / ', i5, 5x, 2(i12) )
+120   format('total time: ', f8.2, ' minutes')
+
+      end
+c----------------------------------------------------------------
+c	this subroutine do the iterations
+c   in pars:	a
+c		b
+c		maxpasse
+c		limit
+c   out pars:	passe
+c		rx
+c		ry
+c
+
+      subroutine henon(a, b, maxpasse, passe, limit, rx, ry)
+      double precision a, b, limit
+      integer maxpasse, passe
+      double precision rx, ry
+      
+      double precision x, x2, y, y2
+
+      x = 0
+      y = 0
+
+      do 5 passe=1, maxpasse
+
+          x2 = 1d0 + y - a * x * x
+          y2 = b * x
+          x = x2
+          y = y2
+
+          if (x .lt. -limit) goto 8
+          if (x .gt.  limit) goto 8
+          if (y .lt. -limit) goto 8
+          if (y .gt.  limit) goto 8
+
+5     continue
+
+8     continue
+
+      rx = x
+      ry = y
+
+      end
+
+c----------------------------------------------------------------

Fraktalism/mkhenon.f90

@@ -1,32 +1,27 @@
-! 
-!    this is the main programm
-! 
-!-----------------------------------------------------
+program henon
 
-program julia
-
-    use spitpgm
-    use fraktals
+    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 ": MKHENON 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, 250)
-    call spit_as_pgm_8(picz, trim(filename))
+    allocate(picz(1280, 1024))
 
-end program
+    call rgbpix_spit_as_pnm_8(picz, trim(filename))
 
 !-----------------------------------------------------
+
+end program

Fraktalism/mkjulia.f90

@@ -0,0 +1,40 @@
+!-----------------------------------------------------
+!           JULIA
+!           =====
+!    this is the main program
+!-----------------------------------------------------
+
+program julia
+
+    use spitpgm
+    use JULIAS
+    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 ": MKJULIA 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 julia_colormapped(picz, cx, cy, 0.600, 1000)
+    call rgbpix_spit_as_pnm_8(picz, trim(filename))
+
+  contains
+
+!-----------------------------------------------------
+
+end program
+
+!-----------------------------------------------------

Fraktalism/mkjuliagif.sh

@@ -3,30 +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 39)
+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/%05d.pgm" $foo)
-	bar=$(echo "$foo / 247.0"      | bc -l)
-	cx=$(echo "0.4 * c($foo)"     | bc -l)
-	cy=$(echo "0.4 * 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/*.pgm 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/mkvoxvidz.sh

@@ -0,0 +1,64 @@
+#!/bin/bash
+
+echo
+source "./common.sh"
+
+make voxelize
+if [ $? -ne 0 ] ; then
+	echo
+	echo "Make error " $?
+	exit 1
+fi
+
+
+TMPNG="/dev/shm/voxvidz.png"
+NBIMG=1600
+
+printf "#declare NbImg = %d;\n" $NBIMG | tee WS/nbimg.inc
+
+for idx in $( seq   0 $(( NBIMG - 1)) )
+do
+
+	dst=$(printf "frames/voxel/%05d.png" $idx)
+	delta=$( echo "scale=6 ; ${idx}/${NBIMG}" | bc -l)
+	echo "Renderbox work on "$dst"     delta = "  $delta
+
+	./voxelize "WS/voxels.inc" $delta
+	grep 'NbrVox' "WS/voxels.inc"
+
+	povray		-ishowvoxels.pov -K$idx ${POVOPT}	\
+			-O${TMPNG} 2> WS/toto.err
+	if [ $? -ne 0 ] ; then
+		echo "ERROR ERROR ERROR ERROR ERROR ERROR"
+		tail -15 WS/toto.err
+		sleep 20
+		#exit 1
+	fi
+
+	titre='Voxelisation - tTh - Avril 2022'
+	numbers=$(tail -1 WS/camvox.log |			\
+		  awk '{printf "  K=%5d  :  %6.3f   %6.3f   %6.3f",	\
+					$1, $2, $3, $4}')
+
+	echo "numbers " "$numbers" "     txtidx " $txtidx
+
+	convert		${TMPNG}			\
+			-fill  Orange			\
+			-kerning 2			\
+			-pointsize 32			\
+			-font AvantGarde-Book		\
+			-gravity South-West		\
+			-annotate +20+45 "$titre"	\
+			-pointsize 24			\
+			-annotate +20+10 "$numbers"	\
+							\
+			$dst
+
+	grep 'Parse Time' WS/toto.err
+	grep 'Trace Time' WS/toto.err
+
+	echo 
+
+done
+
+./encode.sh frames/voxel/ voxel-3.mp4

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,9 +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
 
-.pgm
+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/points3d.f90

@@ -10,24 +10,52 @@ module points3d
 !-----------------------------------------------------
   contains
 
+!-----------------------------------------------------
 
 subroutine list_points3d(array, start, length)
     type(t_point3d), dimension(:), intent(in)  :: array
     integer, intent(in)                        :: start, length
-    integer                                    :: sz, i
+    integer                                    :: sz, i, j
 
+    write(0, '(1X, A15, 2I9)') "list pt3d ", start, length
     sz = ubound(array, 1)
     if ((start+length) .GT. sz) then
-      STOP ' : OUT OF BOUND'
+      STOP ' : LIST P3D, OUT OF BOUND'
     endif
 
-    ! send oi to stdout.
-    do i = start, start+length-1
-       print *, array(i)%x, array(i)%y, array(i)%z, array(i)%seq
+    ! send values to stdout.
+    do i = 1, length
+       j = i + start
+       print *, array(j)%x, array(j)%y, array(j)%z, array(j)%seq
     enddo
 
 end subroutine list_points3d
 
 !-----------------------------------------------------
 
+subroutine write_points3d(array, start, length, fname)
+    type(t_point3d), dimension(:), intent(in)  :: array
+    integer, intent(in)                        :: start, length
+    character(*), intent(in)                   :: fname
+
+    integer                                    :: sz, i, j, io
+
+    ! write(0, '(1X, A15, 2I9)') "write pt3d ", start, length
+    sz = ubound(array, 1)
+    if ((start+length) .GT. sz) then
+      STOP ' : WRITE P3D, OUT OF BOUND'
+    endif
+
+    open(newunit=io, file=fname)
+    do i = 1, length
+       j = i + start
+       write(io, '(3F12.6, I8)')           &
+             array(j)%x, array(j)%y, array(j)%z, array(j)%seq
+    enddo
+    close(io)
+
+end subroutine write_points3d
+
+!-----------------------------------------------------
+
 end module points3d

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

@@ -0,0 +1,55 @@
+module xperiment
+
+  implicit none
+  contains
+
+!===============================================================
+! nouveau 24 mai 2022
+
+subroutine parasites_1(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, 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)
+    do ix = 1, width
+      fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
+      burps = (RAND() .lt. 0.01)
+      do iy = 1, height
+        fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
+        if (burps) then
+          pic(ix, iy) = int(fx * fy * coef * 1.005)
+        else
+          pic(ix, iy) = int(fx * fy * coef)
+        endif
+      enddo
+    enddo
+end subroutine parasites_1
+
+!---------------------------------------------------------------
+!
+!    aucune idee de l'utilisation de ce truc !
+!
+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_1
+
+!===============================================================
+end module xperiment

Fraktalism/pick3d.pov

@@ -24,11 +24,12 @@ union {
 
 // --------------------------------------------------------------
 
-#declare TS = 0.017;
+#declare TS = 0.025;
 
 #declare Truc = object
 {
-box { <-TS, -TS, -TS>, <TS, TS, TS> }
+// box { <-TS, -TS, -TS>, <TS, TS, TS> }
+sphere { <0, 0, 0>, TS*0.83 }
 }
 
 #include  "WS/pickover.inc"
@@ -57,7 +58,7 @@ object {
 plane   {
         <0, 1, 0>, 0
         texture {
-                pigment { color srgb <0.133, 0.155, 0.111> } 
+                pigment { color srgb <0.233, 0.155, 0.191> } 
                 finish { phong 0.18 metallic 0.55 }
                 }
         }
@@ -65,18 +66,18 @@ plane   {
 
 //  ----------------------------------------------------------
 
-light_source { <-12, 17, -11> color Gray90 }
-light_source { <-11, 11,   9> color Gray60 }
+light_source { <-12, 15, -11> color Gray90 }
+light_source { < 11, 11,  13> color Gray60 }
 
-#declare XCAM =  -3.8;
+#declare XCAM =  -3.1;
 #declare YCAM =   3;
-#declare ZCAM =   2.1;
+#declare ZCAM =   1.9;
 
 camera  {
         location   	<XCAM, YCAM, ZCAM>
         look_at    	<0,    2.09,   0>
         right           x*image_width/image_height
-        angle           92
+        angle           82
         }
 //  ----------------------------------------------------------
 

Fraktalism/pick3d.sh

@@ -1,12 +1,20 @@
 #!/bin/bash
 
-POVOPT=" -d +q9 +a +W1920 +H1080 -v +WT4"
-PASS=600
+POVOPT=" -d +q9 +a +W1280 +H1024 -v +WT2"
+PASS=999
 ERR="/tmp/pov.error"
 POVINC="WS/pickover.inc"
+TMPF="/dev/shm/pickover.png"
+
+make pickover
+if [ $? -ne 0 ] ; then
+	echo
+	echo "Make error " $?
+	exit 1
+fi
 
 ./pickover foo.pgm | awk -f pick2pov.awk > $POVINC
-head $POVINC
+# head $POVINC
 
 for pass in $(seq 0 $(( PASS-1 )) )
 do
@@ -16,18 +24,24 @@ do
 
 	povray -ipick3d.pov -K${pass}			\
 			Declare=NBPASS=${PASS}		\
-			$POVOPT -O${dstname} 2> $ERR
+			$POVOPT -O${TMPF} 2> $ERR
 	if [ $? -ne 0 ]
 	then
-		tail $ERR
+		tail -20 $ERR
 		exit
 	fi
 
-	sleep  16
+	convert		${TMPF}			\
+			-fill  Gray50		\
+			-gravity South-West	\
+			-pointsize 24		\
+			-annotate +20+10 "tTh"	\
+			$dstname
+
+	sleep  10
 
 done
 
-
 ffmpeg  -nostdin                                        	\
         -loglevel warning                               	\
         -y -r 25 -f image2 -i frames/pick3d/%05d.png            \

Fraktalism/pickover.f90

@@ -37,7 +37,7 @@ program pickover
     coefs(3) = -0.65     ;     coefs(4) = -2.43
 
     call compute_pickover(points, coefs)
-    call list_points3d(points, 2, 42000)
+    call list_points3d(points, 200, 15000)
 
 end program
 

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/showvoxels.pov

@@ -0,0 +1,100 @@
+/*
+ *		SHOW VOXELS
+ *
+ *  see also : vox2inc.awk and voxelize.f90
+ */
+
+#version 3.7;
+
+global_settings {
+                ambient_light rgb <0.04, 0.04, 0.04>
+                assumed_gamma 1.0
+                }
+//----------------------------------------------------------------
+
+#include  "colors.inc"
+
+#declare VOXEL = object
+{
+// sphere { 0, 1.18 }
+#local D = 2.11;
+box { <-D, -D, -D>, <D, D, D> }
+}
+
+#include "WS/voxels.inc"
+object {
+	Voxels
+	texture {
+		pigment { color White }
+		finish { phong 0.6 specular 0.8 }
+		}
+	/*
+	 * un peu de calcul empirique ?
+	 */
+	#local TRK = DIMC/2.0000000;
+	translate <-TRK, -TRK, -TRK>
+	// rotate <clock*0.22, 0, clock*0.17>
+	}
+
+//----------------------------------------------------------------
+#declare TriAxe = object
+{
+#local Sz = 300;
+#local Ra = 0.20;
+union	{
+	cylinder { <-Sz, 0, 0>, <Sz, 0, 0>, Ra pigment { color Red }    }
+	cylinder { <0, -Sz, 0>, <0, Sz, 0>, Ra pigment { color Green }  }
+	cylinder { <0, 0, -Sz>, <0, 0, Sz>, Ra pigment { color Blue }   }
+	}
+finish { phong 0.6 specular 0.8 }
+}
+
+object { TriAxe }
+
+plane   {
+        <0, 1, 0>, -120
+        texture {
+                pigment { color srgb <0.203, 0.185, 0.191> } 
+                finish { phong 0.18 metallic 0.55 }
+                }
+        }
+
+light_source { <-29,  45, -27> color Gray70 }
+light_source { <-52,  5, -48>   color Yellow*0.45 	}
+light_source { < 59,  45,  48>   color Gray20		}
+light_source { < 59, -45,  48>   color Gray20		}
+light_source { <  9,  59,  18>   color Red*0.65 		}
+light_source { <  8,  -48,  3>   color Green*0.75 	}
+
+#include "WS/nbimg.inc"
+#declare NormClock = (clock/NbImg);
+
+#declare ECAM    =  210 - (100*NormClock);
+#declare CKsmall =  NormClock * 87.20;
+#declare Offset  =  0.10;
+#declare XCAM  =  ECAM * (sin(radians(CKsmall)) + Offset);
+#declare YCAM  =  18;
+#declare ZCAM  =  ECAM * (cos(radians(CKsmall)) + Offset);
+#declare ACAM  =  65 + (53*NormClock);
+
+// #declare XCAM = ECAM * 0.8;
+// #declare ZCAM = ECAM * 0.35;
+
+#if (0 = clock)
+  #fopen CL "WS/camvox.log" write
+#else 
+  #fopen CL "WS/camvox.log" append
+#end
+#write (CL, clock, " ", NormClock, " ", ECAM, " ", ACAM, "\n")
+#fclose CL
+
+camera  {
+	location   	<XCAM, YCAM, ZCAM>
+	// look_at    	<Bary_X, Bary_Y, Bary_Z>
+	look_at		<0, -1, 0>
+        right           x*image_width/image_height
+        angle           ACAM
+        }
+
+//----------------------------------------------------------------
+//----------------------------------------------------------------

Fraktalism/spitpgm.f90

@@ -1,73 +0,0 @@
-module spitpgm
-
-    implicit none
-
-    contains
-
-!-----------------------------------------------------
-
-subroutine spit_as_pgm(pic, fname)
-
-    integer, intent(in), dimension (:,:)  ::  pic
-    character (len=*), intent(in)         ::  fname
-
-    integer   :: io, foo
-    integer   :: ix, iy
-    real      :: fk, fpix
-
-    write(0, '(1X, A)') "> spit_as_pgm to " // trim(fname)
-
-    open(newunit=io, file=fname)
-    write (io, '(a2)') "P2"
-    write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
-    write (io, '(i0)') 65535
-
-    foo = MAXVAL(pic)
-    if (foo .EQ. 0) then
-        print *, " IS SOMETHING WRONG GOING TO HAPPEN ?"
-        do ix = 1, size(pic)
-            write (io, "(i0)") 0
-        enddo
-    else
-        fk = float(foo)  / 65535.0
-        print *, "  max pix value", foo, "  fk =  ", fk
-        do iy = 1, ubound(pic, 2)
-            do ix = 1, ubound(pic, 1)
-                 fpix = float(pic(ix, iy)) / fk
-                 write (io, "(i0)") int(fpix)
-            end do
-        end do
-    endif
-    close(io)
-
-end subroutine
-!-----------------------------------------------------
-subroutine spit_as_pgm_8(pic, fname)
-
-    integer, intent(in), dimension (:,:)  ::  pic
-    character (len=*), intent(in)         ::  fname
-
-    integer   :: io, foo
-    integer   :: ix, iy
-
-    ! XXX print *, "> spit_as_pgm_8 to ", fname
-    foo = MAXVAL(pic)
-    ! XXX print *, "      max = ", foo
-    open(newunit=io, file=fname)
-    write (io, '(a2)') "P2"
-    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)
-        foo = pic(ix, iy)
-        if (foo .GT. 255)  foo = 255
-        write(io, "(i3)") foo
-      enddo
-    enddo
-    close(io)
-
-end subroutine
-!-----------------------------------------------------
-
-end module spitpgm

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

Fraktalism/tracepick.sh

@@ -0,0 +1,36 @@
+#!/bin/bash
+
+POVOPT=" -d +q9 +a +W1280 +H1024 -v +WT4"
+TMPNG="/dev/shm/evolv.png"
+
+outfile=$(printf "frames/pick3d/%05d.png" $1)
+# echo $outfile
+
+awk -f pick2pov.awk < WS/pick.dat > WS/pickover.inc
+
+PASS=2222
+
+povray		-ipick3d.pov -K120 ${POVOPT}	\
+		Declare=NBPASS=${PASS}		\
+		-O${TMPNG} 2> WS/err-tracepick.txt
+
+title="Clifford Pickover strange attractor"
+tdate=$(date +'%F %R:%S')
+# echo $tdate
+coefs=$(tail -1 WS/k-pick.txt)
+# echo $coefs
+txt=$(printf '%s  %s' "$tdate" "$coefs")
+
+convert		${TMPNG}			\
+		-fill  Orange			\
+		-font Courier-Bold		\
+		-pointsize 32			\
+		-gravity North-West		\
+		-annotate +30+30 "${title}"	\
+		-pointsize 22			\
+		-gravity South-West		\
+		-annotate +30+30 "${txt}"	\
+		$outfile
+
+sleep 2
+

Fraktalism/vox2inc.awk

@@ -0,0 +1,32 @@
+#!/usr/bin/awk -f
+
+BEGIN	{
+	maxcount = 0
+	nbrvox = 0
+	bx = by = bz = 0.0
+	print "// generated file, don't touch it bastard !"
+	print "#declare Voxels = object {"
+	print "union {"
+	}
+
+$4 > 500 {
+	count = $4
+	value = $5
+	if (count > maxcount) 
+		{ maxcount = count }
+	nbrvox++;
+	bx += $1
+	by += $2
+	bz += $3
+	printf "object { VOXEL scale %f translate <%f, %f, %f> }    // %d \n",	\
+					value, $1, $2, $3, count
+	}
+
+END	{
+	print "} } // done, ",     NR, " records read"
+	print "#declare VoxMaxcount = ", maxcount, ";"
+	print "#declare NbrVox   = ",   nbrvox, ";"
+	print "#declare Bary_X   = ", bx/nbrvox, ";"
+	print "#declare Bary_Y   = ", by/nbrvox, ";"
+	print "#declare Bary_Z   = ", bz/nbrvox, ";"
+	}

Fraktalism/voxelize.f90

@@ -0,0 +1,203 @@
+!-----------------------------------------------------
+!           VOXELIZE
+!           ========
+!    this is the main program, see also mkvoxvidz.sh
+!    showvoxels.pov and vox2inc.awk
+!-----------------------------------------------------
+program voxelize
+  use fraktals
+
+  implicit none
+
+  integer, parameter                          :: DIMC = 320
+  integer, dimension(:,:,:), allocatable      :: cube
+  type(t_point3d), dimension(:), allocatable  :: points
+  integer                                     :: errcode, foo, argc
+  integer                                     :: ix, iy, iz
+  integer                                     :: nbr_points, maxcube
+  double precision, dimension(4)              :: KA, KB, KM
+  double precision                            :: dmaxcube, delta
+  character(200)                              :: filename, string
+
+  write(0, *) "--- start of voxelize"
+
+  argc = IARGC()
+  if (2 .NE. argc) then
+    STOP ": VOXELIZE NEED PARAMETERS !"
+  endif
+
+  call getarg(1, filename)
+  call getarg(2, string)       ;   read (string, *) delta
+  write(0, "( ' --- delta = ', F11.6)") delta
+
+  allocate (cube(DIMC,DIMC,DIMC), stat=errcode)
+  if (0 .NE. errcode) then
+    STOP " : NO ENOUGH MEMORY FOR CUBE"
+  endif
+
+  nbr_points = 9000000
+  allocate(points(nbr_points), stat=errcode)
+  if (0 .NE. errcode) then
+    STOP " : NO ENOUGH MEMORY FOR POINTS"
+  endif
+
+  KA(1) =  -1.3402     ;     KA(2) =   1.5245
+  KA(3) =   1.0966     ;     KA(4) =  -2.3423
+  KB(1) =  -1.2100     ;     KB(2) =   1.3685
+  KB(3) =   1.3237     ;     KB(4) =  -2.3992
+  call interp4dp(KA, KB, KM, delta)
+  write(0, "(' --- coefs = ', 4F11.6)") KM
+  call compute_pickover(points, KM)
+  call clear_cube(cube)
+  ! 
+  ! and now, we loop over all the pre-computed
+  ! points of the attractor
+  ! 
+  do foo=1, nbr_points
+    call fcoor2icoor(points(foo)%x, ix)
+    call fcoor2icoor(points(foo)%y, iy)
+    call fcoor2icoor(points(foo)%z, iz)
+    cube(ix,iy,iz) = cube(ix,iy,iz) + 1
+  enddo
+
+  maxcube = MAXVAL(cube)
+  dmaxcube = DBLE(maxcube)
+  write(0, *) "--- maxval(cube) = ", maxcube
+
+  call spit_cube_as_union(filename,   cube,       &
+                          maxcube/2000, dble(9000.00))
+
+  write(0, *) "--- end of voxelize"
+
+!-----------------------------------------------------
+contains
+!-----------------------------------------------------
+  ! or maybe, we can write a function ?
+subroutine fcoor2icoor(in, out)
+  double precision, intent(in)       :: in
+  integer, intent(out)               :: out
+  double precision                   :: invalue
+  integer                            :: outvalue
+
+  invalue = (in + 2.0) / 2.0
+  outvalue = int(invalue * real(DIMC/2))
+
+  ! add molly-guard here
+  out = outvalue
+  if (outvalue .LT. 1)      out = 1
+  if (outvalue .GE. DIMC)    out = DIMC-1
+
+end subroutine
+!------------------------------------------------------------
+!           USELESS USE OF LOOPS !
+
+subroutine clear_cube(cube)
+  type(integer), dimension(:,:,:), intent(out)  :: cube
+
+  integer        :: i, j, k
+
+  do i=lbound(cube, 1), ubound(cube, 1)
+    do j=lbound(cube, 2), ubound(cube, 2)
+      do k=lbound(cube, 3), ubound(cube, 3)
+        cube(i, j, k) = 0
+      enddo
+    enddo
+  enddo
+
+end subroutine
+!------------------------------------------------------------
+subroutine print_cube(cube, points, scaling)
+  type(integer), dimension(:,:,:), intent(in)  :: cube
+  type(t_point3d), dimension(:), intent(in)    :: points
+  double precision, intent(in)                 :: scaling
+
+  integer                     :: foo
+
+  do foo=1, nbr_points
+    call fcoor2icoor(points(foo)%x, ix)
+    call fcoor2icoor(points(foo)%y, iy)
+    call fcoor2icoor(points(foo)%z, iz)
+    print *, ix, iy, iz,                   &
+             cube(ix,iy,iz),               &
+             DBLE(cube(ix,iy,iz)) / scaling
+  enddo
+
+end subroutine
+
+!------------------------------------------------------------
+!           generation Povray STL source file !
+
+subroutine spit_cube_as_union(fname, voxels, limit, scaling)
+  character(*), intent(in)                     :: fname
+  type(integer), dimension(:,:,:), intent(in)  :: voxels
+  integer, intent(in)                          :: limit
+  double precision, intent(in)                 :: scaling
+
+  integer             :: fd, errcode
+  integer             :: ix, iy, iz, maxv
+  integer             :: nbrvox = 0
+  double precision    :: bx, by, bz, valeur
+  character(200)      :: chaine
+
+  !   molly-guard
+  maxv = limit
+  if (maxv .LT. 2)   maxv = 2
+
+  open (newunit=fd, file=trim(fname),           &
+        status='replace',                       &
+        action='write', iostat=errcode)
+  if (0 .NE. errcode) then
+    STOP ' : SPIT UNION, FAIL OPEN OUTPUT FILE'
+  endif
+
+  write(fd, *) "// generated file, don't touch it bastard !"
+  write(fd, *) "// version 2.09"
+  write(fd, *) "#declare DIMC = ", DIMC, ";"
+  write(fd, *) "#declare Voxels = object {"
+  write(fd, *) "union {"
+
+  bx = 0.0   ;   by = 0.0   ;   bz = 0.0
+
+  do ix=lbound(voxels,1), ubound(voxels,1)
+    do iy=lbound(voxels,2), ubound(voxels,2)
+      do iz=lbound(voxels,3), ubound(voxels,3)
+
+        if (cube(ix,iy,iz) .LT. maxv) then
+          ! print *, "foo = ", foo, cube(ix,iy,iz)
+          cycle                                   ! REDO FROM START
+        endif
+
+        nbrvox  = nbrvox + 1
+        bx = bx + dble(ix)
+        by = by + dble(iy)
+        bz = bz + dble(iz)
+        valeur = DBLE(cube(ix,iy,iz)) / scaling
+        ! XXX
+        if (valeur .GT. 1.5) then
+          valeur = 1.5
+        endif
+
+        write(chaine, "( 'translate <', I4, ',', I4, ',', I4, '> ' )")   &
+                            ix, iy, iz
+        write(unit=fd,                                                   &
+              fmt="( 'object { VOXEL scale ', F11.6, 1X, A, ' }'  )",    &
+              iostat=errcode)                                            &
+              valeur, trim(chaine)
+      enddo
+    enddo
+  enddo
+
+  write(fd, *) "} }"
+  write(fd, *) "// limit = ", limit
+  write(fd, "( '#declare NbrVox = ', I9,    ';' )")   nbrvox
+  write(fd, "( '#declare Bary_X = ', F11.6, ';' )")   bx / dble(nbrvox)
+  write(fd, "( '#declare Bary_Y = ', F11.6, ';' )")   by / dble(nbrvox)
+  write(fd, "( '#declare Bary_Z = ', F11.6, ';' )")   bz / dble(nbrvox)
+
+  close(fd)
+
+end subroutine
+!-----------------------------------------------------
+end program voxelize
+!-----------------------------------------------------
+

GrafAnim/.gitignore

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

GrafAnim/F/README.md

@@ -0,0 +1,3 @@
+
+# This is juste a workspace
+

GrafAnim/Makefile

@@ -0,0 +1,49 @@
+#
+# Fortraneries by tTh - Graf Anim
+#
+
+GFOPT = -Wall -Wextra -g -time  -I../Modules
+MYLIB = '../Modules/libtth90modules.a'
+
+# ---- programmes
+
+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

@@ -0,0 +1,36 @@
+# GrafAnim
+
+Quelques essais approximatifs pour faire des graphiques inutiles,
+dans une démarche mettant en avant la
+[techno-futilité](https://wiki.interhacker.space/index.php?title=Techno-futilit%C3%A9),
+une notion bien définie par le collectif **Interhack**.
+
+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

@@ -0,0 +1,61 @@
+program doubledice
+  use usegenplot
+  use utils_ga
+
+  implicit none
+
+  integer                   :: nbarg, numframe
+  character(len=256)        :: arg
+  integer                   :: idx, foo, bar, xpos
+  integer                   :: buckets(12)
+
+  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

@@ -0,0 +1,99 @@
+program essai
+
+! *******************************************
+!      CE TRUC NE MARCHE PAS /O\
+! *******************************************
+
+  use pixrgb
+  implicit none
+
+  integer                   :: nbarg
+  integer                   :: param0 = 10
+  character(len=256)        :: arg
+
+  ! 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, *) param0
+  endif
+
+  allocate(pix(width, height))
+
+  do seqnum = 0, param0
+    nclock = float(seqnum) / float(param0)
+    call rgbpix_set_to_rgb(pix, 0, 0, 0)
+
+    kx = nclock * 0.35 * sin(nclock * 7.0)
+    ky = nclock * 0.95 * cos(nclock * 7.0)
+    call iterator (pix, kx, ky, 50000)
+
+    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
+
+contains
+! ----------------------------------------------------------
+!-
+subroutine setpixel(pic, x, y)
+  implicit none
+  type(t_pixrgb), intent(inout)   :: pic(:,:)
+  real, intent(in)                :: x, y 
+
+  integer                         :: ix, iy
+
+  ix = 600 - int (300.0 * x)
+  iy = 600 - int (300.0 * y)
+
+  ! 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
+
+end program
+

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

@@ -0,0 +1,15 @@
+#!/bin/bash
+
+set -e
+
+make noisepic
+
+for foo in $(seq 0 89)
+do
+
+	./noisepic $foo
+
+done
+
+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

@@ -0,0 +1,123 @@
+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
+
+! -------------------------------------------------------------------
+
+subroutine do_initialise_once(motif)
+
+  character(*), intent(in)    :: motif
+
+  write(0, *)   '--> do initialise once "', motif, '", flag is ', initialised
+
+  call init_genplot('a.scratch')
+
+end subroutine
+
+! -------------------------------------------------------------------
+!-    getter, setter, wtf ?
+subroutine gplt_setcol(col)
+  integer, intent(in)           :: col
+  color = col
+end subroutine
+function   gplt_getcol()
+  integer gplt_getcol
+  gplt_getcol = color
+end function
+! -------------------------------------------------------------------
+
+subroutine gplt_move(x, y)
+  integer, intent(in)          :: x, y
+
+  if (.NOT. initialised) then
+    call do_initialise_once('in gplt_move')
+  endif
+  write(iochannel, '(3I8)') x, y, 0
+end subroutine
+
+! -------------------------------------------------------------------
+
+subroutine gplt_draw(x, y)
+  integer, intent(in)          :: x, y
+  if (.NOT. initialised) then
+    call do_initialise_once('in gplt_draw')
+  endif
+  write(iochannel, '(3I8)') x, y, color
+end subroutine
+
+! -------------------------------------------------------------------
+
+subroutine gplt_line(x1, y1, x2, y2)
+   integer, intent(in)           :: x1, y1, x2, y2
+   call gplt_move(x1, y1)
+   call gplt_draw(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)
+   call gplt_draw(x1, y2)
+   call gplt_draw(x1, y1)
+
+end subroutine
+
+! -------------------------------------------------------------------
+! -------------------------------------------------------------------
+
+end module
+

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

@@ -0,0 +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
+
+*.stderr
+
+foo.pgm
+bar.pgm
+planets.txt
+

GravityField/Makefile

@@ -0,0 +1,26 @@
+#
+#    Fortraneries by tTh - Gravity Field
+#
+
+GFOPT   = -Wall -Wextra -g -time -I../Modules
+MODOBJ  = ../Modules/spitpgm.o ../Modules/pixrgb.o
+
+all:	essai animation realdump2png
+
+# ----------- modules
+
+realfield.o:	realfield.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+# ----------- progs
+
+essai:	essai.f90  Makefile realfield.o
+	gfortran $(GFOPT) $< realfield.o $(MODOBJ) -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

@@ -0,0 +1,27 @@
+# Gravity Field Experiment
+
+_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/README.md

@@ -0,0 +1 @@
+# this is just a worspace

GravityField/animation.f90

@@ -0,0 +1,183 @@
+!-----------------------------------------------------------------------
+!-
+!       Project "gravity field" - Firts renderer
+!-
+!-----------------------------------------------------------------------
+program animation
+
+  use realfield
+
+  use spitpgm             ! extern module
+  use pixrgb              ! extern module
+              
+  implicit none
+
+  ! some configuration constants
+  integer, parameter      :: S_WIDTH  = 2048
+  integer, parameter      :: S_HEIGHT = 2048
+  integer, parameter      :: NB_BODY  = 250
+
+  !!! WARNING : global variable !!!
+  type(massbody)          :: planets(NB_BODY)
+
+  call init_random()
+  call create_some_planets(planets, 1664e3, S_WIDTH , S_HEIGHT)
+  call print_barycentre_bodies(planets, 'begin')
+
+  call la_grande_boucle(0, 2000, planets)
+
+  STOP ': YOLO TIME *NOW*'
+
+!-----------------------------------------------------------------------
+contains
+!-
+!         fabrication de la sequence complete
+!-
+subroutine la_grande_boucle(start, nbre, moons)
+  integer, intent(in)            :: start, nbre
+  type(massbody), intent(inout)  :: moons(:)
+
+  character(len=100)      :: filename
+  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, '(3I5, "    *  ", a20)') start, nbre, pass, filename
+    call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
+
+    ! save the current bodies positions (can be used in gnuplot)
+    ! write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
+    ! call save_bodies_to_txt_file (planets, filename)
+
+    write (filename, "(a, i5.5, a)") 'WS/colmap/', pass, '.pnm'
+    call make_color_map(planets, filename, S_WIDTH, S_HEIGHT)
+
+  enddo
+
+call print_barycentre_bodies(moons, 'end')
+
+end subroutine
+
+!-----------------------------------------------------------------------
+!-
+!      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, coef
+
+  integer, parameter      :: EE = 100
+  integer                 :: SW = S_WIDTH  - EE
+  integer                 :: SH = S_HEIGHT - EE
+
+  do foo=1, ubound(moons, 1)
+
+    ! print *, "----- deplace ",foo, "serial ", moons(foo)%serial
+    depx = moons(foo)%speed * sin(moons(foo)%heading)
+    depy = moons(foo)%speed * cos(moons(foo)%heading)
+    moons(foo)%posx = moons(foo)%posx + depx
+    moons(foo)%posy = moons(foo)%posy + depy
+
+    !-
+    !   ici se pose une question pertinente sur la gestion des
+    !   bords du chanmp. Clipping, Toring or Boucing ?
+    !-
+    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
+
+    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
+
+end subroutine
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
+end program
+
+
+

GravityField/encode.sh

@@ -0,0 +1,42 @@
+#!/bin/bash
+
+if [ $# -ne 2 ] ; then
+	echo
+	echo "need two arguments:"
+	echo "    1) source dir"
+	echo "    2) mp4 filename"
+	exit 1
+fi
+
+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
+
+case  $filetype in
+	PNG)		extension=".png"		;;
+	Netpbm)		extension=".pgm"		;;
+	*)		extension=".pnm"		;;
+esac
+echo "extension  :" $extension
+
+TITLE=$(printf -- '---{ experimental gravity field %d }---' $$)
+
+ffmpeg  -nostdin					\
+	-loglevel warning				\
+	-y -r 30 -f image2 -i ${SDIR}/%05d${extension}	\
+	-metadata artist='---{ tTh }---'		\
+	-metadata title="${TITLE}"			\
+	-c:v libx264 -pix_fmt yuv420p			\
+	$FNAME
+
+echo $FNAME ' ..... [done]'
+
+

GravityField/essai.f90

@@ -0,0 +1,82 @@
+!-----------------------------------------------------------------------
+!-
+!       test program for the project "gravity field"
+!-
+!-----------------------------------------------------------------------
+program essai
+  use  realfield
+  use  spitpgm               ! XXX
+  use  pixrgb
+
+  implicit none
+
+  call init_random()
+
+  call essai_near_planet(2048, 2048)
+
+  STOP 'BECAUSE YOLO'
+
+contains
+!-----------------------------------------------------------------------
+!-
+!     computation of thr nearest planet
+!-
+subroutine essai_near_planet(nbplanets, szfield)
+  integer, intent(in)       :: nbplanets, szfield
+
+  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)
+
+    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

@@ -0,0 +1,58 @@
+#!/bin/bash
+
+set -e
+
+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')
+texte=$(printf "pass %04d" $clock | tr '01' 'Ol')
+outfile=$(printf "WS/troid/%05d.png" $clock)
+echo  $timestamp $texte $outfile
+
+convert	${TMPF}				\
+	-pointsize 24			\
+	-font Courier-Bold		\
+	-fill Yellow			\
+	-annotate +20+32  "$timestamp"	\
+	-annotate +20+58  "$texte"	\
+	-pointsize 16			\
+	-gravity south-west		\
+	-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
+done
+
+ffmpeg  -nostdin					\
+	-loglevel warning				\
+	-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			\
+ 	-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

@@ -0,0 +1,289 @@
+!-----------------------------------------------------------------------
+!-
+!      some functions for the project "gravity field" 
+!-
+!-----------------------------------------------------------------------
+module realfield
+  use spitpgm               ! XXX
+
+  implicit none
+
+!-----------------------------------------------------------------------
+!-
+!      definition of structures
+!-
+type massbody
+  real                  :: posx = 0, posy = 0
+  real                  :: heading       = 0.29
+  real                  :: speed         = 1.017
+  real                  :: mass          = 1.0
+  integer               :: serial        = 666
+end type
+
+!-----------------------------------------------------------------------
+contains
+!-----------------------------------------------------------------------
+subroutine compute_barycentre_bodies(astres, bcx, bcy)
+  type(massbody), intent(in)     :: astres(:)
+  real, intent(out)              :: bcx, bcy
+  integer                        :: foo
+  real                           :: cx, cy
+
+  !   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
+  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
+      !-
+      planets(1)%posx   = sx / 2
+      planets(1)%posy   = sy / 2
+      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     = 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
+  real                          :: compute_gravity
+  real                          :: rx, ry, dist
+
+  rx = fx - body%posx
+  ry = fy - body%posy
+  ! ??? 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
+  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 numbers
+!   come from, sorry.
+!-
+subroutine compute_a_field(field, moon)
+  real, dimension(:,:), intent(out)  :: field
+  type(massbody), intent(in)         :: moon
+
+  integer                            :: ix, iy
+  real                               :: fx, fy
+  real                               :: grav
+
+  ! print *, "pic size  ", ubound(field, 1), "W", ubound(field, 2), "H"
+  ! print *, "mass body ", moon
+
+  do ix=1, ubound(field, 1)
+    fx = real(ix)
+    do iy=1, ubound(field, 2)
+      fy = real(iy)
+      grav = compute_gravity(fx, fy, moon)
+      field(ix,iy) = grav
+    enddo
+  enddo
+
+end subroutine
+!-----------------------------------------------------------------------
+!-
+!   compute a field with only one body; and write a pic file
+!-
+subroutine build_and_write_a_field(szx, szy, moons, fname)
+  integer, intent(in)                :: szx, szy
+  type(massbody), intent(in)         :: moons(:)
+  character(len=*), intent(in)       :: fname
+
+  real                                  :: maxi, mini
+  integer                               :: errcode, foo
+  real,    dimension(:,:), allocatable  :: field, tmpf
+  integer, dimension(:,:), allocatable  :: greymap
+
+  allocate(field(szx, szy), stat=errcode)
+  allocate(tmpf(szx, szy), stat=errcode)
+
+  field = 0.0
+  do foo=1, ubound(moons, 1)
+    call compute_a_field(tmpf, moons(foo))
+    tmpf = tmpf * 0.018
+    field = field + tmpf
+  enddo
+
+  maxi = maxval(field)
+  mini = minval(field)
+  ! print *, "field: ", mini, maxi, maxi-mini
+
+  allocate(greymap(szx, szy), stat=errcode)
+  greymap = 65533
+  ! convert from real value to 16 bits int values
+  where (field < 65530.0)
+    greymap = int(field)
+  end where
+
+  call spit_as_pgm_16(greymap, trim(fname))
+
+  ! make valgrind happy
+  deallocate(field)
+  deallocate(greymap)
+
+end subroutine
+
+!-----------------------------------------------------------------------
+!-
+!    Yes, I know, this is a disturbing kluge, but I like it :}
+!    May be, it's time to read the doc of modern Fortran
+!-
+subroutine init_random()
+
+  integer, dimension(3) :: tarray
+  integer               :: t3
+  real                  :: dummy
+  call itime(tarray)
+  t3 = 8971*tarray(1) + 443*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 t3=1, 4
+    dummy = rand()
+    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
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
+end module

GravityField/runme.sh

@@ -0,0 +1,16 @@
+#!/bin/bash
+
+set -e				# stop on error
+
+make animation
+
+LOG="WS/log.animation"
+
+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

@@ -0,0 +1,78 @@
+/*
+ *	Visualisation en 3d d'une tentative de champ gravitationnel
+ *
+ *	tTh novembre 2022
+ */
+
+#version 3.7;
+global_settings {
+		ambient_light rgb <0.07, 0.05, 0.05>
+		assumed_gamma 1.0
+		max_trace_level 6
+		}
+
+#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");
+
+#declare CMDIR  = "WS/colmap/";
+#declare CMNAME = concat(CMDIR, str(HFCK , -5, 0), ".pnm");
+
+#debug concat("- - - - - - - ", HFNAME, "  ", CMNAME, "\n")
+
+#declare GravityField = object
+{
+height_field {
+        pgm	HFNAME
+        smooth    // on
+        translate <-0.5, 0, -0.5>
+	}
+texture {
+	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.10, 0.60, 4.10> }
+
+// ----------------------------------------------------------------------
+
+#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 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	{
+	// omnimax
+	location	<Xcam, Ycam, Zcam>
+	look_at		<0, 0, 0>
+	right		x*image_width/image_height
+	angle		34
+	}
+
+// ----------------------------------------------------------------------