Fortraneries/GrafAnim/utils_ga.f90

! -------------------------------------------------------------------
!-      fonctions diverses pour faire des images bizarres
! -------------------------------------------------------------------

module utils_ga

  use pixrgb
  implicit none

  contains

! -------------------------------------------------------------------
function fair_random_dice()
  integer            :: fair_random_dice

  fair_random_dice = 1 + int(rand()*6.0)

end function
! -------------------------------------------------------------------
!     usage  -->  see doublegauss.f90
function fair_random_gauss(hilevel)
  integer, intent(in) :: hilevel
  integer             :: fair_random_gauss
  integer             :: foo, bar

  foo = int((rand()*hilevel)/2)
  bar = int((rand()*hilevel)/2)
  fair_random_gauss = 1 + foo + bar

end function
! -------------------------------------------------------------------
!     usage  -->  see doublegauss.f90
subroutine increment_pixel(pix, k)
  type(t_pixrgb), intent(inout)  :: pix
  integer                        :: k

  pix%r = pix%r + k
  pix%g = pix%g + k
  pix%b = pix%b + k

end subroutine
! -------------------------------------------------------------------
subroutine make_bar_dot(image, ix, iy)
  type(t_pixrgb), intent(inout)  :: image(:,:)
  integer, intent(in)            :: ix, iy
  integer                        :: foo

  do foo=-1, 1
    image(ix+foo,   iy)%r = 45000
    image(ix+foo,   iy)%g =  5000
    image(ix+foo,   iy)%b = 45000
  enddo
  image(ix-2,   iy)%g = 45000
  image(ix  ,   iy)%g = 65500
  image(ix+2,   iy)%g = 45000

end subroutine
! -------------------------------------------------------------------
subroutine make_red_dot(image, ix, iy)
  type(t_pixrgb), intent(inout)  :: image(:,:)
  integer, intent(in)            :: ix, iy

  image(ix,   iy)%r = 55000
  image(ix+1, iy)%r = 55000
  image(ix-1, iy)%r = 55000
  image(ix+2, iy)%r = 55000
  image(ix-2, iy)%r = 55000
  
end subroutine
!-- ------------------------------------------------------------------
subroutine make_blue_dot(image, ix, iy)
  type(t_pixrgb), intent(inout)  :: image(:,:)
  integer, intent(in)            :: ix, iy

  image(ix,   iy)%b = 65000
  image(ix, iy+1)%b = 65000
  image(ix, iy-1)%b = 65000
  image(ix, iy+2)%b = 65000
  image(ix, iy-2)%b = 65000
  
end subroutine
!-- ------------------------------------------------------------------


subroutine make_big_dot(image, ix, iy)
  type(t_pixrgb), intent(inout)  :: image(:,:)
  integer, intent(in)            :: ix, iy

  image(ix,   iy)%g   = 65000

  image(ix-1, iy)%g   = 56000
  image(ix,   iy-1)%g = 56000
  image(ix+1, iy)%g   = 56000
  image(ix,   iy+1)%g = 56000

  image(ix+1, iy+1)%g = 24000
  image(ix-1, iy+1)%g = 24000
  image(ix+1, iy-1)%g = 24000
  image(ix-1, iy-1)%g = 24000

end subroutine

!-- ------------------------------------------------------------------

subroutine dim_pix_rgb_sub(pix, k)
  type(t_pixrgb), intent(inout)  :: pix(:,:)
  integer,intent(in)             :: k
  integer                        :: ix, iy

  ! write(0, *) "dim pixrgb", k

  do ix=1, ubound(pix, 1)
    do iy=1, ubound(pix, 2)
      if (pix(ix,iy)%r .GT. k) then
        pix(ix,iy)%r = pix(ix,iy)%r - k
      endif
      if (pix(ix,iy)%g .GT. k) then
        pix(ix,iy)%g = pix(ix,iy)%g - k
      endif
      if (pix(ix,iy)%b .GT. k) then
        pix(ix,iy)%b = pix(ix,iy)%b - k
      endif
    enddo
  enddo

end subroutine
! -------------------------------------------------------------------
subroutine clear_image(image, border)

  type(t_pixrgb), intent(inout)  :: image(:,:)
  integer, intent(in)            :: border
  integer                        :: ix, iy

  ! write(0, *) "dim 1 =", ubound(image, 1)
  ! write(0, *) "dim 2 =", ubound(image, 2)

  do ix=1+border, ubound(image, 1)-border
    do iy=1+border, ubound(image, 2)-border
      image(ix, iy)%r = 5555
      image(ix, iy)%g = 0
      image(ix, iy)%b = 0
    enddo
  enddo

end subroutine
! -------------------------------------------------------------------

subroutine dim_pix_rgb_mul(pix, fk)
  type(t_pixrgb), intent(inout)  :: pix(:,:)
  real,intent(in)                :: fk

  integer                        :: ix, iy

  ! write(0, *) "dim pixrgb", k

  do ix=1, ubound(pix, 1)
    do iy=1, ubound(pix, 2)

      pix(ix,iy)%r = int(float(pix(ix,iy)%r)*fk)
      pix(ix,iy)%g = int(float(pix(ix,iy)%g)*fk)
      pix(ix,iy)%b = int(float(pix(ix,iy)%b)*fk)

    enddo
  enddo

end subroutine

! -------------------------------------------------------------------
subroutine fill_random_gauss(image, mval, marge)
  type(t_pixrgb), intent(inout)  :: image(:,:)
  integer,intent(in)             :: mval, marge
  integer                        :: ix, iy

  ! write(0, *) "dim 1 =", ubound(image, 1)
  ! write(0, *) "dim 2 =", ubound(image, 2)

  do ix=1+marge, ubound(image, 1)-marge
    do iy=1+marge, ubound(image, 2)-marge
      image(ix, iy)%r = fair_random_gauss(mval)
      image(ix, iy)%g = fair_random_gauss(mval)
      image(ix, iy)%b = fair_random_gauss(mval)
    enddo
  enddo

end subroutine

!-- ------------------------------------------------------------------
end module