update noisepictures

2023-06-09 23:59:54 +02:00
parent c2648077f2
commit 920a864b22
4 changed files with 141 additions and 34 deletions
--- a/Modules/noisepictures.f90
+++ b/Modules/noisepictures.f90
@@ -0,0 +1,80 @@
+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
+
+end subroutine
+!-----------------------------------------------------------------------
+end module noisepictures