145 lines
3.6 KiB
Fortran
145 lines
3.6 KiB
Fortran
! *****************************************************
|
|
!
|
|
! *****************************************************
|
|
|
|
program soundscope
|
|
|
|
use pixrgb
|
|
use utils_ga
|
|
|
|
implicit none
|
|
|
|
integer :: width = 800
|
|
integer :: height = 600
|
|
integer :: marge = 20
|
|
integer :: samplerate = 44100
|
|
integer :: framerate = 30
|
|
|
|
type(t_pixrgb), allocatable :: pix(:,:)
|
|
character (len=280) :: filename
|
|
integer :: iter, foo, tx, ty
|
|
integer :: smppf
|
|
logical :: flagdone
|
|
|
|
|
|
smppf = samplerate / framerate
|
|
|
|
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
|
|
|
|
call dim_pix_rgb_sub(pix, 3300)
|
|
call make_a_frame(pix, smppf, flagdone)
|
|
|
|
write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
|
|
call rgbpix_spit_as_pnm_16(pix, filename)
|
|
|
|
if (flagdone) then
|
|
exit
|
|
endif
|
|
|
|
enddo
|
|
|
|
write(0, *) " [done]"
|
|
|
|
contains
|
|
!-- ------------------------------------------------------------------
|
|
!--
|
|
|
|
subroutine make_a_frame(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
|
|
|
|
! scale it to the window
|
|
ix = (2 * int(vl / 111.111)) + 400
|
|
iy = (2 * int(vr / 166.666)) + 300
|
|
ix = width - ix
|
|
! write(6, *) vl, ix, " | ", vr, iy
|
|
|
|
if (is_pixel_inside(ix, iy)) then
|
|
call make_big_dot(image, ix, iy)
|
|
endif
|
|
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
|
|
|
|
!-- ------------------------------------------------------------------
|
|
!-- ------------------------------------------------------------------
|
|
|
|
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
|
|
|