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

Compare commits

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

3 Commits
49183e4153 ... f039df4fe2

Author SHA1 Message Date
tTh
f039df4fe2 more doc ! 2024-02-07 03:40:23 +01:00
tTh
e3ff6de512 mood of the night 2024-02-07 03:22:44 +01:00
tTh
cd715e902f wavmetrics in the wild ! 2024-02-07 02:36:08 +01:00
12 changed files with 316 additions and 56 deletions
Show Stats Expand all files Collapse all files

5
GrafAnim/Makefile
View File

@ -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) \
-o $@
# ---- bienvenue dans le monde applicatif
gfortran $(GFOPT) $< $(MYLIB) -o $@
wavmetrics.o: wavmetrics.f90 Makefile
gfortran $(GFOPT) -c $<

20
GrafAnim/README.md
View File

@ -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
graphique brassé à la maison et nommé `genplot2`. Hélas, celui-ci est
Actuellement, certains des logiciels que vous voyez ici utilisent un backend graphique brassé
[à 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.
Le code source ([soundscope.f90](soundscope.f90)) est encore
bien gore.
Une tentative de retranscription en image de type oscilloscope/vumètre d'un fichier son.
Les codes source du proggy ([soundscope.f90](soundscope.f90)) et du
[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.

5
GrafAnim/essai.f90
View File

@ -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

35
GrafAnim/geowaves.f90 Normal file
View File

@ -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

124
GrafAnim/soundscope.f90
View File

@ -9,23 +9,28 @@ program soundscope
implicit none
integer :: width = 720
integer :: height = 576
integer :: width = 800
integer :: height = 600
integer :: marge = 32
integer :: samplerate = 44100
integer :: framerate = 30
integer, parameter :: overtrig = 25200
type(t_pixrgb), allocatable :: pix(:,:)
character (len=280) :: filename
integer :: iter, foo, tx, ty
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. &
((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
write(0,*) "overshoot!"
if ( (idx .LT. 50) .AND. &
((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
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)
iy = (2 * int(vr / 166.666)) + 300
ix = int((vl/65536.9) * real(width)) + width/2
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
write(0,*) "overshoot!"
((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
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
!-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------

38
GrafAnim/utils_ga.f90
View File

@ -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
! -------------------------------------------------------------------

2
Modules/.gitignore vendored
View File

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

6
Modules/Makefile
View File

@ -31,6 +31,7 @@ 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 $<
@ -59,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 $@

11
Modules/README.md
View File

@ -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
@ -25,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 !

39
Modules/twavm.f90 Normal file
View File

@ -0,0 +1,39 @@
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,15 +1,16 @@
! new: Thu Jan 4 00:08:04 UTC 2024
module wavmetrics
! new: Thu Jan 4 00:08:04 UTC 2024
use mathstuff2
implicit none
type wavmetric
integer :: num
real :: freql, freqr
integer :: maxl, maxr
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
@ -17,14 +18,51 @@ module wavmetrics
end type
contains
!-------------------------------------------------------------
subroutine compute_wavmetric(samples, start, size, metrics)
!-
! main computation routine, still full buggy
!-
subroutine compute_wavmetric(samples, size, metrics)
type(intsample), intent(in) :: samples(:)
integer, intent(in) :: start, size
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, 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
!-------------------------------------------------------------
@ -32,6 +70,13 @@ end subroutine
subroutine display_wavmetrics(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
!-------------------------------------------------------------

18
README.md
View File

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