From 9629d6ca9794c65f66ca5ea1ecf48d374cfe8738 Mon Sep 17 00:00:00 2001 From: tTh Date: Sun, 24 Dec 2023 20:53:27 +0100 Subject: [PATCH] soundscope, first try ok --- GrafAnim/.gitignore | 2 + GrafAnim/Makefile | 6 ++ GrafAnim/README.md | 17 ++++-- GrafAnim/soundscope.f90 | 120 ++++++++++++++++++++++++++++++++++++++++ GrafAnim/utils_ga.f90 | 27 ++++++++- 5 files changed, 165 insertions(+), 7 deletions(-) create mode 100644 GrafAnim/soundscope.f90 diff --git a/GrafAnim/.gitignore b/GrafAnim/.gitignore index e4096ff..dca5806 100644 --- a/GrafAnim/.gitignore +++ b/GrafAnim/.gitignore @@ -4,6 +4,8 @@ doubledice doublegauss trigofest noisepic +geowaves +soundscope *.scratch *.genplot diff --git a/GrafAnim/Makefile b/GrafAnim/Makefile index cc07480..de45e21 100644 --- a/GrafAnim/Makefile +++ b/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 $@ diff --git a/GrafAnim/README.md b/GrafAnim/README.md index 4eb6e46..310bb0e 100644 --- a/GrafAnim/README.md +++ b/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 https://bleuje.com/tutorial1/ que c'est d'la balle ! +Expériences inspirées par [ce site](https://bleuje.com/tutorial1/) +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. + + diff --git a/GrafAnim/soundscope.f90 b/GrafAnim/soundscope.f90 new file mode 100644 index 0000000..87840ed --- /dev/null +++ b/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 + diff --git a/GrafAnim/utils_ga.f90 b/GrafAnim/utils_ga.f90 index b3f8f38..4aa3eab 100644 --- a/GrafAnim/utils_ga.f90 +++ b/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) - bar = int(rand()*hilevel/2) + foo = 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