Fortraneries/GrafAnim/soundscope.f90

! *****************************************************
! 
! *****************************************************

program soundscope

  use pixrgb
  use utils_ga

  implicit none

  integer                       :: width  = 720
  integer                       :: height = 576
  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, 500
      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, 2200)
    call make_a_frame(pix, smppf, flagdone)
    call dessine_cadre(pix, 65000, 65000, 65000)
    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

    if ( (idx .LT. 160)       .AND.       &
       ((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
      !-
      !   add flash !
      write(0,*) "overshoot!"
      call preparation(image, 65000)
    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

!-- ------------------------------------------------------------------

subroutine dessine_cadre(image, R, G, B)
  type(t_pixrgb), intent(inout)  :: image(:,:)
  integer,intent(in)             :: R, G, B

  integer                        :: ix, iy, foo
  
  foo = ubound(image, 2) - marge
  do ix=1+marge, ubound(image, 1) - marge
      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) - marge
  do iy=1+marge, ubound(image, 2)-marge
      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

!-- ------------------------------------------------------------------

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