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