2023-06-09 23:59:54 +02:00
|
|
|
module noisepictures
|
|
|
|
|
use pixrgb
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
contains ! a lot of garbage ?
|
|
|
|
|
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
subroutine noise_gray8_pic(pict, nbre)
|
|
|
|
|
implicit none
|
|
|
|
|
integer, dimension(:,:), intent(inout) :: pict
|
|
|
|
|
integer, intent(in) :: nbre
|
|
|
|
|
integer :: quux, ix, iy, width, height
|
|
|
|
|
|
|
|
|
|
width = ubound(pict, 1) ; height = ubound(pict, 2)
|
|
|
|
|
|
|
|
|
|
do quux=1, nbre
|
|
|
|
|
ix = 1 + mod ( irand(), width )
|
|
|
|
|
iy = 1 + mod ( irand(), height )
|
|
|
|
|
pict(ix, iy) = mod ( irand(), 256 )
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
end subroutine
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
subroutine noise_gray16_pic(pict, nbre)
|
|
|
|
|
implicit none
|
|
|
|
|
integer, dimension(:,:), intent(inout) :: pict
|
|
|
|
|
integer, intent(in) :: nbre
|
|
|
|
|
integer :: quux, ix, iy, width, height
|
|
|
|
|
|
|
|
|
|
width = ubound(pict, 1) ; height = ubound(pict, 2)
|
|
|
|
|
|
|
|
|
|
do quux=1, nbre
|
|
|
|
|
ix = 1 + mod ( irand(), width )
|
|
|
|
|
iy = 1 + mod ( irand(), height )
|
|
|
|
|
pict(ix, iy) = mod ( irand(), 65536 )
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
end subroutine
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
subroutine noise_rgb8_pic(prgb, nbre)
|
|
|
|
|
implicit none
|
|
|
|
|
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
|
|
|
|
|
integer, intent(in) :: nbre
|
|
|
|
|
integer :: quux, ix, iy, width, height
|
|
|
|
|
|
|
|
|
|
print *, 'noise_rgb_pic', nbre
|
|
|
|
|
|
|
|
|
|
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 = mod ( irand(), 256 )
|
|
|
|
|
prgb(ix, iy)%g = mod ( irand(), 256 )
|
|
|
|
|
prgb(ix, iy)%b = mod ( irand(), 256 )
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
end subroutine
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
subroutine noise_rgb16_pic(prgb, nbre)
|
|
|
|
|
implicit none
|
|
|
|
|
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
|
|
|
|
|
integer, intent(in) :: nbre
|
|
|
|
|
integer :: quux, ix, iy, width, height
|
|
|
|
|
|
|
|
|
|
print *, 'noise_rgb_pic', nbre
|
|
|
|
|
|
|
|
|
|
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 = mod ( irand(), 65536 )
|
|
|
|
|
prgb(ix, iy)%g = mod ( irand(), 65536 )
|
|
|
|
|
prgb(ix, iy)%b = mod ( irand(), 65536 )
|
|
|
|
|
enddo
|
|
|
|
|
|
2023-06-10 08:52:36 +02:00
|
|
|
end subroutine
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
! new: Sat Jun 10 06:50:51 UTC 2023
|
|
|
|
|
|
|
|
|
|
subroutine noise_range_rgb16_pic(prgb, rngs, nbre)
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
|
|
|
|
|
integer, intent(in) :: rngs(6)
|
|
|
|
|
integer, intent(in) :: nbre
|
2023-10-10 22:08:50 +02:00
|
|
|
integer :: foo, ix, iy
|
2023-06-10 08:52:36 +02:00
|
|
|
|
2023-10-10 22:08:50 +02:00
|
|
|
! print *, 'noise rgb16 range', nbre
|
|
|
|
|
! print *, 'rngs', rngs
|
2023-06-10 08:52:36 +02:00
|
|
|
|
2023-10-10 22:08:50 +02:00
|
|
|
do foo = 1, nbre
|
|
|
|
|
ix = 1 + mod ( irand(), ubound(prgb, 1) )
|
|
|
|
|
iy = 1 + mod ( irand(), ubound(prgb, 2) )
|
|
|
|
|
prgb(ix, iy)%r = rngs(1) + mod(irand(), rngs(2) - rngs(1))
|
2023-06-10 08:52:36 +02:00
|
|
|
|
2023-10-10 22:08:50 +02:00
|
|
|
ix = 1 + mod ( irand(), ubound(prgb, 1) )
|
|
|
|
|
iy = 1 + mod ( irand(), ubound(prgb, 2) )
|
|
|
|
|
prgb(ix, iy)%g = rngs(3) + mod(irand(), rngs(4) - rngs(3))
|
|
|
|
|
|
|
|
|
|
ix = 1 + mod ( irand(), ubound(prgb, 1) )
|
|
|
|
|
iy = 1 + mod ( irand(), ubound(prgb, 2) )
|
|
|
|
|
prgb(ix, iy)%b = rngs(5) + mod(irand(), rngs(6) - rngs(5))
|
2023-06-10 08:52:36 +02:00
|
|
|
enddo
|
|
|
|
|
|
2023-06-09 23:59:54 +02:00
|
|
|
end subroutine
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
end module noisepictures
|
