soundscope, first try ok

GrafAnim/.gitignore

@@ -4,6 +4,8 @@ doubledice
 doublegauss
 trigofest
 noisepic
+geowaves
+soundscope
 
 *.scratch
 *.genplot

GrafAnim/Makefile

@@ -10,6 +10,9 @@ MYLIB = '../Modules/libtth90modules.a'
 essai:	essai.f90 Makefile
 	gfortran $(GFOPT) $< $(MYLIB) -o $@
 
+geowaves:	geowaves.f90 Makefile
+	gfortran $(GFOPT) $< $(MYLIB) -o $@
+
 doubledice:	doubledice.f90 Makefile	\
 		utils_ga.o usegenplot.o
 	gfortran $(GFOPT) $< usegenplot.o utils_ga.o -o $@
@@ -20,6 +23,9 @@ doublegauss:	doublegauss.f90 Makefile utils_ga.o
 trigofest:	trigofest.f90 Makefile vue3axes.o utils_ga.o
 	gfortran $(GFOPT) $<  $(MYLIB) utils_ga.o -o $@
 
+soundscope:	soundscope.f90 Makefile utils_ga.o
+	gfortran $(GFOPT) $<  $(MYLIB) utils_ga.o -o $@
+
 noisepic:	noisepic.f90  Makefile
 	gfortran $(GFOPT) $< $(MYLIB)			\
 		-o $@

GrafAnim/README.md

@@ -1,7 +1,8 @@
 # GrafAnim
 
 Quelques essais approximatifs pour faire des graphiques inutiles,
-dans une démarche mettant en avant la techno-futilité, une notion
+dans une démarche mettant en avant la
+[techno-futilité](https://wiki.interhacker.space/index.php?title=Techno-futilit%C3%A9), une notion
 bien définie par le collectif Interhack.
 
 Actuellement, certains des logiciels que vous voyez ici utilisent un backend
@@ -12,13 +13,19 @@ un peu foireux sur les tracés de ligne...
 ## trigofest
 
 Distorsions approximatives de la courbe de Lissajous.
-
+Expériences inspirées par [ce site](https://bleuje.com/tutorial1/)
-Expériences inspirées par  https://bleuje.com/tutorial1/ que c'est d'la balle !
+que c'est d'la balle !
 
 ## doubledice
 
-Ou comment dessiner des gaussiennes.
+Ou comment dessiner des gaussiennes en jetant des dés.
 
 ## vue3axes
 
-Un module assez spécialisé
+Un module assez spécialisé.
+
+## soundscope
+
+Retranscription en image de type oscilloscope d'un fichier son.
+
+

GrafAnim/soundscope.f90

@@ -0,0 +1,120 @@
+! *******************************************
+! 
+! *******************************************
+
+program soundscope
+
+  use pixrgb
+  use utils_ga
+
+  implicit none
+
+  integer                       :: width  = 640
+  integer                       :: height = 480
+  integer                       :: marge  = 10
+  type(t_pixrgb), allocatable   :: pix(:,:)
+  character (len=280)           :: filename
+  integer                       :: iter, foo, tx, ty
+  logical                       :: flag
+
+  allocate(pix(width, height))
+  ! call preparation(pix, 65000)
+
+  do iter=0, 450
+    write(0, *) "----- iteration", iter, "    -------------"
+
+!    do foo=0, 10
+!      tx = (marge/2) + fair_random_gauss(width-marge)
+!      ty = (marge/2) + fair_random_gauss(height-marge)
+!      call make_big_dot(pix, tx, ty)
+!    enddo
+
+    call dim_pix_rgb(pix, 1500)
+    call make_a_frame(pix, 300)
+
+    write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
+    call rgbpix_spit_as_pnm_16(pix, filename)
+
+  enddo
+
+contains
+!-- ------------------------------------------------------------------
+!--
+
+subroutine make_a_frame(image, nbdata)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer, intent(in)            :: nbdata
+  integer                        :: idx
+  real                           :: vl, vr
+  integer                        :: ix, iy
+
+  do idx=0, nbdata
+    read(5, *) vl, vr
+    ix = int((vl / 111.111) + 300)
+    iy = int((vr / 166.666) + 200)
+    ! write(6, *) vl, ix, "  |  ", vr, iy
+    call make_big_dot(image, ix, iy)
+  enddo
+
+end subroutine
+
+!-- ------------------------------------------------------------------
+
+subroutine make_big_dot(image, ix, iy)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer, intent(in)            :: ix, iy
+
+  image(ix, iy)%r = 12000
+
+  image(ix,   iy)%g   = 65000
+  image(ix-1, iy)%g   = 56000
+  image(ix,   iy-1)%g = 56000
+  image(ix+1, iy)%g   = 56000
+  image(ix,   iy+1)%g = 56000
+
+  image(ix, iy)%b = 24000
+
+end subroutine
+
+!-- ------------------------------------------------------------------
+
+subroutine preparation(image, mval)
+  type(t_pixrgb), intent(inout)  :: image(:,:)
+  integer,intent(in)             :: mval
+  integer                        :: ix, iy
+
+  write(0, *) "dim 1 =", ubound(image, 1)
+  write(0, *) "dim 2 =", ubound(image, 2)
+
+  do ix=1, ubound(image, 1)
+    do iy=1, ubound(image, 2)
+      image(ix, iy)%r = fair_random_gauss(mval)
+      image(ix, iy)%g = fair_random_gauss(mval)
+      image(ix, iy)%b = fair_random_gauss(mval)
+    enddo
+  enddo
+
+end subroutine
+
+!-- ------------------------------------------------------------------
+
+logical function diff_sign(a, b)
+   integer, intent(in)     :: a, b
+
+   ! write(0, *) "diff_sign", a, b
+   if ( (a .lt. 0) .and. (b .ge. 0) ) then 
+      diff_sign = .TRUE.
+      return
+   endif
+   if ( (a .ge. 0) .and. (b .lt. 0) ) then
+      diff_sign = .TRUE.
+      return
+   endif
+   diff_sign = .FALSE.
+
+end function
+
+!-- ------------------------------------------------------------------
+
+end program soundscope
+

GrafAnim/utils_ga.f90

@@ -22,8 +22,8 @@ function fair_random_gauss(hilevel)
   integer             :: fair_random_gauss
   integer             :: foo, bar
 
-  foo = int(rand()*hilevel/2)
+  foo = int((rand()*hilevel)/2)
-  bar = int(rand()*hilevel/2)
+  bar = int((rand()*hilevel)/2)
   fair_random_gauss = 1 + foo + bar
 
 end function
@@ -38,4 +38,27 @@ subroutine increment_pixel(pix, k)
 end subroutine
 ! -------------------------------------------------------------------
 
+subroutine dim_pix_rgb(pix, k)
+  type(t_pixrgb), intent(inout)  :: pix(:,:)
+  integer,intent(in)             :: k
+  integer                        :: ix, iy
+
+  ! write(0, *) "dim pixrgb", k
+
+  do ix=1, ubound(pix, 1)
+    do iy=1, ubound(pix, 2)
+      if (pix(ix,iy)%r .GT. k) then
+        pix(ix,iy)%r = pix(ix,iy)%r - k
+      endif
+      if (pix(ix,iy)%g .GT. k) then
+        pix(ix,iy)%g = pix(ix,iy)%g - k
+      endif
+      if (pix(ix,iy)%b .GT. k) then
+        pix(ix,iy)%b = pix(ix,iy)%b - k
+      endif
+    enddo
+  enddo
+
+end subroutine
+! -------------------------------------------------------------------
 end module