dernier commit avant le Gers

BloubWorld/.gitignore

@@ -8,6 +8,7 @@ nbimg.inc
 *.lst
 *.wav
 *.xyz
+*.ssv
 frames/*
 log.*
 

BloubWorld/Makefile

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

BloubWorld/README.md

@@ -41,17 +41,25 @@ 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)
+([source](genbloubs.f90))
 
 ### movebloubs
 
-Le cœur actif du système : c'est lui qui, à chaque tick, va déplacer
+Il ne fait que deux choses : à chaque tick, va déplacer
-les bloubs, gérer les rebonds avec la boudary-box, éliminer les
+les bloubs et faire naitre de nouveaux bloubs
-bloubs usés par les chocs, et faire naitre de nouveaux bloubs
 si le besoin s'en fait sentir.
 Seul problème, il n'a pas de notion directe du temps, parce qu'il est juste de passage dans un pipeline.
-[source](movebloubs.f90)
+([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
 
@@ -60,19 +68,14 @@ 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)
+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).
 
-### mergebloubs
-
-Alors, celui-ci, il n'est pas vraiment au point. Il faut tout ré-écrire
-et faire gaffe à l'explosion quadratique.
-[source](mergebloubs.f90)
-
 ## TODO
 
 - Concevoir un système de _bouding box_ facile à utiliser

BloubWorld/bloubspace.f90

@@ -31,6 +31,8 @@ module bloubspace
   ! ----------------------------------------------------------------
 
   subroutine load_boundingbox(infile, where, name)
+    implicit none
+
     character(*), intent(in)            :: infile
     type(t_boundingbox), intent (out)   :: where
     character(8), intent(in)            :: name
@@ -73,6 +75,7 @@ module bloubspace
   !             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
 
@@ -81,25 +84,30 @@ module bloubspace
     blb%py = coefxyz * (rand() - 0.50)
     blb%pz = coefxyz * (rand() - 0.50)
 
-    blb%vx = (rand()) / 5.000
+    blb%vx = (rand() / 9.000)
-    if (blb%px .LT. 0.0) blb%vx = -blb%vx
+    ! if (blb%px .LT. 0.0) blb%vx = -blb%vx
 
-    blb%vy = 0.2 + (rand()) / 8.000
+    blb%vy = -0.10 + (rand() / 11.000)
-    if (blb%py .LT. 0.0) blb%vy = -blb%vy
+    ! if (blb%py .LT. 0.0) blb%vy = -blb%vy
 
-    blb%vz = (rand()) / 5.000
+    blb%vz =  (rand() / 10.000)
-    if (blb%pz .LT. 0.0) blb%vz = -blb%vz
+    ! if (blb%pz .LT. 0.0) blb%vz = -blb%vz
+
+    blb%red   = mod(irand(), 256)
+    blb%green = 127 + mod(irand(), 127)
+    blb%blue  = mod(irand(), 256)
 
     blb%state  = 0
     blb%alive  = .TRUE.
     blb%age    = 0
-    blb%agemax = 100
+    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
@@ -131,7 +139,7 @@ module bloubspace
     enddo
 
     close(output)
-    write(0, '(1X, "spitted ", I0, " bloubs to .", A)')       &
+    write(0, '(1X, "spitted ", I0, " bloubs to ", A)')       &
                              spitted,            trim(fname) 
 
   end subroutine spit_bloubs_to_file
@@ -139,6 +147,7 @@ module bloubspace
   !        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
@@ -167,7 +176,7 @@ module bloubspace
       read (unit=input, iostat=errcode, iomsg=chaine) bloub
       if (0 .ne. errcode) then
         ! may be we got an EOF ?
-        ! write(0, '(" got errcode on read ", (I8,1X,A))') errcode, chaine
+        ! write(0, '("errcode on read ", (I0,1X,A))') errcode, chaine
         exit
       endif
       nbread = nbread + 1
@@ -189,6 +198,7 @@ module bloubspace
   !        Display a bloub content to stderr
 
   subroutine display_bloub (blb, message)
+    implicit none
     type(t_bloubs), intent (in)  :: blb
     character(*),   intent (in)  :: message
 
@@ -212,6 +222,7 @@ module bloubspace
   !		Deplacement d'un bloub
   !-
   subroutine move_bloub (blb, coef)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
     real,           intent (in)     :: coef
 
@@ -220,6 +231,9 @@ module bloubspace
     blb%py  = blb%py + (blb%vy * coef)
     blb%pz  = blb%pz + (blb%vz * coef)
 
+    ! faire vieillir le bloub
+    blb%age = blb%age + 1
+
   end subroutine
   ! ----------------------------------------------------------------
   ! 
@@ -229,10 +243,11 @@ module bloubspace
   !     vitesse. XXX
   ! 
   subroutine bound_a_bloub (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
 
     real, parameter      :: SH = 6.0
-    real, parameter      :: SV = 4.0
+    real, parameter      :: SV = 6.0
 
     logical              :: flag
 
@@ -242,6 +257,7 @@ module bloubspace
     if ((blb%px + blb%radius) .GT. SH) then
       blb%vx = -1.0 * blb%vx
       blb%px = SH - blb%radius
+      flag = .TRUE.
     endif
     if ((blb%px - blb%radius) .LT. -SH) then
       blb%vx = -1.0 * blb%vx
@@ -275,12 +291,18 @@ module bloubspace
 
     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
 
@@ -298,6 +320,7 @@ module bloubspace
   !          kill a bloub under condition(s)
 
   subroutine green_soylent (blb)
+    implicit none
     type(t_bloubs), intent (inout)  :: blb
 
     if (blb%age .gt. 240) then
@@ -306,7 +329,7 @@ module bloubspace
 
     ! this is juste a molly-guard, don't worry
     ! 
-    if (blb%radius .GT. 4.0) then
+    if (blb%radius .GT. 5.0) then
       blb%alive = .FALSE.
     endif
   end subroutine

BloubWorld/essai.f90

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

BloubWorld/exportbloubs.f90

@@ -34,7 +34,8 @@ program exportbloubs
     endif
     if (bloub%alive) then
       print *, bloub%px, bloub%py, bloub%pz, bloub%radius,     &
-               bloub%age, bloub%state
+               bloub%age, bloub%state, "   ",                  &
+               bloub%red, bloub%green, bloub%blue
       compte = compte + 1
     endif
   enddo

BloubWorld/genbloubs.f90

@@ -33,8 +33,8 @@ program genbloubs
 
     bloub%nick    = 'noname  '
     bloub%num     = i + 41
-    call make_a_random_bloub(bloub, 8.25)
+    call make_a_random_bloub(bloub, 11.80)
-    bloub%radius  = 0.015 + (0.08*rand())
+    bloub%radius  = 0.010 + (0.12*rand())
 
     write(idu) bloub              ! no error control ?
 

BloubWorld/listbloubs.f90

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

BloubWorld/mathstuff.f90

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

BloubWorld/mergebloubs.f90

@@ -5,6 +5,7 @@ program mergebloubs
           !-------------------------------------------!
 
   use bloubspace
+  use mathstuff2
   implicit none
 
   integer, parameter       :: NB_MAX_BLOUBS = 250000
@@ -24,9 +25,11 @@ program mergebloubs
   call getarg(1, infile)
   call getarg(2, outfile)
 
-  write(0, '(A, 2A15, I8)') "### mergebloubs ",        &
+  write(0, '(A, A, 1X, A, 1X, I6)') "### mergebloubs ",        &
                  trim(infile), trim(outfile), NB_MAX_BLOUBS
 
+  call init_random_seed()
+
   allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY"
@@ -52,6 +55,8 @@ program mergebloubs
         write(0, *) "  *** merged ", ia, " and ", ib,       &
                     "   new r = ",  merged%radius
 
+        ! call display_bloub (bloubs(ia), "juste merged")
+
       endif
 
     enddo
@@ -70,6 +75,7 @@ program mergebloubs
 contains
 
   subroutine merge_two_bloubs(bla, blb, blr)
+      implicit none
       type(t_bloubs), intent(in)   :: bla, blb
       type(t_bloubs), intent(out)  :: blr
 
@@ -91,8 +97,13 @@ contains
       blr%vx = (bla%vx + blb%vx) / 2.0
       blr%vy = (bla%vy + blb%vy) / 2.0
       blr%vz = (bla%vz + blb%vz) / 2.0
+      if (0.001 .GT. rand()) then
+         blr%vx = blr%vx * 1.04
+         blr%vy = blr%vy * 1.04
+         blr%vz = blr%vz * 1.04
+      endif
 
-      blr%radius = (va + vb) ** 0.33333333333
+      blr%radius = (va + vb) ** 0.33335
       blr%age = min(bla%age, blb%age)
 
       ! bring it to life !

BloubWorld/movebloubs.f90

@@ -2,7 +2,7 @@ program movebloubs
 
   use bloubspace
   use povstuff
-  use mathstuff
+  use mathstuff2
 
   implicit none
 
@@ -14,8 +14,6 @@ program movebloubs
   ! logical                  :: add_new_bloub = .TRUE.
   real                     :: rnd
 
-  call init_random_seed()
-
   i = IARGC()
   if (i .ne. 2) then
     STOP ": BAD ARGS ON COMMAND LINE"
@@ -26,6 +24,8 @@ program movebloubs
   write (0, '(A)') &
   "### moving bloubs from "//trim(infile)//" to "//trim(outfile)
 
+  call init_random_seed()
+
   open(newunit=inu,                                          &
                   file=trim(infile), form='unformatted',     &
                   iostat=errcode,                            &
@@ -61,10 +61,14 @@ program movebloubs
     ! moving, morphing and boundingboxing
     call move_bloub     (bloub, 0.185)
     call bound_a_bloub  (bloub)
-    if (bloub%radius .GT. 0.0238) then
+    if (bloub%radius .GT. 3.50) then
       bloub%radius = bloub%radius * 0.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!"
@@ -94,8 +98,15 @@ program movebloubs
   ! ok, we have read all the bloubs from the input file
 
   ! insert some fancy conditional here
-  if (compteur .LT.  200) then
+  if (compteur .LT. 50) then
-    call add_more_bloubs(outu, 5, 0.032)
+    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)
@@ -104,20 +115,22 @@ program movebloubs
 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(), 3)
+  count = nbre+mod(irand(), 2)
-  write(0, '(A,I4,1X,A)') "movebloubs adding", count, "bloubs"
+  write(0, '(1X,A,I0,1X,A)') "movebloubs: adding ", count, " bloubs"
 
   do foo=1, count
 
     bloub%nick = 'newbie  '
-    call make_a_random_bloub(bloub, 7.12)
+    call make_a_random_bloub(bloub, 10.00)
-    bloub%radius = rayon + (0.09*rand())
+    bloub%radius = rayon + (0.11*rand())
     bloub%age   = 1
+    bloub%agemax = 160 + (count * 4)
     bloub%alive = .TRUE.
     bloub%num   = mod(irand(), 42)
     write(un) bloub              ! no error control ?

BloubWorld/plotworld.sh

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

BloubWorld/povstuff.f90

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

BloubWorld/runme.sh

@@ -34,7 +34,7 @@ printf "\n#declare NbImg = %d;\n" $NBIMG > WS/nbimg.inc
 #    first, we have to make a seminal buch of bloubs
 #    --> this function need to be parametrizable
 #
-./genbloubs ${BLBS_IN}  666
+./genbloubs ${BLBS_IN}  2
 
 for idx in $(seq 0 $((NBIMG-1)) )
 do
@@ -75,14 +75,14 @@ do
 			-annotate +45+5 "BloubWorld"	\
 			$PNG
 
-	echo $PNG '[done]'
+	echo ' ' $PNG '[done]'
 
 	./movebloubs ${BLBS_IN} ${BLBS_OUT}
 	./mergebloubs ${BLBS_OUT} ${BLBS_IN}
 	# mv ${BLBS_OUT} ${BLBS_IN}
 
 	echo "### run done"
-	sleep 5
+	sleep 35
 
 done
 

BloubWorld/scene.pov

@@ -47,7 +47,7 @@ union {
 cylinder { 0, -y, 30
 	texture {
 		pigment { color srgb <0.225, 0.244, 0.211> } 
-		finish { phong 0.18 metallic 0.25 reflection 0.15 }
+		finish { phong 0.18 metallic 0.25 reflection 0.10 }
 		}
 translate -6.20*y
 }
@@ -61,17 +61,18 @@ sky_sphere {
 
 #declare Croisillon = object
 {
+#local SC = 0.75;
 union	{
-	cylinder { -1*x, 1*x, 0.04 }
+	cylinder { -SC*x, SC*x, 0.04 }
-	cylinder { -1*y, 1*y, 0.04 }
+	cylinder { -SC*y, SC*y, 0.04 }
-	cylinder { -1*z, 1*z, 0.04 }
+	cylinder { -SC*z, SC*z, 0.04 }
 	}
 texture	{
 	pigment { color Gray50 }
 	}
 }
 
-object { Croisillon scale 0.80 translate <Bary_X, Bary_Y, Bary_Z> }
+object { Croisillon scale 0.90 translate <Bary_X, Bary_Y, Bary_Z> }
 
 //  ----------------------------------------------------------
 
@@ -130,10 +131,10 @@ union	{
 	object { Montants }
 
 	#local G = Green * 0.80;
-	object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue }  }
+	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 }   }
+	object { Une_Borne translate < BH, 0,  BH> pigment { color Red*0.9 }   }
 	}
 }
 

BloubWorld/toinc.awk

@@ -20,16 +20,16 @@ BEGIN	{
 	merged = $6
 
 	color = "Cyan"
-	if (age < 18)		color = "Gray40"
-	if (age <  2)		color = "Gray10"
 	if (merged) {
-		if (age > 120)	color = "Orange"
+		if (age > 150)	color = "Orange"
 		else		color = "Yellow"
 		}
 	else	{
-		if (age > 120)	color = "Black"
+		if (age > 150)	color = "DarkGreen"
 		else		color = "Aquamarine"
 		}
+	if (age < 18)		color = "Gray40"
+	if (age <  9)		color = "Blue"
 
 	bx += $1
 	by += $2
@@ -43,7 +43,7 @@ BEGIN	{
 END	{
 	# print "\t}\n"
         print "\t} // end of union\n"
-	print "finish { phong 0.67 specular 0.57 }\n"
+	print "finish { phong 0.57 specular 0.67 }\n"
         print "}\n"
 	print "#declare Nb_Bloubs = ", count, ";\n"
 	print "#declare Bary_X = ", bx/count, ";";

Fraktalism/.gitignore

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

Fraktalism/Makefile

@@ -38,12 +38,22 @@ plotcolmap:	plotcolmap.f90 Makefile $(OBJDEP)
 
 # ---------------------------------------------
 
+mkjulia:	mkjulia.f90 Makefile $(OBJDEP)
+	gfortran $(GFOPT) $<  $(OBJS)    -o $@
+
+xjulia.pnm:	mkjulia Makefile
+	./mkjulia $@ -0.204365 0.321463
+
+# ---------------------------------------------
+
 henon:		henon.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-mkjulia:	mkjulia.f90 Makefile $(OBJDEP)
+mkhenon:	mkhenon.f90 Makefile $(OBJDEP)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
+# ---------------------------------------------
+
 pickover:	pickover.f90 Makefile $(OBJDEP) 
 	gfortran $(GFOPT) $<  $(OBJS)   -o $@
 

Fraktalism/README.md

@@ -6,6 +6,20 @@ Voyons d'abord
 [une vidéo](http://la.buvette.org/fractales/f90/video.html)
 qui montre ma première expérience dans ce domaine.
 
+## Trucs à voir
+
+La fractale de Julia se porte plutôt bien, mais les travaux continuent.
+
+* [mkjuliagif.sh](mkjuliagif.sh) : fabrication de la gif animée
+* [julias.f90](julias.f90) : fonctions de dessin d'une Julia 
+* [mkjulia.f90](mkjulia.f90) : le programme principal
+
+**Q:** pourquoi faire la boucle en shell plutôt qu'en Fortran ?
+
+**A:** Parce que je peux recompiler le binaire `mkjulia` pendant le
+déroulement de la boucle, une manière comme une autre de faire
+du *livecoding*.
+
 ## La technique
 
 Le gros des calculs de fractales est fait dans `mods/fraktals.f90`,
@@ -34,7 +48,7 @@ Generally writen as a *sequencial unformated* file.
 
 ## TODO
 
-- Voir de près le calcul du cadrage 
+- Voir de près le calcul du cadrage : [centermag](../Modules/centermag.f90) 
 - Rajouter des formules
 - Ne pas procastiner sur le reste
 

Fraktalism/encode.sh

@@ -36,7 +36,7 @@ TITLE='---{ experimental }---'
 
 ffmpeg  -nostdin					\
 	-loglevel warning				\
-	-y -r 30 -f image2 -i $SDIR/%05d.pnm 		\
+	-y -r 30 -f image2 -i $SDIR/%05d.png 		\
 	-metadata artist='---{ tTh }---'		\
 	-metadata title="${TITLE}"			\
  	-preset veryslow				\

Fraktalism/fraktals.f90

@@ -137,6 +137,7 @@ subroutine interp4dp (ina, inb, out, dpk)
 
 end subroutine
 !-----------------------------------------------------------
+!-
 
 function dist0 (x, y)
   implicit none
@@ -146,6 +147,8 @@ function dist0 (x, y)
 end function
 
 !-----------------------------------------------------------
+!-
+
 function modulus2(pt)
   implicit none
   complex, intent(in)    ::   pt

Fraktalism/henon.f90

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

Fraktalism/julias.f90

@@ -1,4 +1,6 @@
 module julias
+
+  use fraktals
   implicit none
   contains
 
@@ -42,37 +44,47 @@ subroutine simple_julia(pic, cx, cy, maxiter)
           if (over_iter) then
             pic(ix, iy) = 0
           else
-            pic(ix, iy) = iter*12
+            pic(ix, iy) = mod(iter*13, 256)
           endif
       enddo      ! iy
     enddo        ! ix
 
 end subroutine simple_julia
 !===============================================================
-subroutine julia_colormapped(pic, cx, cy, maxiter)
+!-
+!	this code is nor really finished
+!-
+subroutine julia_colormapped(pic, cx, cy, mag, maxiter)
     use pixrgb
     type(t_pixrgb), intent(inout), dimension (:,:)  ::  pic
-    real, intent(in)                                ::  cx, cy
+    real, intent(in)                                ::  cx, cy, mag
     integer, intent(in)                             ::  maxiter
 
-    integer      ::  ix, iy, width, height
+    integer      ::  ix, iy, width, height, iter
-    real         ::  fx, fy
+    real         ::  fx, fy, div, off
     complex      ::  Z, C
-    integer      ::  iter
     logical      ::  over_iter
+    integer      ::  under, over
+
+    pic = t_pixrgb(0, 0, 0)
 
     width  = ubound(pic, 1)
     height = ubound(pic, 2)
     C = complex(cx, cy)
-    print *, "Color julia, const = ", C
+
+    div = mag * 10.0    ;     off = mag * 2.5
+    under = 0          ;     over = 0
+    print *, "mag:", mag, " -> ", div, off
+
+    ! print *, "Color julia, const = ", C
     do ix = 1, width
-      fx = (float(ix) / (float(width*2)/4.0) - 1.0)
+      fx = (float(ix) / (float(width*2)/div) - off)
       do iy = 1, height
-        fy = (float(iy) / (float(height*2)/4.0) - 1.0)
+        fy = (float(iy) / (float(height*2)/div) - off)
           ! ------ traitement du pixel
           iter = 0  ; over_iter = .FALSE.
           Z = complex(fx, fy)
-          do while ((real(Z)*real(Z) + imag(Z)*imag(Z)) .LT. 4.0) 
+          do while ((real(Z)*real(Z) + (imag(Z)*imag(Z))) .LT. 4.0) 
             Z = (Z * Z) + C
             iter = iter + 1
             if (iter .GE. maxiter) then
@@ -81,17 +93,22 @@ subroutine julia_colormapped(pic, cx, cy, maxiter)
             endif
           end do
           if (over_iter) then
-            pic(ix, iy)%r = 0
+            pic(ix, iy)%r = mod(int(modulus2(Z)*2000.0), 255)
-            pic(ix, iy)%g = mod(abs(int(real(Z) *140)), 255)
+            pic(ix, iy)%g = mod(abs(int(real(Z) *11.0)), 255)
-            pic(ix, iy)%b = mod(abs(int(aimag(Z)*140)), 255)
+            pic(ix, iy)%b = mod(abs(int(aimag(Z)*11.0)), 255)
+            print *, ix, iy, Z, modulus2(Z)
+            over = over + 1
           else
-            pic(ix, iy)%r = mod(iter*33, 255)
+            pic(ix, iy)%r = mod(iter*11, 255)
-            pic(ix, iy)%g = mod(iter*59, 255)
+            pic(ix, iy)%g = mod(iter*14, 255)
-            pic(ix, iy)%b = mod(iter*41, 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/mkhenon.f90

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

Fraktalism/mkjulia.f90

@@ -26,11 +26,15 @@ program julia
     call getarg(2, string)       ;   read (string, *) cx
     call getarg(3, string)       ;   read (string, *) cy
 
-    allocate(picz(512, 342))
+    allocate(picz(1280, 1024))
 
-    call julia_colormapped(picz, cx, cy, 500)
+    call julia_colormapped(picz, cx, cy, 0.600, 1000)
     call rgbpix_spit_as_pnm_8(picz, trim(filename))
 
+  contains
+
+!-----------------------------------------------------
+
 end program
 
 !-----------------------------------------------------

Fraktalism/mkjuliagif.sh

@@ -3,7 +3,6 @@
 #
 #	build the prog
 #
-
 make mkjulia
 if [ $? -ne 0 ] ; then
 	echo
@@ -11,28 +10,52 @@ if [ $? -ne 0 ] ; then
 	exit 1
 fi
 
+cxa=" -1.5432 "	;	cya=" -0.8999 "
+cxb="  1.0975 "	;	cyb="  1.5091 "
+nbi=" 2000 "
+tmpimg="/dev/shm/juliatmp.pnm"
+
+rm frames/julia/*
+
 #
 #	run the prog
 #
 workdir="frames/julia/"
-for foo in $(seq 0 179)
+for foo in $( seq 0 $(( nbi - 1)) )
 do
+	Ka=$( echo "$foo / $nbi"			| bc -l)
+	Kb=$( echo "1.0 - $Ka"				| bc -l)
+	# echo $Ka $Kb
+	cx=$(echo "($cxa*$Ka) + ($cxb*$Kb)"		| bc -l)
+	cy=$(echo "$cya*$Ka + $cyb*$Kb"			| bc -l)
 
-	img=$(printf "%s/%05d.pnm" $workdir $foo)
+	# make mkjulia
-	bar=$(echo "$foo / 247.0"			| bc -l)
-	cx=$(echo "0.5 * (1.52*c($foo/28.0))"		| bc -l)
-	cy=$(echo "0.5 * (1.45*s($foo/17.0))"		| bc -l)
 
-	./mkjulia $img $cx $cy
+	printf "%5d  %4.6f %4.6f     %4.6f  %4.6f\n"		\
+		$foo $Ka $Kb         $cx $cy
+	./mkjulia $tmpimg $cx $cy
+	echo
 
-	sleep 145
+	img=$(printf "%s/%05d.png" $workdir $foo)
+	tcx=$(printf "%8.6f" $cx)
+	tcy=$(printf "%8.6f" $cy)
+
+	convert $tmpimg					\
+		-gravity North-East			\
+		-font Courier-Bold			\
+		-pointsize 20				\
+		-fill Yellow				\
+		-annotate +15+34 $tcx			\
+		-annotate +15+58 $tcy			\
+		-gravity South-East			\
+		-font Courier				\
+		-pointsize 14				\
+		-fill Yellow				\
+		-annotate +10+6 "Konrad+tTh 2024"	\
+		$img
 
 done
 
-./tagpicz.sh $workdir
-
 echo ; echo "Encoding, please wait..."
 
-convert -delay 10 $workdir/*.pnm color-julia.gif
+./encode.sh frames/julia/ foo.mp4
-# animate foo.gif &
-

Fraktalism/tagpicz.sh

@@ -17,10 +17,10 @@ do
 
 	mogrify						\
 		-gravity South-East			\
-		-font Courier				\
+		-font Courier-Bold			\
 		-pointsize 12				\
-		-fill firebrick				\
+		-fill Black				\
-		-annotate +10+10 "Konrad+tTh 2023"	\
+		-annotate +10+4 "Konrad+tTh 2024"	\
 		$img
 	echo "tagging " $img
 

GrafAnim/.gitignore

@@ -6,6 +6,7 @@ trigofest
 noisepic
 geowaves
 soundscope
+readpicz
 
 *.scratch
 *.genplot
@@ -16,4 +17,5 @@ F/*.tga
 *.pgm
 *.data
 *.png
+log.txt
 

GrafAnim/Makefile

@@ -24,10 +24,7 @@ trigofest:	trigofest.f90 Makefile vue3axes.o utils_ga.o
 	gfortran $(GFOPT) $<  $(MYLIB) utils_ga.o -o $@
 
 noisepic:	noisepic.f90  Makefile
-	gfortran $(GFOPT) $< $(MYLIB)			\
+	gfortran $(GFOPT) $< $(MYLIB) -o $@
-		-o $@
-
-# ---- bienvenue dans le monde applicatif
 
 wavmetrics.o:	wavmetrics.f90 Makefile
 	gfortran $(GFOPT) -c $<
@@ -35,6 +32,9 @@ wavmetrics.o:	wavmetrics.f90 Makefile
 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

GrafAnim/README.md

@@ -3,12 +3,16 @@
 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.
+une notion bien définie par le collectif **Interhack**.
 
-Actuellement, certains des logiciels que vous voyez ici utilisent un backend
+Actuellement, certains des logiciels que vous voyez ici utilisent un backend graphique brassé
-graphique brassé à la maison et nommé `genplot2`. Hélas, celui-ci est
+[à la maison](https://git.tetalab.org/tTh/libtthimage)
+et nommé `genplot2`. Hélas, celui-ci est
 un peu foireux sur les tracés de ligne...
 
+## geowaves
+
+Une idée en l'air, probablement...
 
 ## trigofest
 
@@ -20,15 +24,11 @@ que c'est d'la balle !
 
 Ou comment dessiner des gaussiennes en jetant des dés.
 
-## vue3axes
-
-Un module assez spécialisé.
-
 ## soundscope
 
-Retranscription en image de type oscilloscope d'un fichier son.
+Une tentative de retranscription en image de type oscilloscope/vumètre d'un fichier son.
-Le code source ([soundscope.f90](soundscope.f90)) est encore
+Les codes source du proggy ([soundscope.f90](soundscope.f90)) et du 
-bien gore.
+[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/essai.f90

@@ -1,5 +1,9 @@
 program essai
 
+! *******************************************
+!      CE TRUC NE MARCHE PAS /O\
+! *******************************************
+
   use pixrgb
   implicit none
 
@@ -60,6 +64,7 @@ subroutine setpixel(pic, x, y)
                .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

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/readpicz.f90

@@ -0,0 +1,59 @@
+program readpicz
+
+  use pixrgb
+  implicit none
+
+  integer                   :: nbarg
+  integer                   :: param0 = 10
+  character(len=256)        :: arg
+
+  ! integer                   :: foo, bar
+
+  integer                   :: width  = 640
+  integer                   :: height = 480
+  integer                   :: x, y, r, g, b
+  integer                   :: errcode
+  character (len=280)       :: filename
+  type(t_pixrgb), allocatable      :: pix(:,:)
+
+  filename = "out.pnm"
+
+  nbarg = IARGC()
+  if (nbarg .GT. 0) then
+       call GETARG(1, arg)
+       ! write (0, '(A40, A5)') "argument = ",  arg
+       read (arg, *) param0
+  endif
+
+  allocate(pix(width, height))
+
+  do
+    !----- get a pixel
+    read(5, *, iostat=errcode) x, y, r, g, b
+    ! print *, x, y
+    if (0 .NE. errcode) then
+      write(0, *) "iostat", errcode
+      exit
+    endif
+    if (mod(y, 2) .EQ. 1) then
+      pix(x+1, y+1)%r = g * 200
+      pix(x+1, y+1)%g = b * 200
+      pix(x+1, y+1)%b = r * 200
+    else
+      pix(x+1, y+1)%r = g * 200
+      pix(x+1, y+1)%g = r * 200
+      pix(x+1, y+1)%b = b * 200
+    endif
+
+  enddo
+
+  call rgbpix_spit_as_pnm_16(pix, trim(filename))
+
+contains
+! ----------------------------------------------------------
+
+
+! ----------------------------------------------------------
+
+end program
+

GrafAnim/soundscope.f90

@@ -9,11 +9,13 @@ program soundscope
 
   implicit none
 
-  integer                       :: width  = 720
+  integer                       :: width       = 800
-  integer                       :: height = 576
+  integer                       :: height      = 600
-  integer                       :: marge  = 32
+  integer                       :: marge       = 32
-  integer                       :: samplerate = 44100
+  integer                       :: samplerate  = 44100
-  integer                       :: framerate = 30
+  integer                       :: framerate   = 30
+
+  integer, parameter            :: overtrig    = 25200
 
   type(t_pixrgb), allocatable   :: pix(:,:)
   character (len=280)           :: filename
@@ -21,11 +23,14 @@ program soundscope
   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)
+  ! call fill_random_gauss(pix, 65000, marge)
 
   iter = 0
   do 
@@ -46,13 +51,19 @@ program soundscope
     enddo
 
     call dim_pix_rgb_mul(pix, 0.86)
-    if (mod(iter, 180) .LT. 90) then
-      call make_a_frame_dplot(pix, smppf, flagdone)
-    else
-      call make_a_frame_xy(pix, smppf, flagdone)
-    endif
 
-    call dessine_cadre(pix, 65000, 65000, 65000, marge)
+    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)
 
@@ -60,13 +71,17 @@ program soundscope
       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(:,:)
@@ -88,15 +103,16 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
     endif
 
     !   add flash !
-    if ( (idx .LT. 100)       .AND.       &
+    if ( (idx .LT. 50)       .AND.       &
-       ((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
+       ((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
-      write(0,*) "overshoot!"
+      write(0,*) "overshoot in xy!"
       call fill_random_gauss(image, 65000, marge)
     endif
 
     ! scale it to the window
-    ix = width - ((2 * int(vl / 111.111)) + 400)
+    ix = int((vl/65536.9) * real(width))   + width/2
-    iy = (2 * int(vr / 166.666)) + 300
+    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
@@ -105,9 +121,73 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
 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
@@ -129,8 +209,8 @@ subroutine make_a_frame_dplot(image, nbdata, jobdone)
     endif
     !   add flash !
     if ( (idx .LT. 100)       .AND.       &
-       ((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
+       ((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
-      write(0,*) "overshoot!"
+      write(0,*) "overshoot in dplot!"
       call fill_random_gauss(image, 65000, marge)
     endif
 
@@ -183,7 +263,7 @@ subroutine dessine_cadre(image, R, G, B, border)
 end subroutine
 
 !-- ------------------------------------------------------------------
-
+!-- ------------------------------------------------------------------
 function is_pixel_inside(ix, iy)
   integer,intent(in)        :: ix, iy
   logical                   :: is_pixel_inside
@@ -200,8 +280,6 @@ function is_pixel_inside(ix, iy)
 
 end function
 
-!-- ------------------------------------------------------------------
-
 
 !-- ------------------------------------------------------------------
 

GrafAnim/t_readpicz.sh

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

GrafAnim/utils_ga.f90

@@ -3,6 +3,7 @@
 ! -------------------------------------------------------------------
 
 module utils_ga
+
   use pixrgb
   implicit none
 
@@ -33,7 +34,25 @@ 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
 ! -------------------------------------------------------------------
@@ -104,6 +123,25 @@ subroutine dim_pix_rgb_sub(pix, k)
     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
 ! -------------------------------------------------------------------
 

Modules/.gitignore

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

Modules/Makefile

@@ -6,7 +6,7 @@
 
 GFOPT  =  -Wall -Wextra -g -I.
 
-all:	chkpixels trnd    t
+all:	chkpixels trnd twavm
 
 # ---------------------------------------------------------
 
@@ -31,26 +31,37 @@ mathstuff2.o:	mathstuff2.f90 Makefile
 noisepictures.o:	noisepictures.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
+# new: Wed Feb  7 01:27:48 UTC 2024
+wavmetrics.o:		wavmetrics.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
 #----------------------------------------------------------
 #	making a fluffy archive
 #
 OBJECTS =	spitpgm.o		pixrgb.o	\
 		centermag.o		dummy.o		\
 		trials.o		mathstuff2.o	\
-		noisepictures.o
+		noisepictures.o		wavmetrics.o
 
 libtth90modules.a:	$(OBJECTS) Makefile
 	$(AR) 	rs $@ $?
 
+#	please explain the 'ar' command line
+
 #----------------------------------------------------------
 #     programmes de testouille
 #
 
 chkpixels:	chkpixels.f90 Makefile libtth90modules.a
-	gfortran $(GFOPT) $<  libtth90modules.a -o $@
+	gfortran $(GFOPT) -pg $<  libtth90modules.a -o $@
 
-t:		t.f90 Makefile libtth90modules.a
+t_centermag:	t_centermag.f90 Makefile libtth90modules.a
 	gfortran $(GFOPT) $<  libtth90modules.a -o $@
 
 trnd:		trnd.f90 Makefile libtth90modules.a
 	gfortran $(GFOPT) $<  libtth90modules.a -o $@
+
+# new: Wed Feb  7 01:27:48 UTC 2024
+twavm:		twavm.f90 Makefile libtth90modules.a
+	gfortran $(GFOPT) $<  libtth90modules.a -o $@
+

Modules/README.md

@@ -3,6 +3,11 @@
 
 ## Modules disponibles
 
+### wavmetrics
+
+This module try to make some computations on *stereo* buffers.
+
+This is just a [WIP](./wavmetrics.f90), see [twavm](./twavm.f90) for a no-use case.
 
 ### spitpgm
 
@@ -11,8 +16,7 @@ Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
 ### pixrgb
 
 Write 8 bits or 16 bits RGB pictures to PNM format.
-
+The width of the picture MUST be a multiple of 4 !
-**Warning!** The width of the picture MUST be a multiple of 4 !
 
 ### trials
 
@@ -26,11 +30,13 @@ or have a sane place to put a breakpoint with gdb
 
 ## Compiler un module
 
-You can use the same options as for a main program.
+*You can use the same options as for a main program.
 And when you use the module, you have to specify the paths
 for the .mod and the .o to the linker.
+*
+
 See [Makefile](./Makefile) for an example.
 
 ## TODO
 
-- écrire la doc !
+- write the fscking doc !

Modules/centermag.f90

@@ -2,6 +2,11 @@
 module centermag
     implicit none
 !-----------------------------------------------------------------------
+!-
+!   By definition, the default centermax (0, 0, 1) give us a
+!   (-1,-1), (1, 1) box, who is mapped to the screen size.
+!-
+!-----------------------------------------------------------------------
 !      definition of structures
 !-
 type t_centermag
@@ -13,16 +18,30 @@ type t_centermag
 end type
 !-------------------------------------------------------------------
 contains
+!-------------------------------------------------------------------
+subroutine init_centermag(cntmag, w, h, mag)
+    type(t_centermag),intent(out)     :: cntmag
+    integer, intent(in)               :: w, h        ! screen size
+    real, intent(in)                  :: mag
+
+    write(0, *) ">>> init centermag:", w, h
+
+    cntmag%wscr = w   ;   cntmag%hscr = h
+    cntmag%mag = mag
+
+end subroutine
+
 !-------------------------------------------------------------------
 subroutine  print_centermag (cm)
     type(t_centermag), intent(in)   :: cm
 
     print *, "Screen     ", cm%wscr, cm%hscr
     print *, "MagFactor  ", cm%mag
-    print *, "Center     ", cm%cx, cm%cy
+    ! print *, "Center     ", cm%cx, cm%cy
 
 end subroutine
 !-------------------------------------------------------------------
+!-------------------------------------------------------------------
 subroutine  centermag_scr2real (sx, sy, rx, ry)
     integer, intent(in)         ::  sx, sy
     real, intent(out)           ::  rx, ry

Modules/farbfeld.f90

@@ -0,0 +1,6 @@
+!-
+!-
+! https://linuxfr.org/users/devnewton/liens/farbfeld-le-format-d-image-le-plus-simple-du-monde
+! http://tools.suckless.org/farbfeld/
+!-
+

Modules/mathstuff2.f90

@@ -6,15 +6,15 @@ module mathstuff2
   implicit none
   contains
 
- ! ----------------------------------------------------------------
+! ----------------------------------------------------------------
- !   really quick'n'dirty hack
+!   really quick'n'dirty hack
- !                  not really tested yet...
+!                  not really tested yet...
-
   subroutine init_random_seed()
 
     integer, dimension(3) :: tarray
     integer               :: t3, foo
     real                  :: dummy
+
     call itime(tarray)
     t3 = 3600*tarray(1) + 60*tarray(2) + tarray(3)
     ! write(0, '(A,3I3,A,I6)') "sranding: ", tarray, " --> ", t3
@@ -28,8 +28,10 @@ module mathstuff2
 
   end subroutine 
 
-  ! ----------------------------------------------------------------
+! ----------------------------------------------------------------
-
+!-
+!-      May be I can make some generic procedures ?
+!-
 logical function diff_sign(a, b)
    integer, intent(in)     :: a, b
 
@@ -45,8 +47,6 @@ logical function diff_sign(a, b)
    diff_sign = .FALSE.
 
 end function
-
+! ----------------------------------------------------------------
-
-  ! ----------------------------------------------------------------
 end module mathstuff2
 

Modules/pixrgb.f90

@@ -116,12 +116,14 @@ end subroutine
 !-
 !          CAUTION: there was NO out-of-bounds check !
 !-
+!     The width of the picture MUST be a multiple of 4 !
+!-
 subroutine rgbpix_spit_as_pnm_16(pic, fname)
 
   type(t_pixrgb), intent(in)       ::  pic(:,:)
   character (len=*), intent(in)    ::  fname
 
-  integer                          ::  io, ix, iy, ik
+  integer                          ::  io, ix, iy
   integer                          ::  buffer(3*4), ptr
 
   ! write(0, *) ">>> subroutine rgbpix_spit_as_pnm_16"
@@ -150,7 +152,7 @@ subroutine rgbpix_spit_as_pnm_16(pic, fname)
     enddo    ! write(io, *) " fin iy=", iy
   enddo
 
-!   may be we have to flush the buffer ?
+! XXX  may be we have to flush our internal buffer ?
 
   close(unit=io)
 

Modules/t_centermag.f90

@@ -1,15 +1,9 @@
 program t
-
   use      centermag
   implicit none
-
   type(t_centermag)      :: cmag
 
-  print *, '====== programme de test ======'
+  print *, '====== programme de test centermag ======'
-
-  cmag%wscr = 800
-  cmag%hscr = 600
-
   call essai_centermag(cmag)
   print *
 
@@ -19,15 +13,13 @@ program t
 contains
 !       --------------
 subroutine essai_centermag(cm)
-    type(t_centermag), intent(in)   :: cm
+    type(t_centermag), intent(inout)   :: cm
-
+    real                               :: rx, ry
-    real                            :: rx, ry
 
+    call init_centermag(cm, 800, 600, 1.0)
     call  print_centermag (cm)
-    print *
 
-    call  centermag_scr2real(1, 1, rx, ry)
+    rx = 0.45   ;    ry = -1.098
-    print *, 'to real  :', rx, ry
 
 end subroutine
 !       --------------

Modules/test-wavm.sh

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

Modules/twavm.f90

@@ -0,0 +1,67 @@
+program twavm
+
+  ! new: Wed Feb  7 01:27:48 UTC 2024
+
+  use mathstuff2
+  use wavmetrics
+  implicit none
+
+  write(0, *)   "----------------- twavm -------------------"
+
+  call run_second_test(44100/30)
+ 
+contains
+!-----------------------------------------------------------------------
+
+subroutine run_first_test(nbs)
+  integer, intent(in)   :: nbs                ! nombre d'echantillons
+
+  type(intsample), allocatable     :: samples(:)
+  type(wavmetric)                  :: metrics
+  integer                          :: foo, bar
+
+  write(0, '(1X, "first test on ", I0, " samples.")') nbs
+
+! create the buffer, and fill it with garbage
+  allocate(samples(nbs))
+  do foo=1, nbs
+    samples(foo)%left   = mod(irand(), 65534) - 32700
+    samples(foo)%right  = mod(irand(), 60000) - 29999
+  enddo
+
+! compute and display the metrics (gi-go)
+  call compute_wavmetric(samples, nbs, metrics)
+  call display_wavmetrics(metrics)
+
+end subroutine
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!-
+!-  we read the datas from stdin
+!-
+subroutine run_second_test(nbs)
+  integer, intent(in)   :: nbs                ! nombre d'echantillons
+
+  type(intsample), allocatable     :: samples(:)
+  type(wavmetric)                  :: metrics
+  integer                          :: foo, bar
+  integer                          :: vl, vr
+
+  write(0, '(1X, "second test on ", I0, " samples.")') nbs
+
+! create the buffer, and fill it with stdin
+  allocate(samples(nbs))
+  do foo=1, nbs
+    read(5, *) vl, vr
+    ! print '(1X, 2I16)', vl, vr
+    samples(foo)%left   = vl
+    samples(foo)%right  = vr
+  enddo
+
+! compute and display the metrics (gi-go)
+  call compute_wavmetric(samples, nbs, metrics)
+  call display_wavmetrics(metrics)
+
+end subroutine
+!-----------------------------------------------------------------------
+end program

Modules/wavmetrics.f90

@@ -0,0 +1,85 @@
+
+module wavmetrics
+
+  ! new: Thu Jan  4 00:08:04 UTC 2024
+
+  use mathstuff2
+  implicit none
+
+  type wavmetric
+    integer             :: nbre             ! number of slices/samples
+    real                :: freql, freqr     ! zero-crossing estimation
+    integer             :: maxl,  maxr      ! maximum of abs values
+    real                :: meanl, meanr
+  end type
+
+  type intsample
+    integer             :: left, right
+  end type
+
+  contains
+!-------------------------------------------------------------
+!-
+!        main computation routine, still full buggy
+!-
+subroutine compute_wavmetric(samples, size, metrics)
+  type(intsample), intent(in)       :: samples(:)
+  integer, intent(in)               :: size
+  type(wavmetric), intent(out)      :: metrics
+
+  integer                           :: Lmax, Rmax
+  integer                           :: Lval, Rval
+  integer                           :: idx
+  integer                           :: Lfreq, Rfreq
+
+  real                              :: Lsum, Rsum
+
+  Lmax  = 0     ;   Rmax  = 0
+  Lfreq = 1     ;   Rfreq = 1
+  Lsum  = 0.0   ;   Rsum  = 0.0
+
+  do idx=1, size
+    Lval = samples(idx)%left
+    Rval = samples(idx)%right
+
+    ! print *, Rval, Lval
+    if (abs(Lval) .GT. Lmax)   Lmax = abs(Lval)
+    if (abs(Rval) .GT. Rmax)   Rmax = abs(Rval)
+
+    if (idx .GT. 1) then
+      if (diff_sign(samples(idx-1)%left,  Lval))  Lfreq = Lfreq + 1
+      if (diff_sign(samples(idx-1)%right, Rval))  Rfreq = Rfreq + 1
+    endif
+
+    Lsum = Lsum + Lval
+    Rsum = Rsum + Rval
+
+  enddo
+
+  metrics%nbre  = size
+  metrics%maxl  = Lmax   ;  metrics%maxr = Rmax
+  metrics%freql = 1.0 / (Lfreq / real(size))
+  metrics%freqr = 1.0 / (Rfreq / real(size))
+  metrics%meanl = Lsum / real(size)
+  metrics%meanr = Rsum / real(size)
+
+end subroutine
+
+!-------------------------------------------------------------
+
+subroutine display_wavmetrics(metrics)
+  type(wavmetric), intent(in)      :: metrics
+
+  ! print '(1X, "metrics are :")'
+
+  print '(1X, "    | nbre         ", I0)',     metrics%nbre
+  print '(1X, "    | freq         ", 2F12.2)', metrics%freql, metrics%freqr
+  print '(1X, "    | mean         ", 2F12.2)', metrics%meanl, metrics%meanr
+  print '(1X, "    | maxi         ", 2I8)',    metrics%maxl, metrics%maxr
+
+end subroutine
+
+!-------------------------------------------------------------
+!-------------------------------------------------------------
+
+end module

README.md

@@ -8,21 +8,31 @@ de Janvier 2022, et j'ai bien aimé. Bon, contrairement à la
 version de 77, les `GOTO`s sont moins agréables à faire, mais
 l'existence des _pointeurs_ compense largement.
 
-## content
+## Le contenu
 
+- [Modules](Modules/) : quelques composants de base.
 - [SoundBrotching](SoundBrotching/) : faire gémir vos tympans
 - [BloubWorld](BloubWorld/) : la vie des particules
 - [Fraktalism](Fraktalism/) : du chaos dans les pixels
 - [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret
 - [GrafAnim](GrafAnim/) : Ah, enfin de la gif89a en vue !
 
-## Prérequis
+## Utilisation
 
-- GNUtrucs : bash, make, awk... 
+- Prérequis de base, les GNUtrucs : gfortran, gcc, bash, make, awk...
+- Première chose à faire, compiler les [modules](Modules/README.md)
+  qui seront utilisés par les autres logiciels.
+- Et ensuite, à vous de jouer. Fouillez dans les dossiers en sachant
+  bien que beaucoup de ces trucs ne sont ni fait, ni à faire.
 
-## hotline
+## Hotline
 
 - Le canal `#tetalab` sur le réseau IRC de
 [Libera](https://libera.chat/)
 - La [mailing-list publique](https://lists.tetalab.org/mailman/listinfo/tetalab) du Tetalab.
 
+## Ressources
+
+  * [Fortran Programming Language](https://fortran-lang.org/)
+  * [Fortran Tips](https://zmoon.github.io/FortranTipBrowser/tips/index.html)
+

SoundBrotching/c-tools/Makefile

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

SoundBrotching/c-tools/README.md

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