sounscope, second try ok
This commit is contained in:
tTh
parent
9629d6ca97
commit
bd581ee2bd
@ -1,6 +1,6 @@
|
||||
! *******************************************
|
||||
! *****************************************************
|
||||
!
|
||||
! *******************************************
|
||||
! *****************************************************
|
||||
|
||||
program soundscope
|
||||
|
||||
@ -9,73 +9,113 @@ program soundscope
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: width = 640
|
||||
integer :: height = 480
|
||||
integer :: marge = 10
|
||||
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
|
||||
logical :: flag
|
||||
integer :: smppf
|
||||
logical :: flagdone
|
||||
|
||||
|
||||
smppf = samplerate / framerate
|
||||
|
||||
allocate(pix(width, height))
|
||||
! call preparation(pix, 65000)
|
||||
call preparation(pix, 65000)
|
||||
|
||||
do iter=0, 450
|
||||
write(0, *) "----- iteration", iter, " -------------"
|
||||
iter = 0
|
||||
do
|
||||
write(0, *) "----- iteration", iter, " -----"
|
||||
iter = iter + 1
|
||||
|
||||
! do foo=0, 10
|
||||
! tx = (marge/2) + fair_random_gauss(width-marge)
|
||||
! ty = (marge/2) + fair_random_gauss(height-marge)
|
||||
! call make_big_dot(pix, tx, ty)
|
||||
! enddo
|
||||
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(pix, 1500)
|
||||
call make_a_frame(pix, 300)
|
||||
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)
|
||||
subroutine make_a_frame(image, nbdata, jobdone)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: nbdata
|
||||
integer :: idx
|
||||
logical, intent(out) :: jobdone
|
||||
integer :: idx, errcode
|
||||
real :: vl, vr
|
||||
integer :: ix, iy
|
||||
|
||||
jobdone = .FALSE.
|
||||
|
||||
do idx=0, nbdata
|
||||
read(5, *) vl, vr
|
||||
ix = int((vl / 111.111) + 300)
|
||||
iy = int((vr / 166.666) + 200)
|
||||
! 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
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
subroutine make_big_dot(image, ix, iy)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: ix, iy
|
||||
function is_pixel_inside(ix, iy)
|
||||
integer,intent(in) :: ix, iy
|
||||
logical :: is_pixel_inside
|
||||
|
||||
image(ix, iy)%r = 12000
|
||||
is_pixel_inside = .TRUE.
|
||||
|
||||
image(ix, iy)%g = 65000
|
||||
image(ix-1, iy)%g = 56000
|
||||
image(ix, iy-1)%g = 56000
|
||||
image(ix+1, iy)%g = 56000
|
||||
image(ix, iy+1)%g = 56000
|
||||
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
|
||||
|
||||
image(ix, iy)%b = 24000
|
||||
|
||||
end subroutine
|
||||
end function
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
subroutine preparation(image, mval)
|
||||
@ -98,22 +138,6 @@ end subroutine
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
logical function diff_sign(a, b)
|
||||
integer, intent(in) :: a, b
|
||||
|
||||
! write(0, *) "diff_sign", a, b
|
||||
if ( (a .lt. 0) .and. (b .ge. 0) ) then
|
||||
diff_sign = .TRUE.
|
||||
return
|
||||
endif
|
||||
if ( (a .ge. 0) .and. (b .lt. 0) ) then
|
||||
diff_sign = .TRUE.
|
||||
return
|
||||
endif
|
||||
diff_sign = .FALSE.
|
||||
|
||||
end function
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
end program soundscope
|
||||
|
||||
@ -37,8 +37,53 @@ subroutine increment_pixel(pix, k)
|
||||
|
||||
end subroutine
|
||||
! -------------------------------------------------------------------
|
||||
subroutine make_red_dot(image, ix, iy)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: ix, iy
|
||||
|
||||
subroutine dim_pix_rgb(pix, k)
|
||||
image(ix, iy)%r = 65000
|
||||
image(ix+1, iy)%r = 65000
|
||||
image(ix-1, iy)%r = 65000
|
||||
image(ix+2, iy)%r = 65000
|
||||
image(ix-2, iy)%r = 65000
|
||||
|
||||
end subroutine
|
||||
!-- ------------------------------------------------------------------
|
||||
subroutine make_blue_dot(image, ix, iy)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: ix, iy
|
||||
|
||||
image(ix, iy)%b = 65000
|
||||
image(ix, iy+1)%b = 65000
|
||||
image(ix, iy-1)%b = 65000
|
||||
image(ix, iy+2)%b = 65000
|
||||
image(ix, iy-2)%b = 65000
|
||||
|
||||
end subroutine
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
|
||||
subroutine make_big_dot(image, ix, iy)
|
||||
type(t_pixrgb), intent(inout) :: image(:,:)
|
||||
integer, intent(in) :: ix, iy
|
||||
|
||||
image(ix, iy)%g = 65000
|
||||
|
||||
image(ix-1, iy)%g = 56000
|
||||
image(ix, iy-1)%g = 56000
|
||||
image(ix+1, iy)%g = 56000
|
||||
image(ix, iy+1)%g = 56000
|
||||
|
||||
image(ix+1, iy+1)%g = 24000
|
||||
image(ix-1, iy+1)%g = 24000
|
||||
image(ix+1, iy-1)%g = 24000
|
||||
image(ix-1, iy-1)%g = 24000
|
||||
|
||||
end subroutine
|
||||
|
||||
!-- ------------------------------------------------------------------
|
||||
|
||||
subroutine dim_pix_rgb_sub(pix, k)
|
||||
type(t_pixrgb), intent(inout) :: pix(:,:)
|
||||
integer,intent(in) :: k
|
||||
integer :: ix, iy
|
||||
@ -60,5 +105,23 @@ subroutine dim_pix_rgb(pix, k)
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
! -------------------------------------------------------------------
|
||||
|
||||
subroutine dim_pix_rgb_mul(pix, fk)
|
||||
type(t_pixrgb), intent(inout) :: pix(:,:)
|
||||
real,intent(in) :: fk
|
||||
|
||||
integer :: ix, iy
|
||||
|
||||
! write(0, *) "dim pixrgb", k
|
||||
|
||||
do ix=1, ubound(pix, 1)
|
||||
do iy=1, ubound(pix, 2)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
|
||||
! -------------------------------------------------------------------
|
||||
end module
|
||||
|
||||
Loading…
Reference in New Issue
Block a user