Fortraneries/GrafAnim/soundscope.f90

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

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