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

mood of the night

Browse Source
This commit is contained in:
tTh
2024-02-07 03:22:44 +01:00
parent cd715e902f
commit e3ff6de512
6 changed files with 193 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

130
GrafAnim/soundscope.f90
View File

@@ -9,11 +9,13 @@ program soundscope
implicit none
integer :: width = 720
integer :: height = 576
integer :: marge = 32
integer :: samplerate = 44100
integer :: framerate = 30
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
@@ -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. &
((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
!-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------