! ***************************************************** ! ! ***************************************************** 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