dernier commit avant le Gers

BloubWorld/Makefile

@@ -7,7 +7,7 @@ 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'
 
 # ------------------------------------------------------------
@@ -37,9 +37,6 @@ 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)

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,17 +31,23 @@ 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
 #
@@ -54,3 +60,8 @@ t_centermag:	t_centermag.f90 Makefile libtth90modules.a
 
 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/t.f90

@@ -1,35 +0,0 @@
-program t
-
-  use      centermag
-  implicit none
-
-  type(t_centermag)      :: cmag
-
-  print *, '====== programme de test ======'
-
-  cmag%wscr = 800
-  cmag%hscr = 600
-
-  call essai_centermag(cmag)
-  print *
-
-  STOP ': PAF LE CHIEN ?'
-
-!       --------------
-contains
-!       --------------
-subroutine essai_centermag(cm)
-    type(t_centermag), intent(in)   :: cm
-
-    real                            :: rx, ry
-
-    call  print_centermag (cm)
-    print *
-
-    call  centermag_scr2real(1, 1, rx, ry)
-    print *, 'to real  :', rx, ry
-
-end subroutine
-!       --------------
-
-end program

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