trying to use the new rgb pixels module
This commit is contained in:
parent
fc03c70454
commit
e780a79273
@ -2,8 +2,8 @@
|
|||||||
# Fortraneries by tTh - Gravity Field
|
# Fortraneries by tTh - Gravity Field
|
||||||
#
|
#
|
||||||
|
|
||||||
GFOPT = -Wall -Wextra -g -pg -time -I../Modules
|
GFOPT = -Wall -Wextra -g -time -I../Modules
|
||||||
MODOBJ = ../Modules/spitpgm.o
|
MODOBJ = ../Modules/spitpgm.o ../Modules/pixrgb.o
|
||||||
|
|
||||||
all: essai animation
|
all: essai animation
|
||||||
|
|
||||||
|
@ -64,6 +64,8 @@ end subroutine
|
|||||||
|
|
||||||
!-----------------------------------------------------------------------
|
!-----------------------------------------------------------------------
|
||||||
!-
|
!-
|
||||||
|
! this is going to go very complex
|
||||||
|
!-
|
||||||
subroutine make_color_map(moons, fname, width, height)
|
subroutine make_color_map(moons, fname, width, height)
|
||||||
type(massbody), intent(in) :: moons(:)
|
type(massbody), intent(in) :: moons(:)
|
||||||
character(len=*), intent(in) :: fname
|
character(len=*), intent(in) :: fname
|
||||||
|
@ -4,8 +4,9 @@
|
|||||||
!-
|
!-
|
||||||
!-----------------------------------------------------------------------
|
!-----------------------------------------------------------------------
|
||||||
program essai
|
program essai
|
||||||
use realfield
|
use realfield
|
||||||
use spitpgm ! XXX
|
use spitpgm ! XXX
|
||||||
|
use pixrgb
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
@ -23,17 +24,17 @@ contains
|
|||||||
subroutine essai_near_planet(nbplanets, szfield)
|
subroutine essai_near_planet(nbplanets, szfield)
|
||||||
integer, intent(in) :: nbplanets, szfield
|
integer, intent(in) :: nbplanets, szfield
|
||||||
|
|
||||||
integer, dimension(:,:), allocatable :: map
|
type(t_pixrgb), dimension(:,:), allocatable :: cmap
|
||||||
integer :: ix, iy
|
integer :: ix, iy
|
||||||
real :: fx, fy, dx, dy
|
real :: fx, fy, dx, dy
|
||||||
integer :: near, ipl, errcode
|
integer :: near, ipl, errcode
|
||||||
real :: curdist, smalldist
|
real :: curdist, smalldist
|
||||||
type(massbody) :: planets(nbplanets)
|
type(massbody) :: planets(nbplanets)
|
||||||
|
|
||||||
print *, "near planets test", nbplanets, szfield
|
print *, "near planets test", nbplanets, szfield
|
||||||
|
|
||||||
allocate(map(szfield, szfield), stat=errcode)
|
allocate(cmap(szfield, szfield), stat=errcode)
|
||||||
map = -1
|
! map = -1
|
||||||
|
|
||||||
! create some random bodies
|
! create some random bodies
|
||||||
do ipl=1, nbplanets
|
do ipl=1, nbplanets
|
||||||
@ -63,7 +64,9 @@ subroutine essai_near_planet(nbplanets, szfield)
|
|||||||
endif
|
endif
|
||||||
end do ! loop on ipl
|
end do ! loop on ipl
|
||||||
|
|
||||||
map(ix, iy) = mod(near, 255)
|
cmap(ix, iy)%r = mod(near*2, 255)
|
||||||
|
cmap(ix, iy)%g = mod(near*3, 255)
|
||||||
|
cmap(ix, iy)%b = mod(near*4, 255)
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -71,7 +74,7 @@ subroutine essai_near_planet(nbplanets, szfield)
|
|||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call spit_as_pgm_8(map, "nearest.pgm")
|
call rgbpix_spit_as_pnm(cmap, "rgb.pnm")
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
!-----------------------------------------------------------------------
|
!-----------------------------------------------------------------------
|
||||||
|
Loading…
Reference in New Issue
Block a user