2023-05-07 10:33:43 +02:00
|
|
|
program noisepic
|
|
|
|
|
|
|
|
use spitpgm
|
2023-05-07 20:23:33 +02:00
|
|
|
use pixrgb
|
2023-06-09 23:59:54 +02:00
|
|
|
use noisepictures
|
2023-06-20 21:06:59 +02:00
|
|
|
use mathstuff2
|
2023-05-07 10:33:43 +02:00
|
|
|
implicit none
|
|
|
|
|
|
|
|
integer :: numframe = 0
|
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
integer :: nbarg
|
2023-05-07 10:33:43 +02:00
|
|
|
character(len=256) :: arg
|
2023-06-02 19:29:36 +02:00
|
|
|
integer :: ranges(6)
|
2023-06-20 21:06:59 +02:00
|
|
|
real :: fclock, kpi, r1, r3, r5
|
2023-05-07 10:33:43 +02:00
|
|
|
|
|
|
|
nbarg = IARGC()
|
|
|
|
if (nbarg .GT. 0) then
|
|
|
|
call GETARG(1, arg)
|
|
|
|
! write (0, '(A40, A5)') "argument = ", arg
|
|
|
|
read (arg, *) numframe
|
|
|
|
endif
|
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
call init_random_seed()
|
2023-05-07 10:33:43 +02:00
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
kpi = 3.151592654 / 3.0
|
2023-05-07 20:23:33 +02:00
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
do numframe = 0, 479
|
|
|
|
fclock = kpi * float(numframe) / 480.0
|
|
|
|
r1 = 27000 + 20000 * cos(fclock*26)
|
|
|
|
ranges(1) = nint(r1) ; ranges(2) = ranges(1)+300
|
2023-05-07 20:23:33 +02:00
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
r3 = 32000 + 28000 * cos(fclock*29)
|
|
|
|
ranges(3) = nint(r3) ; ranges(4) = ranges(3)+300
|
2023-05-07 20:23:33 +02:00
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
r5 = 29000 + 23000 * cos(fclock*32)
|
|
|
|
ranges(5) = nint(r5) ; ranges(6) = ranges(5)+300
|
2023-05-07 20:23:33 +02:00
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
print *, 'r123', numframe, fclock, r1, r3, r5
|
2023-05-07 10:33:43 +02:00
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
call make_noise_color_range_pic (numframe, ranges, 29000)
|
2023-05-07 10:33:43 +02:00
|
|
|
enddo
|
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
contains
|
2023-06-02 19:29:36 +02:00
|
|
|
!-- ------------------------------------------------------------------
|
2023-06-20 21:06:59 +02:00
|
|
|
!--
|
2023-06-02 19:29:36 +02:00
|
|
|
!-- ------------------------------------------------------------------
|
2023-06-20 21:06:59 +02:00
|
|
|
subroutine make_noise_color_range_pic (seqv, rngs, nbre)
|
2023-06-02 19:29:36 +02:00
|
|
|
implicit none
|
2023-06-20 21:06:59 +02:00
|
|
|
integer, intent(in) :: seqv, nbre
|
2023-06-02 19:29:36 +02:00
|
|
|
integer, intent(in) :: rngs(6)
|
|
|
|
|
|
|
|
type(t_pixrgb), allocatable :: pix(:,:)
|
|
|
|
character (len=280) :: filename
|
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
allocate(pix(640, 480))
|
2023-06-02 19:29:36 +02:00
|
|
|
call rgbpix_set_to_rgb(pix, 0, 0, 0)
|
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
write (filename, "(a, i5.5, a)") "./F/np/", seqv, ".pnm"
|
|
|
|
! print *, 'filename: ', trim(filename)
|
2023-06-02 19:29:36 +02:00
|
|
|
|
2023-06-20 21:06:59 +02:00
|
|
|
call noise_range_rgb16_pic(pix, rngs, nbre)
|
|
|
|
call rgbpix_spit_as_pnm_16(pix, trim(filename))
|
2023-06-02 19:29:36 +02:00
|
|
|
|
|
|
|
deallocate(pix)
|
2023-05-07 10:33:43 +02:00
|
|
|
end subroutine
|
|
|
|
!-- ------------------------------------------------------------------
|
|
|
|
end program
|