! ------------------------------------------------------------------- !- 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