288 lines
7.8 KiB
Fortran
288 lines
7.8 KiB
Fortran
! *****************************************************
|
|
!
|
|
! *****************************************************
|
|
|
|
program soundscope
|
|
|
|
use pixrgb
|
|
use utils_ga
|
|
|
|
implicit none
|
|
|
|
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)
|
|
|
|
iter = 0
|
|
do
|
|
write(0, *) "----- iteration", iter, " -----"
|
|
iter = iter + 1
|
|
|
|
do foo=0, 100
|
|
tx = (marge/2) + fair_random_gauss(width-marge)
|
|
ty = (marge/2) + fair_random_gauss(height-marge)
|
|
if (is_pixel_inside(tx, ty)) then
|
|
call make_red_dot(pix, tx, ty)
|
|
endif
|
|
tx = (marge/2) + fair_random_gauss(width-marge)
|
|
ty = (marge/2) + fair_random_gauss(height-marge)
|
|
if (is_pixel_inside(tx, ty)) then
|
|
call make_blue_dot(pix, tx, ty)
|
|
endif
|
|
enddo
|
|
|
|
call dim_pix_rgb_mul(pix, 0.86)
|
|
|
|
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)
|
|
|
|
if (flagdone) then
|
|
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(:,:)
|
|
integer, intent(in) :: nbdata
|
|
logical, intent(out) :: jobdone
|
|
integer :: idx, errcode
|
|
real :: vl, vr
|
|
integer :: ix, iy
|
|
|
|
jobdone = .FALSE.
|
|
|
|
do idx=0, nbdata
|
|
! get a sample
|
|
read(5, *, iostat=errcode) vl, vr
|
|
if (0 .NE. errcode) then
|
|
write(0, *) "iostat", errcode
|
|
jobdone = .TRUE.
|
|
exit
|
|
endif
|
|
|
|
! add flash !
|
|
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 = 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
|
|
enddo
|
|
|
|
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
|
|
logical, intent(out) :: jobdone
|
|
integer :: idx, errcode
|
|
real :: vl, vr
|
|
integer :: il, ir, xpos
|
|
|
|
jobdone = .FALSE.
|
|
xpos = 1
|
|
|
|
do idx=0, nbdata
|
|
! get a sample
|
|
read(5, *, iostat=errcode) vl, vr
|
|
if (0 .NE. errcode) then
|
|
write(0, *) "iostat", errcode
|
|
jobdone = .TRUE.
|
|
exit
|
|
endif
|
|
! add flash !
|
|
if ( (idx .LT. 100) .AND. &
|
|
((abs(vl).GT.overtrig).OR.(abs(vr).GT.overtrig)) ) then
|
|
write(0,*) "overshoot in dplot!"
|
|
call fill_random_gauss(image, 65000, marge)
|
|
endif
|
|
|
|
if (xpos .LT. width) then
|
|
! scale it to the window
|
|
il = int((vl/65536.9) * real(height)) + height/2
|
|
ir = int((vr/65536.9) * real(height)) + height/2
|
|
! print *, vl, il, " | ", vr, ir
|
|
if (is_pixel_inside(xpos, il)) then
|
|
call make_big_dot(image, xpos, il)
|
|
endif
|
|
if (is_pixel_inside(xpos, ir)) then
|
|
call make_big_dot(image, xpos, ir)
|
|
endif
|
|
xpos = xpos + 1
|
|
endif
|
|
|
|
enddo
|
|
|
|
end subroutine
|
|
|
|
!-- ------------------------------------------------------------------
|
|
|
|
subroutine dessine_cadre(image, R, G, B, border)
|
|
type(t_pixrgb), intent(inout) :: image(:,:)
|
|
integer,intent(in) :: R, G, B, border
|
|
|
|
integer :: ix, iy, foo
|
|
|
|
foo = ubound(image, 2) - border
|
|
do ix=1+marge, ubound(image, 1) - border
|
|
image(ix, marge)%r = R
|
|
image(ix, marge)%g = G
|
|
image(ix, marge)%b = B
|
|
image(ix, foo)%r = R
|
|
image(ix, foo)%g = G
|
|
image(ix, foo)%b = B
|
|
enddo
|
|
|
|
foo = ubound(image, 1) - border
|
|
do iy=1+marge, ubound(image, 2)-border
|
|
image(marge, iy)%r = R
|
|
image(marge, iy)%g = G
|
|
image(marge, iy)%b = B
|
|
image(foo, iy)%r = R
|
|
image(foo, iy)%g = G
|
|
image(foo, iy)%b = B
|
|
enddo
|
|
|
|
end subroutine
|
|
|
|
!-- ------------------------------------------------------------------
|
|
!-- ------------------------------------------------------------------
|
|
function is_pixel_inside(ix, iy)
|
|
integer,intent(in) :: ix, iy
|
|
logical :: is_pixel_inside
|
|
|
|
is_pixel_inside = .TRUE.
|
|
if ( (ix .LT. marge) .OR. (ix .GT. width-marge) ) then
|
|
is_pixel_inside = .FALSE.
|
|
return
|
|
endif
|
|
if ( (iy .LT. marge) .OR. (iy .GT. height-marge) ) then
|
|
is_pixel_inside = .FALSE.
|
|
return
|
|
endif
|
|
|
|
end function
|
|
|
|
|
|
!-- ------------------------------------------------------------------
|
|
|
|
end program soundscope
|
|
|