2023-05-07 10:33:43 +02:00
|
|
|
program noisepic
|
|
|
|
|
|
|
|
use spitpgm
|
2023-05-07 20:23:33 +02:00
|
|
|
use pixrgb
|
2023-05-07 10:33:43 +02:00
|
|
|
implicit none
|
|
|
|
|
|
|
|
integer :: numframe = 0
|
|
|
|
|
|
|
|
integer :: nbarg
|
|
|
|
character(len=256) :: arg
|
|
|
|
|
|
|
|
|
|
|
|
nbarg = IARGC()
|
|
|
|
if (nbarg .GT. 0) then
|
|
|
|
call GETARG(1, arg)
|
|
|
|
! write (0, '(A40, A5)') "argument = ", arg
|
|
|
|
read (arg, *) numframe
|
|
|
|
endif
|
|
|
|
|
2023-05-07 20:23:33 +02:00
|
|
|
call make_noise_color_pic(numframe)
|
2023-05-07 10:33:43 +02:00
|
|
|
|
|
|
|
contains
|
|
|
|
!-- ------------------------------------------------------------------
|
2023-05-07 20:23:33 +02:00
|
|
|
!-
|
|
|
|
!- Black & White
|
|
|
|
!-
|
|
|
|
subroutine make_noise_bw_pic (value)
|
|
|
|
implicit none
|
2023-05-07 10:33:43 +02:00
|
|
|
integer, intent(in) :: value
|
|
|
|
|
|
|
|
integer :: foo
|
|
|
|
integer, dimension(:,:), allocatable :: pic
|
|
|
|
character (len=280) :: filename
|
|
|
|
|
|
|
|
allocate(pic(320, 240))
|
|
|
|
|
2023-05-07 20:23:33 +02:00
|
|
|
pic = 30 !- clear the picz
|
2023-05-07 10:33:43 +02:00
|
|
|
|
|
|
|
call srand(value+34)
|
|
|
|
foo = irand()
|
|
|
|
print *, 'val=', value, ' rnd=', foo
|
|
|
|
|
2023-05-07 20:23:33 +02:00
|
|
|
call plot_noise_bw_pic(pic, 15000)
|
2023-05-07 10:33:43 +02:00
|
|
|
|
|
|
|
write (filename, "(a, i5.5, a)") "", value, ".pgm"
|
|
|
|
call spit_as_pgm_8(pic, trim(filename))
|
|
|
|
end subroutine
|
|
|
|
!-- ------------------------------------------------------------------
|
2023-05-07 20:23:33 +02:00
|
|
|
subroutine plot_noise_bw_pic(picz, nbre)
|
|
|
|
implicit none
|
2023-05-07 10:33:43 +02:00
|
|
|
|
|
|
|
integer, dimension(:,:), intent(inout) :: picz
|
|
|
|
integer, intent(in) :: nbre
|
|
|
|
|
|
|
|
integer :: width, height
|
|
|
|
integer :: quux, ix, iy, iv
|
|
|
|
|
|
|
|
width = ubound(picz, 1) ; height = ubound(picz, 2)
|
|
|
|
! print *, 'sz picz', width, height
|
|
|
|
|
|
|
|
do quux=1, nbre
|
|
|
|
ix = 1 + mod ( irand(), width )
|
|
|
|
iy = 1 + mod ( irand(), height )
|
|
|
|
iv = mod ( irand(), 256 )
|
|
|
|
! print *, ix, iy
|
|
|
|
picz(ix, iy) = iv
|
2023-05-07 20:23:33 +02:00
|
|
|
enddo
|
|
|
|
end subroutine
|
|
|
|
|
|
|
|
!-- ------------------------------------------------------------------
|
|
|
|
!-
|
|
|
|
!- Colorized
|
|
|
|
!-
|
|
|
|
subroutine make_noise_color_pic (value)
|
|
|
|
implicit none
|
|
|
|
integer, intent(in) :: value
|
|
|
|
|
|
|
|
integer :: foo
|
|
|
|
type(t_pixrgb), dimension(:,:), allocatable :: pix
|
|
|
|
character (len=280) :: filename
|
|
|
|
|
|
|
|
allocate(pix(320, 240))
|
|
|
|
call rgbpix_set_to_rgb(pix, 30, 30, 60)
|
|
|
|
|
|
|
|
call srand(value+34)
|
|
|
|
foo = irand()
|
|
|
|
print *, 'val=', value, ' rnd=', foo
|
|
|
|
|
|
|
|
call plot_noise_color_pic(pix, 15000)
|
|
|
|
|
|
|
|
write (filename, "(a, i5.5, a)") "./", value, ".pnm"
|
|
|
|
call rgbpix_spit_as_pnm_8(pix, trim(filename))
|
|
|
|
|
|
|
|
end subroutine
|
|
|
|
!-- ------------------------------------------------------------------
|
|
|
|
|
|
|
|
subroutine plot_noise_color_pic(prgb, nbre)
|
|
|
|
implicit none
|
|
|
|
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
|
|
|
|
integer, intent(in) :: nbre
|
|
|
|
integer :: quux, ix, iy, width, height
|
|
|
|
|
|
|
|
width = ubound(prgb, 1) ; height = ubound(prgb, 2)
|
|
|
|
|
|
|
|
do quux=1, nbre
|
|
|
|
ix = 1 + mod ( irand(), width )
|
|
|
|
iy = 1 + mod ( irand(), height )
|
|
|
|
prgb(ix, iy)%r = 64 + mod ( irand(), 127 )
|
|
|
|
prgb(ix, iy)%g = 64 + mod ( irand(), 127 )
|
|
|
|
prgb(ix, iy)%b = 64 + mod ( irand(), 127 )
|
2023-05-07 10:33:43 +02:00
|
|
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
end subroutine
|
|
|
|
|
|
|
|
!-- ------------------------------------------------------------------
|
|
|
|
end program
|