Fortraneries/GrafAnim/soundscope.f90

145 lines
3.6 KiB
Fortran
Raw Normal View History

2024-01-02 10:14:43 +01:00
! *****************************************************
2023-12-24 20:53:27 +01:00
!
2024-01-02 10:14:43 +01:00
! *****************************************************
2023-12-24 20:53:27 +01:00
program soundscope
use pixrgb
use utils_ga
implicit none
2024-01-02 10:14:43 +01:00
integer :: width = 800
integer :: height = 600
integer :: marge = 20
integer :: samplerate = 44100
integer :: framerate = 30
2023-12-24 20:53:27 +01:00
type(t_pixrgb), allocatable :: pix(:,:)
character (len=280) :: filename
integer :: iter, foo, tx, ty
2024-01-02 10:14:43 +01:00
integer :: smppf
logical :: flagdone
2023-12-24 20:53:27 +01:00
2024-01-02 10:14:43 +01:00
smppf = samplerate / framerate
2023-12-24 20:53:27 +01:00
2024-01-02 10:14:43 +01:00
allocate(pix(width, height))
call preparation(pix, 65000)
iter = 0
do
write(0, *) "----- iteration", iter, " -----"
iter = iter + 1
do foo=0, 45
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
2023-12-24 20:53:27 +01:00
2024-01-02 10:14:43 +01:00
call dim_pix_rgb_sub(pix, 3300)
call make_a_frame(pix, smppf, flagdone)
2023-12-24 20:53:27 +01:00
write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
call rgbpix_spit_as_pnm_16(pix, filename)
2024-01-02 10:14:43 +01:00
if (flagdone) then
exit
endif
2023-12-24 20:53:27 +01:00
enddo
2024-01-02 10:14:43 +01:00
write(0, *) " [done]"
2023-12-24 20:53:27 +01:00
contains
!-- ------------------------------------------------------------------
!--
2024-01-02 10:14:43 +01:00
subroutine make_a_frame(image, nbdata, jobdone)
2023-12-24 20:53:27 +01:00
type(t_pixrgb), intent(inout) :: image(:,:)
integer, intent(in) :: nbdata
2024-01-02 10:14:43 +01:00
logical, intent(out) :: jobdone
integer :: idx, errcode
2023-12-24 20:53:27 +01:00
real :: vl, vr
integer :: ix, iy
2024-01-02 10:14:43 +01:00
jobdone = .FALSE.
2023-12-24 20:53:27 +01:00
do idx=0, nbdata
2024-01-02 10:14:43 +01:00
! get a sample
read(5, *, iostat=errcode) vl, vr
if (0 .NE. errcode) then
write(0, *) "iostat", errcode
jobdone = .TRUE.
exit
endif
! scale it to the window
ix = (2 * int(vl / 111.111)) + 400
iy = (2 * int(vr / 166.666)) + 300
ix = width - ix
2023-12-24 20:53:27 +01:00
! write(6, *) vl, ix, " | ", vr, iy
2024-01-02 10:14:43 +01:00
if (is_pixel_inside(ix, iy)) then
call make_big_dot(image, ix, iy)
endif
2023-12-24 20:53:27 +01:00
enddo
end subroutine
!-- ------------------------------------------------------------------
2024-01-02 10:14:43 +01:00
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
2023-12-24 20:53:27 +01:00
2024-01-02 10:14:43 +01:00
end function
2023-12-24 20:53:27 +01:00
2024-01-02 10:14:43 +01:00
!-- ------------------------------------------------------------------
2023-12-24 20:53:27 +01:00
!-- ------------------------------------------------------------------
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
!-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------
end program soundscope