tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: tTh:f039df4fe25aec24a4124eca14ab71b8b03404bf
Branches Tags
tTh:master
..
compare: tTh:49183e41539b692935e2dc4fa91c3ebe91c3404a
Branches Tags
tTh:master

No commits in common. "f039df4fe25aec24a4124eca14ab71b8b03404bf" and "49183e41539b692935e2dc4fa91c3ebe91c3404a" have entirely different histories.
f039df4fe2 ... 49183e4153

12 changed files with 56 additions and 316 deletions
Show Stats Expand all files Collapse all files

5
GrafAnim/Makefile
View File

@ -24,7 +24,10 @@ trigofest: trigofest.f90 Makefile vue3axes.o utils_ga.o
gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@ gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@
noisepic: noisepic.f90 Makefile noisepic: noisepic.f90 Makefile
gfortran $(GFOPT) $< $(MYLIB) -o $@ gfortran $(GFOPT) $< $(MYLIB) \
-o $@
# ---- bienvenue dans le monde applicatif
wavmetrics.o: wavmetrics.f90 Makefile wavmetrics.o: wavmetrics.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<

20
GrafAnim/README.md
View File

@ -3,16 +3,12 @@
Quelques essais approximatifs pour faire des graphiques inutiles, Quelques essais approximatifs pour faire des graphiques inutiles,
dans une démarche mettant en avant la dans une démarche mettant en avant la
[techno-futilité](https://wiki.interhacker.space/index.php?title=Techno-futilit%C3%A9), [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 graphique brassé Actuellement, certains des logiciels que vous voyez ici utilisent un backend
[à la maison](https://git.tetalab.org/tTh/libtthimage) graphique brassé à la maison et nommé `genplot2`. Hélas, celui-ci est
et nommé `genplot2`. Hélas, celui-ci est
un peu foireux sur les tracés de ligne... un peu foireux sur les tracés de ligne...
## geowaves
Une idée en l'air, probablement...
## trigofest ## trigofest
@ -24,11 +20,15 @@ que c'est d'la balle !
Ou comment dessiner des gaussiennes en jetant des dés. Ou comment dessiner des gaussiennes en jetant des dés.
## vue3axes
Un module assez spécialisé.
## soundscope ## soundscope
Une tentative de retranscription en image de type oscilloscope/vumètre d'un fichier son. Retranscription en image de type oscilloscope d'un fichier son.
Les codes source du proggy ([soundscope.f90](soundscope.f90)) et du Le code source ([soundscope.f90](soundscope.f90)) est encore
[module](utils_ga.f90) associé sont encore bien *gore*. 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 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. pour la partie dessin.

5
GrafAnim/essai.f90
View File

@ -1,9 +1,5 @@
program essai program essai
! *******************************************
! CE TRUC NE MARCHE PAS /O\
! *******************************************
use pixrgb use pixrgb
implicit none implicit none
@ -64,7 +60,6 @@ subroutine setpixel(pic, x, y)
.and. & .and. &
(iy .gt. lbound(pic, 2)) .and. (iy .lt. ubound(pic, 2)) ) & (iy .gt. lbound(pic, 2)) .and. (iy .lt. ubound(pic, 2)) ) &
then then
pix(ix, iy)%r = 0
pic(ix, iy)%g = 65000 pic(ix, iy)%g = 65000
pic(ix, iy)%b = 20000 pic(ix, iy)%b = 20000
else else

35
GrafAnim/geowaves.f90
View File

@ -1,35 +0,0 @@
! *******************************************
!
! *******************************************
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

122
GrafAnim/soundscope.f90
View File

