dernier commit avant le Gers

BloubWorld/.gitignore

@@ -1,12 +1,23 @@
 
 bloubs.inc
+nbimg.inc
+
 *.gif
 *.blbs
 *.mp4
+*.lst
+*.wav
+*.xyz
+*.ssv
 frames/*
 log.*
 
 exportbloubs
 genbloubs
 movebloubs
+mergebloubs
+listbloubs
+essai
 
+WS/*.data
+core

BloubWorld/Makefile

@@ -1,16 +1,34 @@
 
 
-all:	genbloubs movebloubs exportbloubs
+all:	genbloubs movebloubs exportbloubs mergebloubs	\
+	listbloubs					\
+	essai
 
+# ------------------------------------------------------------
 
-GFOPT = -Wall -Wextra -g -time
+GFOPT = -Wall -Wextra -g -time  -I../Modules
 OBJS  = bloubspace.o povstuff.o
+MYLIB = '../Modules/libtth90modules.a'
+
+# ------------------------------------------------------------
+
+essai:		essai.f90 Makefile $(OBJS)
+	gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
 
 # ------------------------------------------------------------
 
 initial.blbs:	genbloubs Makefile
 	./genbloubs $@ 1000
 
+in.blbs:	genbloubs Makefile
+	./genbloubs $@ 30000
+
+out.blbs:	in.blbs mergebloubs Makefile
+	./mergebloubs $< $@
+
+out.lst:	out.blbs exportbloubs Makefile
+	./exportbloubs $< > $@
+
 # ------------------------------------------------------------
 
 bloubspace.o:	bloubspace.f90 Makefile
@@ -22,13 +40,19 @@ povstuff.o:	povstuff.f90 Makefile
 # ------------------------------------------------------------
 
 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) $(MYLIB)  -o $@
 
 exportbloubs:	exportbloubs.f90 Makefile $(OBJS)
-	gfortran $(GFOPT) $(OBJS)  $< -o $@
+	gfortran $(GFOPT) $< $(OBJS) $(MYLIB)  -o $@
+
+mergebloubs:	mergebloubs.f90 Makefile $(OBJS)
+	gfortran $(GFOPT)  $< $(OBJS) $(MYLIB)  -o $@
 
 # ------------------------------------------------------------
 

BloubWorld/README.md

@@ -5,32 +5,82 @@ C'est quoi ?
 Le BloubWorld (que l'on appelle aussi BloubSpace) est un espace borné
 dans lequel se déplacent des **bloubs**, lesquels sont
 des sortes de particule
-munie de certaines propriétés.
-Lesquelles évoluent en fonction du temps.
+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
-
-```
-  type t_bloubs
-    character(8)         :: nick
-    integer              :: num
-    real                 :: px, py, pz
-    real                 :: vx, vy, vz
-    real                 :: radius
-    integer              :: seq
-  end type t_bloubs
-```
-
-C'est simple, en fait. Le plus compliqué, c'est de savoir quoi en faire.
+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, c'est la vie des bloubs.
 
 ## Comment ça fonctionne ?
 
 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.
+des opérations. Lequel enchainement est décrit plus bas.
+
+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 `.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 (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
+
+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))
+
+### 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))
+
+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
 
 - Concevoir un système de _bouding box_ facile à utiliser
 - Réfléchir à une politique de vieillissement des bloubs
+- le `merge` de deux bloubs est-il un acte politique ?
+
+
 

BloubWorld/WS/README.md

@@ -0,0 +1,3 @@
+# Work Space
+
+Where the progs put their work file.

BloubWorld/WS/boundinboxes.dat

@@ -0,0 +1 @@
+cube  -0.35 -0.5 -0.5 5.0 5.0 5.0

BloubWorld/bloubspace.f90

@@ -11,32 +11,194 @@ module bloubspace
   type t_bloubs
     character(8)         :: nick
     logical              :: alive
-    integer              :: num
+    integer              :: state
+    integer              :: num               ! ???
     real                 :: px, py, pz
     real                 :: vx, vy, vz
     real                 :: radius
-    integer              :: seq
+    integer              :: age, agemax
+    integer              :: red, green, blue
   end type t_bloubs
 
+  type t_boundingbox
+    character(8)         :: id
+    real                 :: xm, ym, zm
+    real                 :: xp, yp, zp
+  end type t_boundingbox
+
   contains               ! -----------------------------------------
 
-  subroutine random_pv (blb)
-    type(t_bloubs), intent (inout)  :: blb
+  ! ----------------------------------------------------------------
 
-    blb%px = rand() - 0.50
-    blb%py = rand() * 0.25
-    blb%pz = rand() - 0.50
+  subroutine load_boundingbox(infile, where, name)
+    implicit none
 
-    blb%vx = (rand() - 0.5) / 4.000
-    blb%vy = (rand() - 0.5) / 4.000
-    blb%vz = (rand() - 0.5) / 4.000
+    character(*), intent(in)            :: infile
+    type(t_boundingbox), intent (out)   :: where
+    character(8), intent(in)            :: name
 
+    integer                   :: fd, errcode
+    character(200)            :: message
+
+    print *, "try to load ", infile, " name ", name
+
+    ! put some default values
+    where%id = "default"
+    where%xm = -5.0 ; where%ym = -5.0 ; where%zm = -5.0
+    where%xp =  5.0 ; where%yp =  5.0 ; where%zp =  5.0
+
+    ! and now, try to read the file
+    open (newunit=fd, file=trim(infile),               &
+          status='old', action='read',                 &
+          iostat=errcode, iomsg=message)
+    if (errcode .NE. 0) then
+      stop 'OPEN ERROR ' // message
+    endif
+
+    do
+      read(unit=fd, iostat=errcode, iomsg=message,     &
+           fmt='(A,6F8.3)') where
+      if (errcode .NE. 0) then
+         ! print *, "errcode ", errcode
+         print *, "message: ", message
+         exit
+      endif
+    enddo
+
+    close(fd)
+
+  end subroutine load_boundingbox
+
+  ! ----------------------------------------------------------------
+  !-
+  !    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
+
+    ! 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() / 9.000)
+    ! if (blb%px .LT. 0.0) blb%vx = -blb%vx
+
+    blb%vy = -0.10 + (rand() / 11.000)
+    ! if (blb%py .LT. 0.0) blb%vy = -blb%vy
+
+    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 = 250 + mod(irand(), 250)
 
   end subroutine
   ! ----------------------------------------------------------------
+  !        Load a blbs file into an array of bloubs
+
+  subroutine spit_bloubs_to_file (fname, blbarray, towrite)
+    implicit none
+    character(*), intent(in)       :: fname
+    type(t_bloubs), dimension(:)   :: blbarray
+    integer, intent(in)            :: towrite
+
+    integer                :: errcode, output, foo, spitted
+    character(200)         :: chaine
+ 
+    ! write (0, '(" spitting", (I6), " bloubs to ", (A), " file")')     &
+    !                     towrite, trim(fname)
+
+    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)
+
+    open(      newunit=input,                             &
+               file=trim(infile), form='unformatted',     &
+               iostat=errcode, iomsg=chaine,              &
+               action='read', status='old')
+    if (0 .ne. errcode) then
+      write(0, '(" errcode ", I8, 2X, A)') errcode, chaine
+      STOP " : CAN'T OPEN FILE " // trim(infile)
+    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, '("errcode on read ", (I0,1X,A))') errcode, chaine
+        exit
+      endif
+      nbread = nbread + 1
+      ! print *, bloub%nick, bloub%radius
+      if (bloub%alive) then
+        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
+
+  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
 
@@ -45,73 +207,134 @@ module bloubspace
     if (blb%alive) then
       life = "alive"
     else
-      life = "dead"
+      life = "dead "
     endif
-    write (0, '(A)') '------------- ' // message
-    write (0, '(4X,A8,2X,I6,4X,A5)') blb%nick, blb%num, blb%alive
-    write (0, '(4X,A1,3X,3(F8.3, 4X))') 'P', blb%px, blb%py, blb%pz
-    write (0, '(4X,A1,3X,3(F8.3, 4X))') 'V', blb%vx, blb%vy, blb%vz
+    write (0, '(4X, A)') '+--------------- ' // message // " -------"
+    write (0, '(4X,A3,A8,2X,I6,4X,A5,4X,I5)') '|  ',       &
+                                 blb%nick, blb%num, life, blb%age
+    write (0, '(4X,A3,3X,3(F8.3, 4X))') '| P', blb%px, blb%py, blb%pz
+    write (0, '(4X,A3,3X,3(F8.3, 4X))') '| V', blb%vx, blb%vy, blb%vz
     write (0, '()')
 
   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
   ! ----------------------------------------------------------------
-  subroutine bound_a_blob (blb)
+  ! 
+  !     detection des collisions avec les parois de la boite
+  !     laquelle boite gagnerais beaucoup a etre parametrable,
+  !     ainsi qu'un éventuel coefficient de réduction de la
+  !     vitesse. XXX
+  ! 
+  subroutine bound_a_bloub (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
 
-    if (5.0 .lt. blb%px) 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%seq = blb%seq + 1
+      blb%px = SH - blb%radius
+      flag = .TRUE.
     endif
-    if (-5.0 .gt. blb%px) then
+    if ((blb%px - blb%radius) .LT. -SH) then
       blb%vx = -1.0 * blb%vx
-      blb%px = -5.0
-      blb%seq = blb%seq + 1
+      blb%px = -SH + blb%radius
+      flag = .TRUE.
     endif
 
-    if (0.0 .gt. blb%py) then
+    ! vertical axe Y
+    if ((blb%py - blb%radius) .LT. -SV) then
       blb%vy = -1.0 * blb%vy
-      blb%py = 0.0
+      blb%py = -SV + blb%radius
+      flag = .TRUE.
     endif
-    if (3.0 .lt. blb%py) then
+    if ((blb%py + blb%radius) .GT. SV) then       ! overshoot ?
       blb%vy = -1.0 * blb%vy
-      blb%py = 3.0
+      blb%py = SV - blb%radius
+      flag = .TRUE.
     endif
 
-    if (5.0 .lt. blb%pz) then
+    !    Z axis
+    if ((blb%pz + blb%radius) .GT. SH) then
       blb%vz = -1.0 * blb%vz
-      blb%pz = 5.0
+      blb%pz = SH - blb%radius
+      flag = .TRUE.
     endif
-    if (-5.0 .gt. blb%pz) then
+    if ((blb%pz + blb%radius) .LT. -SH) then
       blb%vz = -1.0 * blb%vz
-      blb%pz = -5.0
+      blb%pz = -SH + blb%radius
+      flag = .TRUE.
+    endif
+
+    if (flag) then
+      blb%age = blb%age + 1
+      blb%radius = blb%radius * 0.9999
+    endif
+
+    if (blb%age .GT. blb%agemax) then
+      blb%alive = .FALSE.
     endif
 
   end subroutine
 
   ! ----------------------------------------------------------------
+  function distance_of_bloubs(bla, blb)
+    implicit none
+    type(t_bloubs), intent(in)   :: bla, blb
+    real                         :: distance_of_bloubs
+
+    real            :: dx, dy, dz
+
+    dx = (bla%px-blb%px)**2
+    dy = (bla%py-blb%py)**2
+    dz = (bla%pz-blb%pz)**2
+
+    distance_of_bloubs = sqrt(dx + dy +dz)
+
+  end function
+
+  ! ----------------------------------------------------------------
+  !          kill a bloub under condition(s)
+
   subroutine green_soylent (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
-    if (blb%seq .gt. 200) then
+
+    if (blb%age .gt. 240) then
+      blb%alive = .FALSE.
+    endif
+
+    ! this is juste a molly-guard, don't worry
+    ! 
+    if (blb%radius .GT. 5.0) then
       blb%alive = .FALSE.
     endif
   end subroutine
   ! ----------------------------------------------------------------
 
-
 end module
 
 

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

@@ -0,0 +1,113 @@
+# What is a bloub ?
+
+## Philosophie
+
+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.
+
+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
+
+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
+    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 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 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/encode.sh

@@ -1,12 +1,12 @@
 #!/bin/bash
 
-DDIR="frames/"
+DDIR="frames/a"
 
 ffmpeg  -nostdin					\
-        -loglevel info                                          \
+        -loglevel warning				\
         -y -r 25 -f image2 -i $DDIR/%05d.png 		\
 	-metadata artist='---[ tTh ]---'		\
-	-metadata title='---[ BloubWorld ]---'		\
+	-metadata title='---[ BloubWorld alpha ]---'	\
         -c:v libx264 -pix_fmt yuv420p			\
         bloubworld.mp4
 

BloubWorld/essai.f90

@@ -0,0 +1,32 @@
+program essai
+
+!  use bloubspace
+  use mathstuff2
+  implicit none
+
+  call test_random(10)
+
+  STOP ': BECAUSE JOB IS DONE'
+
+! --------------------------------------------------------------
+         contains
+
+subroutine test_random(nbre)
+  implicit none
+  integer, intent(in)         :: nbre
+  integer                     :: foo
+  real                        :: quux, bar
+  double precision            :: somme
+
+  call init_random_seed()           ! in module 'mathstuff'
+  somme = 0.0
+  do foo=1, nbre
+    quux = 10.0 * rand()
+    somme = somme + quux
+    bar = quux ** (.1/.3)
+    print *, quux, bar, somme/foo
+  enddo
+end subroutine test_random
+! --------------------------------------------------------------
+
+end program

BloubWorld/exportbloubs.f90

@@ -1,4 +1,4 @@
-program genbloubs
+program exportbloubs
 
   use bloubspace
   implicit none
@@ -11,11 +11,11 @@ program genbloubs
   !       parsing command line
   i = IARGC()
   if (1 .ne. i) then
-    STOP ' :BAD COMMAND LINE'
+    STOP ' : BAD COMMAND LINE'
   endif
   call getarg(1, filename)
   
-  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
+    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, I5, A)') compte, " bloubs exported"
+  write(0, '(1X, I0, A)') compte, " bloubs exported"
 
   close(idu)
 

BloubWorld/genbloubs.f90

@@ -1,14 +1,14 @@
 program genbloubs
 
   use bloubspace
+  use mathstuff2
 
   integer               :: nbbloubs
   integer               :: i
   character(200)        :: filename
   character(30)         :: str
   type(t_bloubs)        :: bloub
-
-  integer, parameter    :: idu = 33
+  integer               :: idu
 
   i = IARGC()
   if (i .ne. 2) then
@@ -19,20 +19,22 @@ program genbloubs
   call getarg(2, str)
   read(str,*) nbbloubs
 
-  write (0, '(A,I6,A)') &
+  write (0, '(A,I8,A)') &
   "*** generating ", nbbloubs, " bloubs to "//trim(filename)
 
-  ! print *, "generating ", nbbloubs, "bloubs to ", filename
+  call init_random_seed()
 
-  open(unit=idu, file=trim(filename), form='unformatted',     &
+   open(newunit=idu, file=trim(filename),            &
+                 form='unformatted',                 &
+                 access="sequential",                &
                  action='write', status='replace')
 
   do i = 1, nbbloubs
+
     bloub%nick    = 'noname  '
-    bloub%alive = .TRUE.
-    call random_pv(bloub)
-    bloub%radius = 0.028
-    bloub%seq    = 0
+    bloub%num     = i + 41
+    call make_a_random_bloub(bloub, 11.80)
+    bloub%radius  = 0.010 + (0.12*rand())
 
     write(idu) bloub              ! no error control ?
 

BloubWorld/listbloubs.f90

@@ -0,0 +1,47 @@
+program listbloubs
+
+  use bloubspace
+  implicit none
+
+  integer, parameter       :: NB_MAX_BLOUBS = 2000000
+
+! --------------------------------------------------------------
+  character(300)           :: infile
+  integer                  :: errcode, i
+  integer                  :: nbgot
+  type(t_bloubs), dimension(:), allocatable  :: bloubs
+
+  i = IARGC()
+  if (i .ne. 1) then
+    STOP ": BAD ARG ON COMMAND LINE"
+  endif
+  call getarg(1, infile)
+
+  write (0, '(A)') &
+            "***** 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
+
+  call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
+  write(0, '(A,I6,1X,A)') "slurped ", nbgot, "bloubs"
+
+  do i=1, nbgot
+    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)%agemax
+  enddo
+
+end program
+
+!                           \o_ 

BloubWorld/mathstuff.f90

@@ -0,0 +1,32 @@
+module mathstuff
+
+  implicit none
+  contains
+
+  ! ----------------------------------------------------------------
+  !   really quick'n'dirty hack
+  !                  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
+    call srand(t3)
+
+    ! after initializing the random generator engine,
+    ! you MUST use it for initializing the initializer
+    do foo=1, tarray(1)+15
+      dummy = rand()
+    enddo
+
+  end subroutine 
+
+  ! ----------------------------------------------------------------
+end module mathstuff
+

BloubWorld/mergebloubs.f90

@@ -0,0 +1,116 @@
+program mergebloubs
+
+          !-------------------------------------------!
+          !       THIS IS A BIG MESS OF BUGS          !
+          !-------------------------------------------!
+
+  use bloubspace
+  use mathstuff2
+  implicit none
+
+  integer, parameter       :: NB_MAX_BLOUBS = 250000
+
+  character(200)           :: infile, outfile
+  ! 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
+    STOP ": NEED IN AND OUT FILENAME"
+  endif
+  call getarg(1, infile)
+  call getarg(2, outfile)
+
+  write(0, '(A, A, 1X, A, 1X, I6)') "### mergebloubs ",        &
+                 trim(infile), trim(outfile), NB_MAX_BLOUBS
+
+  call init_random_seed()
+
+  allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
+  if (0 .NE. errcode) then
+    STOP " : NO ENOUGH MEMORY"
+  endif
+
+  call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
+  write(0, '(A,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
+
+  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
+
+  ! STOP '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
+
+      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
+
+      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 = (va + vb) ** 0.33335
+      blr%age = min(bla%age, blb%age)
+
+      ! bring it to life !
+      blr%alive    = .TRUE.
+
+  end subroutine
+
+end program
+
+

BloubWorld/movebloubs.f90

@@ -2,14 +2,17 @@ program movebloubs
 
   use bloubspace
   use povstuff
+  use mathstuff2
 
   implicit none
 
   character(200)           :: infile, outfile
   integer                  :: inu, outu, errcode, i
+  integer                  :: compteur, killed
   type(t_bloubs)           :: bloub
   double precision         :: bx, by, bz
-  logical                  :: add_new_bloub = .FALSE.
+  ! logical                  :: add_new_bloub = .TRUE.
+  real                     :: rnd
 
   i = IARGC()
   if (i .ne. 2) then
@@ -18,67 +21,124 @@ program movebloubs
   call getarg(1, infile)
   call getarg(2, outfile)
 
-  inu  = 42 ;   outu = 51
-
   write (0, '(A)') &
-  "*** moving bloubs from "//trim(infile)//" to "//trim(outfile)
+  "### moving bloubs from "//trim(infile)//" to "//trim(outfile)
 
-  open(unit=inu,  file=trim(infile), form='unformatted',     &
+  call init_random_seed()
+
+  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)
   endif
 
-  open(unit=outu, file=trim(outfile), form='unformatted',     &
+  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
 
-  bx = 0.0;   by = 0.0;   bz = 0.0
+  ! write(0, '("Units: ", 2I5)') inu, outu
 
+  bx = 0.0;   by = 0.0;   bz = 0.0
+  compteur = 0
+  killed   = 0
+
+!-
+!		begin of bigloop
+!-
   do
     read (unit=inu, iostat=errcode) bloub
     if (0 .ne. errcode) then
+      ! may be we got an EOF ?
       exit
     endif
 
-    ! moving and boundingboxing
-    call move_bloub (bloub, 0.11)
-    call bound_a_blob(bloub)
+    ! moving, morphing and boundingboxing
+    call move_bloub     (bloub, 0.185)
+    call bound_a_bloub  (bloub)
+    if (bloub%radius .GT. 3.50) then
+      bloub%radius = bloub%radius * 0.999
+    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 + bloub%px
-    by = by + bloub%py
-    bz = bz + bloub%pz
+    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
-
-  enddo
-
-  if (add_new_bloub) then
-    ! and now, we inject a new bloub in the universe
-    bloub%nick = 'newbie  '
-    bloub%alive = .TRUE.
-    call random_pv(bloub)
-    bloub%radius = 0.042
-    bloub%seq    = 0
-    ! 
-    ! where is the bug ?
-    ! 
-    call display_bloub (bloub, "new bloub")
-    write(outu) bloub     ! no error control ?
+      compteur = compteur + 1
     endif
 
-  ! ther was some strange bias in this data
-  ! may be a random not symetric around 0.0 ?
-  write (0, '(A,3(F11.3,3X))') "barycentre : ", bx, by, bz
+  enddo                     ! end of main loop
+
+  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 from the input file
+
+  ! insert some fancy conditional here
+  if (compteur .LT. 50) then
+    call add_more_bloubs(outu, 5, 0.046)
+  endif
+
+  rnd = rand()
+  ! write(0, *) 'rnd= ', rnd
+  if (rnd .LT. 0.18) then
+    write (0, *) '... random of life ...'
+    call add_more_bloubs(outu, 5, 0.056)
+  endif
 
   close(inu)    ;    close(outu)
 
-end program
+! --------------------------------------------------------------
+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(), 2)
+  write(0, '(1X,A,I0,1X,A)') "movebloubs: adding ", count, " bloubs"
+
+  do foo=1, count
+
+    bloub%nick = 'newbie  '
+    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 ?
+
+  enddo
+
+  end subroutine
+
+! --------------------------------------------------------------
+
+end program movebloubs

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
@@ -20,6 +21,16 @@ module povstuff
 
   end subroutine
 
+  ! ----------------------------------------------------------------
+
+  subroutine start_of_inc_file (fd)
+    implicit none
+    integer, intent (in)             :: fd
+
+    write(fd, '(A)') "// DON'T EDIT THIS FILE !"
+
+  end subroutine
+
   ! ----------------------------------------------------------------
   ! we need some primitives for the gestion of colors.
   ! may be a small database indexed by name ?

BloubWorld/runme.sh

@@ -5,66 +5,89 @@
 #
 
 
-INCFILE="bloubs.inc"
+INCFILE="WS/bloubs.inc"
 TMPPNG="/dev/shm/bloubs7.png"
-POVOPT="+Q9 +a -v -d -W920 -H600"
-DDIR="frames"
+POVOPT="+Q9 +a -v -d -W1024  -H768 -WT2"
+DDIR="frames/a"
 LOGERR="log.error"
+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=2000
 
 make all
 err=$?
 if [ $err -ne 0 ] ; then
-	echo 'make error = ' $err
+	echo 'make error code is = ' $err
 	exit 1
 fi
 
+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 paraletrizable
+#    --> this function need to be parametrizable
 #
-./genbloubs in.blbs  100000
+./genbloubs ${BLBS_IN}  2
 
-for idx in $(seq 0 800)
+for idx in $(seq 0 $((NBIMG-1)) )
 do
 
-	echo "======== run passe $idx ========="
+	echo "================= run passe $idx ===================="
 
-	./exportbloubs in.blbs | 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
-	else
-		grep "Trace Time" $LOGERR
+		sleep 90
 	fi
 
-	td=$(date +'%F %R:%S')
-	txt=$(printf "%9d %5d   %s" $$ $idx "${td}")
+	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)
-	echo "$txt"
 
 	convert		${TMPPNG}			\
-			-font fixed			\
-			-pointsize 20			\
-			-fill orange			\
+			-font Courier-Bold		\
+			-pointsize 32			\
+			-fill "$TXTCOLOR"		\
 			-gravity south-east		\
-			-annotate +15+10 "$txt"		\
+			-annotate +25+5 "$td"		\
+			-gravity south-west		\
+			-annotate +25+5 "$hi"		\
+			-gravity north-east		\
+			-annotate +45+5 "$count"	\
+			-gravity north-west		\
+			-annotate +45+5 "BloubWorld"	\
 			$PNG
 
-	echo $PNG '[done]'
+	echo ' ' $PNG '[done]'
 
-	./movebloubs in.blbs out.blbs
-	mv out.blbs in.blbs
-	echo
+	./movebloubs ${BLBS_IN} ${BLBS_OUT}
+	./mergebloubs ${BLBS_OUT} ${BLBS_IN}
+	# mv ${BLBS_OUT} ${BLBS_IN}
+
+	echo "### run done"
+	sleep 35
 
 done
 
 rm $LOGERR
 
-convert -delay 10 -resize 50% -colors 192	\
-			$DDIR/????[0]*.png foo.gif
-
-./encode.sh
+nice ./encode.sh
 
 

BloubWorld/scene.pov

@@ -5,64 +5,176 @@
 #version 3.7;
 
 global_settings {
-                ambient_light rgb <0.09, 0.02, 0.02>
+                ambient_light rgb <0.14, 0.08, 0.08>
                 assumed_gamma 1.0
                 }
 
 #include  "colors.inc"
 
-#include  "bloubs.inc"
+#include  "WS/nbimg.inc"
+
+#declare NormClock = clock / NbImg;
+
+//  ----------------------------------------------------------
+
+#include  "WS/bloubs.inc"
+
+#fopen LC "WS/log.nb_bloubs" append
+#write (LC, " ", Nb_Bloubs, "\n")
+#fclose LC
+
 
 object	{
 	Bloubs
-	texture {
-		pigment { color Gray50 } 
-		finish { phong 0.58 metallic 0.45 }
-		}
+	finish { phong 0.57 specular 0.57 }
 	}
 
-plane	{
-	<0, 1, 0>, 0
+#declare La_Boite = object
+{
+union {
+	plane	{ <1, 0, 0>, -37 	}
+	plane	{ <1, 0, 0>,  37	}
+	plane	{ <0, 1, 0>, -27	}
+	plane	{ <0, 1, 0>,  27	}
+	plane	{ <0, 0, 1>,  69 	}
 	texture {
-		pigment { color Gray10 } 
-		finish { phong 0.18 metallic 0.45 }
+		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;
-#declare BV = 3;
-#declare BR = 0.025;
+#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.042, 0>, <0, -0.042, 0>,   BR*1.90   }
+	}
+}
+
+#local Ruc = BR * 0.90;
+#local Rud = BR * 0.30;
+
+#declare Un_Cadre = object
+{
+merge {
+	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 { <0, 0, 0>, <0, BV,   0>, BR     }
-	cylinder { <0, 0, 0>, <0, 0.03, 0>, BR*4   }
+	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 }
 	}
 }
 
 #declare Les_Bornes = object
 {
 union	{
-	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 }   }
+	#local E = 0.0005;
+	object { Un_Cadre translate  y*(BV-E)         }
+	object { Un_Cadre translate -y*(BV-E)         }
+
+	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 }   }
 	}
 }
 
 object { Les_Bornes }
 
 //  ----------------------------------------------------------
+#local D = 0.016;
 
-light_source { <4, 12, -11> color Gray80 }
-// light_source { <4, 19,    9> color White }
+#declare Fleche = object
+{
+merge	{
+	sphere   { <-0.05, 0, 0>, D }
+	cylinder { <1, 0, 0>, <-0.05, 0, 0>, D }
+	cone     { <1, 0, 0>, D*3.1, <1.10, 0, 0>, 0.0001 }
+	}
+}
+#declare Repere = object
+{
+union {
+	object   { Fleche		pigment { color Red }}
+	object   { Fleche rotate z*90	pigment { color Green }}
+	object   { Fleche rotate y*270	pigment { color Blue }}
+	}
+}
+//  ----------------------------------------------------------
+
+light_source { < 19,  12+NormClock, -17> color Gray80 }
+light_source { <-14,  10-NormClock, -29> color Gray70 }
+
+#declare XCAM = 5 - ( 10 * NormClock);
+#declare YCAM = -1.1 + (1.25 * NormClock);
+#declare ZCAM = -19.20;
+
+#declare XLAT = 0;
+#declare YLAT = 0;
+#declare ZLAT = 0;
 
 camera  {
-	location   <7, 5, -16>
-	look_at    <0, 0, 0>
+	location   <XCAM, YCAM, ZCAM>
+	look_at    <XLAT, YLAT, ZLAT>
 	right           x*image_width/image_height
-	angle		54
+	angle		64
 	}

BloubWorld/toinc.awk

@@ -1,22 +1,52 @@
 
+#
+#    Input for this script is generated by 'exportbloubs.f90'
 #
 #            this code is (C) 2022 tTh
 #
 
 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{"
 	}
 
 	{
-	printf "\t\tsphere { <%f, %f, %f>, %f }\n",		\
-			  $1, $2, $3,  $4
+	age = $5
+	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 \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, ";";
+	print "#declare Bary_Z = ", bz/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

@@ -0,0 +1,27 @@
+
+mkjulia
+pickover
+mklorentz
+mkmandel
+voxelize
+evolvopick
+henon
+mkhenon
+essai
+plotcolmap
+
+frames/*
+WS/*.dat
+WS/*.txt
+WS/*.inc
+
+toto
+
+*.pgm
+*.pnm
+*.gif
+*.asc
+*.png
+*.mp4
+
+

Fraktalism/Makefile

@@ -0,0 +1,80 @@
+
+all:	essai voxelize evolvopick pickover 	\
+	mkjulia mklorentz mkmandel
+
+GFOPT  = -Wall -Wextra -time -g -Imods/ -I../Modules
+
+# ---------------------------------------------
+# the module 'spitpgm' is now in $PROJECT/Modules
+#
+
+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 $<
+
+mandelbrots.o:	mandelbrots.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+julias.o:	julias.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+OBJDEP  = mods/points3d.o mods/xperiment.o mods/fractcolmap.o	\
+	  fraktals.o mandelbrots.o julias.o
+
+OBJS    = $(OBJDEP) ../Modules/pixrgb.o ../Modules/spitpgm.o 
+
+# ---------------------------------------------
+
+essai:		essai.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+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 $@
+
+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:	mklorentz Makefile
+	./mklorentz $@ > /dev/null
+
+pickover.pgm:	pickover Makefile
+	./pickover $@ > /dev/null
+
+# ---------------------------------------------

Fraktalism/README.md

@@ -6,16 +6,53 @@ 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
+[d'explications](mods/documentation.md)
 
 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
+    double precision      :: x, y, z
+    integer               :: seq
+  end type t_point3d
+```
+
+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

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

@@ -0,0 +1,159 @@
+module fraktals
+  use points3d
+  implicit none
+  contains
+
+!===============================================================
+!	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, coef
+    logical      ::  burps
+ 
+    width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
+    coef   = float(maxiter) / 12.3456789
+
+    do ix = 1, width
+      fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
+      burps = (RAND() .lt. 0.01)
+      do iy = 1, height
+        fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
+        if (burps) then
+          pic(ix, iy) = mod(int(fx * fy * coef * 1.005), 250)
+        else
+          pic(ix, iy) = mod(int(fx * fy * coef), 250)
+        endif
+      enddo
+    enddo
+
+end subroutine parasites_0
+!===============================================================
+!-
+!  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
+
+    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 
+    enddo
+
+end subroutine
+!-----------------------------------------------------
+! 
+!  d'après les pages 91/92 du livre de Roger T Stevens
+!       "Fractal programming in C"
+! 
+subroutine plot_pickover(pic, count)
+    implicit none
+    integer, intent(inout), dimension (:,:)  ::  pic
+    integer, intent(in)                      ::  count
+
+    type(t_point3d), dimension(:), allocatable ::   points
+    double precision, dimension(4)             ::   coefs
+    integer               :: i, w, h, px, py, errcode
+
+    write(0, '(1X, A18 , I9)') "pickover_0 ", count
+
+    allocate(points(count), stat=errcode)
+    if (0 .NE. errcode) then
+      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)
+ 
+    w  = ubound(pic, 1)
+    h  = ubound(pic, 2)
+
+    do i=1, ubound(points, 1)
+      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"
+! 
+subroutine lorentz_0(pic, count)
+    implicit none
+    integer, intent(inout), dimension (:,:)  ::  pic
+    integer, intent(in)                      ::  count
+
+! XXX    double precision      :: xa, ya, za, xb, yb, zb
+! 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
+  real, intent(in)    :: x, y
+  real                :: dist0
+  dist0 = ( x*x + y*y )
+end function
+
+!-----------------------------------------------------------
+!-
+
+function modulus2(pt)
+  implicit none
+  complex, intent(in)    ::   pt
+  real                   ::   modulus2
+  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

@@ -0,0 +1,27 @@
+program henon
+
+    use PIXRGB
+
+    implicit none
+
+    type(t_pixrgb), allocatable     ::    picz(:,:)
+    integer                         ::    argc
+    character(200)                  ::    filename, string
+    real                            ::    cx, cy
+
+    argc = IARGC()
+    if (3 .NE. argc) then
+      STOP ": MKHENON PROGGY NEED 3 PARAMETERS !"
+    endif
+
+    call getarg(1, filename)
+    call getarg(2, string)       ;   read (string, *) cx
+    call getarg(3, string)       ;   read (string, *) cy
+
+    allocate(picz(1280, 1024))
+
+    call rgbpix_spit_as_pnm_8(picz, trim(filename))
+
+!-----------------------------------------------------
+
+end program

Fraktalism/mkjulia.f90

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

@@ -0,0 +1,61 @@
+#!/bin/bash
+
+#
+#	build the prog
+#
+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
+#
+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)
+
+	# make mkjulia
+
+	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..."
+
+./encode.sh frames/julia/ foo.mp4

Fraktalism/mklorentz.f90

@@ -0,0 +1,31 @@
+! 
+!    this is the main programm
+! 
+!-----------------------------------------------------
+
+program lorentz
+
+    use spitpgm
+    use fraktals
+
+    implicit none
+
+    integer, dimension(800, 600)    ::    picz
+    integer                         ::    argc
+    character(200)                  ::    filename
+
+    argc = IARGC()
+    if (1 .NE. argc) then
+      STOP ": MKLORENTZ NEED A FILENAME !"
+    endif
+
+    call getarg(1, filename)
+
+    write (0, "(A)") "Mk Lorentz -> "//trim(filename)
+
+    call lorentz_0(picz, 50000)
+    call spit_as_pgm_8(picz, trim(filename))
+
+end program
+
+!-----------------------------------------------------

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 image
-
-    use imagetools
+program mkmandel
+    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

@@ -0,0 +1,24 @@
+#
+#      compiling fraktalism's modules
+#
+
+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

@@ -0,0 +1,13 @@
+# Modules
+
+
+Premier point : trouver les bonnes options de gfortran pour
+définir l'emplacement des `.mod`.
+
+Deuxième point : construire un Makefile cohérent d'un bout à l'autre,
+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

@@ -0,0 +1,18 @@
+# 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 ?
+
+## Xperiment
+
+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

@@ -0,0 +1,61 @@
+module points3d
+
+  implicit none
+!-----------------------------------------------------
+  type t_point3d
+    double precision      :: x, y, z
+    integer               :: seq
+  end type t_point3d
+
+!-----------------------------------------------------
+  contains
+
+!-----------------------------------------------------
+
+subroutine list_points3d(array, start, length)
+    type(t_point3d), dimension(:), intent(in)  :: array
+    integer, intent(in)                        :: start, length
+    integer                                    :: sz, i, j
+
+    write(0, '(1X, A15, 2I9)') "list pt3d ", start, length
+    sz = ubound(array, 1)
+    if ((start+length) .GT. sz) then
+      STOP ' : LIST P3D, OUT OF BOUND'
+    endif
+
+    ! 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/pick2pov.awk

@@ -0,0 +1,18 @@
+#!/usr/bin/awk
+
+BEGIN	{
+	print "// generated file, don't touch it bastard !"
+	print "#declare Pickover = object {"
+	print "union {"
+	}
+
+#		for every line
+	{
+	printf "object { Truc translate <%f, %f, %f> }\n", $1, $2, $3
+	}
+
+
+END	{
+	print "} }"
+	print "// done", NR
+	}

Fraktalism/pick3d.pov

@@ -0,0 +1,83 @@
+#version 3.7;
+
+global_settings {
+                ambient_light rgb <0.12, 0.04, 0.04>
+                assumed_gamma 1.0
+                }
+
+#include  "colors.inc"
+
+#declare Tiers = NBPASS * 0.3333333;
+#declare CK    = (clock/Tiers)*180;
+
+// --------------------------------------------------------------
+#declare Rep = object
+{
+union {
+	#local RB = 0.015;
+	cylinder { 0, <2, 0, 0>, RB pigment { color Red   } }
+	cylinder { 0, <0, 2, 0>, RB pigment { color Green } }
+	cylinder { 0, <0, 0, 2>, RB pigment { color Blue  } }
+	}
+}
+// object { Rep translate <-1, 0.10, -1> }
+
+// --------------------------------------------------------------
+
+#declare TS = 0.025;
+
+#declare Truc = object
+{
+// box { <-TS, -TS, -TS>, <TS, TS, TS> }
+sphere { <0, 0, 0>, TS*0.83 }
+}
+
+#include  "WS/pickover.inc"
+
+object {
+	object {
+		Pickover
+		texture {
+			pigment { color srgb <0.35, 0.45, 0.80> }
+                	finish { phong 0.38 metallic 0.55 }
+                	} 
+		}
+
+	#if (clock < (Tiers))
+	  rotate x*(CK)
+	#elseif (clock < (Tiers*2))
+	  rotate y*(CK)
+	#else 
+	  rotate z*(CK)
+	#end
+	translate y*2.25
+	}
+
+//  ----------------------------------------------------------
+
+plane   {
+        <0, 1, 0>, 0
+        texture {
+                pigment { color srgb <0.233, 0.155, 0.191> } 
+                finish { phong 0.18 metallic 0.55 }
+                }
+        }
+
+
+//  ----------------------------------------------------------
+
+light_source { <-12, 15, -11> color Gray90 }
+light_source { < 11, 11,  13> color Gray60 }
+
+#declare XCAM =  -3.1;
+#declare YCAM =   3;
+#declare ZCAM =   1.9;
+
+camera  {
+        location   	<XCAM, YCAM, ZCAM>
+        look_at    	<0,    2.09,   0>
+        right           x*image_width/image_height
+        angle           82
+        }
+//  ----------------------------------------------------------
+

Fraktalism/pick3d.sh

@@ -0,0 +1,50 @@
+#!/bin/bash
+
+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
+
+for pass in $(seq 0 $(( PASS-1 )) )
+do
+
+	dstname=$(printf "frames/pick3d/%05d.png" $pass)
+	echo $dstname
+
+	povray -ipick3d.pov -K${pass}			\
+			Declare=NBPASS=${PASS}		\
+			$POVOPT -O${TMPF} 2> $ERR
+	if [ $? -ne 0 ]
+	then
+		tail -20 $ERR
+		exit
+	fi
+
+	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            \
+        -metadata artist='---[ tTh ]---'                	\
+        -c:v libx264 -pix_fmt yuv420p                   	\
+         pick3d.mp4

Fraktalism/pickover.f90

@@ -0,0 +1,44 @@
+! 
+!    this is the main programm
+! 
+!-----------------------------------------------------
+
+program pickover
+
+    use spitpgm
+    use points3d 
+    use fraktals
+
+    implicit none
+
+    integer, dimension(1024, 768)               ::   picz
+    integer                                    ::   argc
+    character(200)                             ::   filename
+    double precision, dimension(4)             ::   coefs
+    type(t_point3d), dimension(:), allocatable ::   points
+
+    integer                                    ::  nbr_points
+    integer                                    ::  errcode
+    argc = IARGC()
+    if (1 .NE. argc) then
+      STOP ": PICKOVER NEED A FILENAME !"
+    endif
+
+    call getarg(1, filename)
+    write (0, "(A)") " *** Pickover -> "//trim(filename)
+
+    nbr_points = 999999
+    allocate(points(nbr_points), stat=errcode)
+    if (0 .NE. errcode) then
+      STOP " : NO ENOUGH MEMORY"
+    endif
+
+    coefs(1) =  2.24     ;     coefs(2) =  0.43
+    coefs(3) = -0.65     ;     coefs(4) = -2.43
+
+    call compute_pickover(points, coefs)
+    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/plotpick.sh

@@ -0,0 +1,72 @@
+#!/bin/bash
+
+ASCFILE="nuage.asc"
+IMAGE="pickplot.png"
+
+make pickover
+if [ $? -ne 0 ] ; then
+	echo
+	echo "Make error " $?
+	exit 1
+fi
+
+./pickover foo.pgm > $ASCFILE
+if [ $? -ne 0 ] ; then
+	echo
+	echo "Pickover error " $?
+	exit 1
+fi
+
+
+# ----------------------------------------------------
+function plot_this_pic()
+{
+local imgname="$1"
+local angle="$2"
+
+printf "== %s == %3d ==\n" $imgname $angle
+
+gnuplot << __EOC__
+	set term png    size 1024,768
+	set output      "${imgname}"
+
+	set title "3D Pickover"
+	unset grid
+	unset tics
+
+	set view 70, $angle, 1.20
+	set xrange [ -2.10 : 2.10 ]
+	set yrange [ -2.10 : 2.10 ]
+	set zrange [ -1.00 : 1.00 ]
+
+	splot "${ASCFILE}" notitle with dots lt rgb "blue"
+__EOC__
+}
+
+# ----------------------------------------------------
+ddir="frames"
+
+rm $ddir/p???.png
+
+idx=0
+for angle in $(seq 0 5 360)
+do
+
+	fname=$(printf "%s/p%03d.png" $ddir $idx)
+
+	plot_this_pic $fname $angle
+
+	idx=$(( idx + 1 ))
+
+done
+
+convert -delay 10 $ddir/p???.png pickover.gif
+
+echo '[done]'
+
+# ------------------------------------------ EOJ -----
+
+
+
+
+

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