Fortraneries/GrafAnim/noisepic.f90

68 lines
1.8 KiB
Fortran
Raw Permalink Normal View History

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