@ -9,28 +9,23 @@ program soundscope
implicit none implicit none
integer :: width = 800 integer :: width = 720
integer :: height = 600 integer :: height = 576
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(:,:) type(t_pixrgb), allocatable :: pix(:,:)
character (len=280) :: filename character (len=280) :: filename
integer :: iter, foo, tx, ty integer :: iter, foo, tx, ty
integer :: smppf integer :: smppf
logical :: flagdone logical :: flagdone
smppf = samplerate / framerate
write(0, *) "sample rate = ", samplerate
write(0, *) "frames per second = ", framerate
write(0, *) "samples per frame = ", smppf
smppf = samplerate / framerate
allocate(pix(width, height)) allocate(pix(width, height))
! call fill_random_gauss(pix, 65000, marge) call fill_random_gauss(pix, 65000, marge)
iter = 0 iter = 0
do do
@ -51,19 +46,13 @@ program soundscope
enddo enddo
call dim_pix_rgb_mul(pix, 0.86) call dim_pix_rgb_mul(pix, 0.86)
if (mod(iter, 180) .LT. 90) then
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) call make_a_frame_dplot(pix, smppf, flagdone)
end select else
call make_a_frame_xy(pix, smppf, flagdone)
endif
call dessine_cadre(pix, 51000, 65000, 51000, marge) call dessine_cadre(pix, 65000, 65000, 65000, marge)
write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm" write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
call rgbpix_spit_as_pnm_16(pix, filename) call rgbpix_spit_as_pnm_16(pix, filename)
@ -71,17 +60,13 @@ program soundscope
exit exit
endif endif
if (iter .EQ. 360) exit
enddo enddo
write(0, *) " [done]" write(0, *) " [done]"
contains contains
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------
!- !--
! This is the classic Lissajou
!-
subroutine make_a_frame_xy(image, nbdata, jobdone) subroutine make_a_frame_xy(image, nbdata, jobdone)
type(t_pixrgb), intent(inout) :: image(:,:) type(t_pixrgb), intent(inout) :: image(:,:)
@ -103,16 +88,15 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
endif endif
! add flash ! ! add flash !
if ( (idx .LT. 50) .AND. & if ( (idx .LT. 100) .AND. &
((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then ((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
write(0,*) "overshoot in xy!" write(0,*) "overshoot!"
call fill_random_gauss(image, 65000, marge) call fill_random_gauss(image, 65000, marge)
endif endif
! scale it to the window ! scale it to the window
ix = int((vl/65536.9) * real(width)) + width/2 ix = width - ((2 * int(vl / 111.111)) + 400)
ix = width - ix iy = (2 * int(vr / 166.666)) + 300
iy = int((vr/65536.9) * real(height)) + height/2
if (is_pixel_inside(ix, iy)) then if (is_pixel_inside(ix, iy)) then
call make_big_dot(image, ix, iy) call make_big_dot(image, ix, iy)
endif endif
@ -121,73 +105,9 @@ subroutine make_a_frame_xy(image, nbdata, jobdone)
end subroutine 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) subroutine make_a_frame_dplot(image, nbdata, jobdone)
type(t_pixrgb), intent(inout) :: image(:,:) type(t_pixrgb), intent(inout) :: image(:,:)
integer, intent(in) :: nbdata integer, intent(in) :: nbdata
@ -209,8 +129,8 @@ subroutine make_a_frame_dplot(image, nbdata, jobdone)
endif endif
! add flash ! ! add flash !
if ( (idx .LT. 100) .AND. & if ( (idx .LT. 100) .AND. &
((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then ((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
write(0,*) "overshoot in dplot!" write(0,*) "overshoot!"
call fill_random_gauss(image, 65000, marge) call fill_random_gauss(image, 65000, marge)
endif endif
@ -263,7 +183,7 @@ subroutine dessine_cadre(image, R, G, B, border)
end subroutine end subroutine
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------
function is_pixel_inside(ix, iy) function is_pixel_inside(ix, iy)
integer,intent(in) :: ix, iy integer,intent(in) :: ix, iy
logical :: is_pixel_inside logical :: is_pixel_inside
@ -280,6 +200,8 @@ function is_pixel_inside(ix, iy)
end function end function
!-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------

38
GrafAnim/utils_ga.f90
View File

@ -3,7 +3,6 @@
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
module utils_ga module utils_ga
use pixrgb use pixrgb
implicit none implicit none
@ -34,25 +33,7 @@ subroutine increment_pixel(pix, k)
type(t_pixrgb), intent(inout) :: pix type(t_pixrgb), intent(inout) :: pix
integer :: k 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 end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
@ -123,25 +104,6 @@ subroutine dim_pix_rgb_sub(pix, k)
enddo enddo
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 end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------

2
Modules/.gitignore vendored
View File

@ -1,6 +1,6 @@
chkpixels chkpixels
twavm t
trnd trnd
*.pgm *.pgm

6
Modules/Makefile
View File

@ -31,7 +31,6 @@ mathstuff2.o: mathstuff2.f90 Makefile
noisepictures.o: noisepictures.f90 Makefile noisepictures.o: noisepictures.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
# new: Wed Feb 7 01:27:48 UTC 2024
wavmetrics.o: wavmetrics.f90 Makefile wavmetrics.o: wavmetrics.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
@ -60,8 +59,3 @@ t_centermag: t_centermag.f90 Makefile libtth90modules.a
trnd: trnd.f90 Makefile libtth90modules.a trnd: trnd.f90 Makefile libtth90modules.a
gfortran $(GFOPT) $< libtth90modules.a -o $@ 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 $@

11
Modules/README.md
View File

@ -3,11 +3,6 @@
## Modules disponibles ## 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 ### spitpgm
@ -30,13 +25,11 @@ or have a sane place to put a breakpoint with gdb
## Compiler un module ## 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 And when you use the module, you have to specify the paths
for the .mod and the .o to the linker. for the .mod and the .o to the linker.
*
See [Makefile](./Makefile) for an example. See [Makefile](./Makefile) for an example.
## TODO ## TODO
- write the fscking doc ! - écrire la doc !

39
Modules/twavm.f90
View File

@ -1,39 +0,0 @@
program essai
! new: Wed Feb 7 01:27:48 UTC 2024
use mathstuff2
use wavmetrics
implicit none
write(0, *) "----------------- essai -------------------"
call run_first_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
!-----------------------------------------------------------------------
end program

63
Modules/wavmetrics.f90
View File

@ -1,16 +1,15 @@
module wavmetrics
! new: Thu Jan 4 00:08:04 UTC 2024 ! new: Thu Jan 4 00:08:04 UTC 2024
module wavmetrics
use mathstuff2 use mathstuff2
implicit none implicit none
type wavmetric type wavmetric
integer :: nbre ! number of slices/samples integer :: num
real :: freql, freqr ! zero-crossing estimation real :: freql, freqr
integer :: maxl, maxr ! maximum of abs values integer :: maxl, maxr
real :: meanl, meanr
end type end type
type intsample type intsample
@ -18,51 +17,14 @@ module wavmetrics
end type end type
contains contains
!------------------------------------------------------------- !-------------------------------------------------------------
!-
! main computation routine, still full buggy subroutine compute_wavmetric(samples, start, size, metrics)
!-
subroutine compute_wavmetric(samples, size, metrics)
type(intsample), intent(in) :: samples(:) type(intsample), intent(in) :: samples(:)
integer, intent(in) :: size integer, intent(in) :: start, size
type(wavmetric), intent(out) :: metrics 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, Lval)) Rfreq = Rfreq + 1
endif
Lsum = Lsum + Lval
Rsum = Rsum + Rval
enddo
metrics%num = 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 end subroutine
!------------------------------------------------------------- !-------------------------------------------------------------
@ -70,13 +32,6 @@ end subroutine
subroutine display_wavmetrics(metrics) subroutine display_wavmetrics(metrics)
type(wavmetric), intent(in) :: metrics type(wavmetric), intent(in) :: metrics
! print '(1X, "metrics are :")'
print '(1X, " | num ", I0)', metrics%num
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 subroutine
!------------------------------------------------------------- !-------------------------------------------------------------

18
README.md
View File

@ -8,31 +8,21 @@ de Janvier 2022, et j'ai bien aimé. Bon, contrairement à la
version de 77, les `GOTO`s sont moins agréables à faire, mais version de 77, les `GOTO`s sont moins agréables à faire, mais
l'existence des _pointeurs_ compense largement. l'existence des _pointeurs_ compense largement.
## Le contenu ## content
- [Modules](Modules/) : quelques composants de base.
- [SoundBrotching](SoundBrotching/) : faire gémir vos tympans - [SoundBrotching](SoundBrotching/) : faire gémir vos tympans
- [BloubWorld](BloubWorld/) : la vie des particules - [BloubWorld](BloubWorld/) : la vie des particules
- [Fraktalism](Fraktalism/) : du chaos dans les pixels - [Fraktalism](Fraktalism/) : du chaos dans les pixels
- [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret - [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret
- [GrafAnim](GrafAnim/) : Ah, enfin de la gif89a en vue ! - [GrafAnim](GrafAnim/) : Ah, enfin de la gif89a en vue !
## Utilisation ## Prérequis
- Prérequis de base, les GNUtrucs : gfortran, gcc, bash, make, awk... - GNUtrucs : 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 - Le canal `#tetalab` sur le réseau IRC de
[Libera](https://libera.chat/) [Libera](https://libera.chat/)
- La [mailing-list publique](https://lists.tetalab.org/mailman/listinfo/tetalab) du Tetalab. - 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)