151 lines
4.0 KiB
Fortran
151 lines
4.0 KiB
Fortran
! -------------------------------------------------------------------
|
|
!- 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
|
|
|
|
|
|
|
|
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 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
|