121 lines
3.0 KiB
Fortran
121 lines
3.0 KiB
Fortran
|
! *******************************************
|
||
|
!
|
||
|
! *******************************************
|
||
|
|
||
|
program soundscope
|
||
|
|
||
|
use pixrgb
|
||
|
use utils_ga
|
||
|
|
||
|
implicit none
|
||
|
|
||
|
integer :: width = 640
|
||
|
integer :: height = 480
|
||
|
integer :: marge = 10
|
||
|
type(t_pixrgb), allocatable :: pix(:,:)
|
||
|
character (len=280) :: filename
|
||
|
integer :: iter, foo, tx, ty
|
||
|
logical :: flag
|
||
|
|
||
|
allocate(pix(width, height))
|
||
|
! call preparation(pix, 65000)
|
||
|
|
||
|
do iter=0, 450
|
||
|
write(0, *) "----- iteration", iter, " -------------"
|
||
|
|
||
|
! 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
|
||
|
|
||
|
call dim_pix_rgb(pix, 1500)
|
||
|
call make_a_frame(pix, 300)
|
||
|
|
||
|
write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
|
||
|
call rgbpix_spit_as_pnm_16(pix, filename)
|
||
|
|
||
|
enddo
|
||
|
|
||
|
contains
|
||
|
!-- ------------------------------------------------------------------
|
||
|
!--
|
||
|
|
||
|
subroutine make_a_frame(image, nbdata)
|
||
|
type(t_pixrgb), intent(inout) :: image(:,:)
|
||
|
integer, intent(in) :: nbdata
|
||
|
integer :: idx
|
||
|
real :: vl, vr
|
||
|
integer :: ix, iy
|
||
|
|
||
|
do idx=0, nbdata
|
||
|
read(5, *) vl, vr
|
||
|
ix = int((vl / 111.111) + 300)
|
||
|
iy = int((vr / 166.666) + 200)
|
||
|
! write(6, *) vl, ix, " | ", vr, iy
|
||
|
call make_big_dot(image, ix, iy)
|
||
|
enddo
|
||
|
|
||
|
end subroutine
|
||
|
|
||
|
!-- ------------------------------------------------------------------
|
||
|
|
||
|
subroutine make_big_dot(image, ix, iy)
|
||
|
type(t_pixrgb), intent(inout) :: image(:,:)
|
||
|
integer, intent(in) :: ix, iy
|
||
|
|
||
|
image(ix, iy)%r = 12000
|
||
|
|
||
|
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, iy)%b = 24000
|
||
|
|
||
|
end subroutine
|
||
|
|
||
|
!-- ------------------------------------------------------------------
|
||
|
|
||
|
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
|
||
|
|
||
|
!-- ------------------------------------------------------------------
|
||
|
|
||
|
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
|
||
|
|