179 lines
5.4 KiB
Fortran
179 lines
5.4 KiB
Fortran
!-----------------------------------------------------------------------
|
|
!-
|
|
! Project "gravity field" - Firts renderer
|
|
!-
|
|
!-----------------------------------------------------------------------
|
|
program animation
|
|
|
|
use realfield
|
|
|
|
use spitpgm ! extern module
|
|
use pixrgb ! extern module
|
|
|
|
implicit none
|
|
|
|
! some configuration constants
|
|
integer, parameter :: S_WIDTH = 1024
|
|
integer, parameter :: S_HEIGHT = 1024
|
|
integer, parameter :: NB_BODY = 51
|
|
|
|
!!! WARNING : global variable !!!
|
|
type(massbody) :: planets(NB_BODY)
|
|
|
|
call init_random()
|
|
call create_some_planets(planets, 1664e3, S_WIDTH , S_HEIGHT)
|
|
call print_barycentre_bodies(planets)
|
|
|
|
! STOP 'BEFORE CRASH'
|
|
|
|
call la_grande_boucle(0, 2000, planets)
|
|
|
|
STOP ': YOLO TIME *NOW*'
|
|
|
|
!-----------------------------------------------------------------------
|
|
contains
|
|
!-
|
|
! fabrication d'une de la sequence complete
|
|
!-
|
|
subroutine la_grande_boucle(start, nbre, moons)
|
|
integer, intent(in) :: start, nbre
|
|
type(massbody), intent(inout) :: moons(:)
|
|
|
|
character(len=100) :: filename
|
|
integer :: pass
|
|
|
|
do pass=start, start+nbre-1
|
|
! if second parameter is TRUE, use clipping,
|
|
! else use ?????ing
|
|
call deplace_les_planetes(moons, .TRUE.)
|
|
|
|
write (filename, "(a, i5.5, a)") 'WS/nanim/', pass, '.pgm'
|
|
write(0, '(3I5, " * ", a20)') start, nbre, pass, filename
|
|
call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
|
|
|
|
write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
|
|
call save_bodies_to_txt_file (planets, filename)
|
|
|
|
write (filename, "(a, i5.5, a)") 'WS/colmap/', pass, '.pnm'
|
|
call make_color_map(planets, filename, S_WIDTH, S_HEIGHT)
|
|
|
|
enddo
|
|
|
|
call print_barycentre_bodies(moons)
|
|
|
|
end subroutine
|
|
|
|
!-----------------------------------------------------------------------
|
|
!-
|
|
! this is going to go very complex
|
|
!-
|
|
subroutine make_color_map(moons, fname, width, height)
|
|
type(massbody), intent(in) :: moons(:)
|
|
character(len=*), intent(in) :: fname
|
|
integer, intent(in) :: width, height
|
|
|
|
type(t_pixrgb), dimension(:,:), allocatable :: cmap
|
|
integer :: ix, iy, near, ipl
|
|
integer :: errcode
|
|
real :: curdist, smalldist
|
|
real :: fx, fy, dx, dy
|
|
|
|
write(0, *) "colmap ", ubound(moons, 1), "moons to ", trim(fname)
|
|
! write(0, *) "mapsize ", width, height
|
|
|
|
allocate (cmap(width, height), stat=errcode)
|
|
! write(0, *) "errcode allocate ", errcode
|
|
|
|
! map = -1 ! invalidate colmap
|
|
|
|
! DO SOME GOOD STUFF HERE
|
|
do ix=1, width
|
|
fx = real(ix)
|
|
do iy=1, height
|
|
fy = real(iy)
|
|
|
|
near = -1
|
|
smalldist = 1e37
|
|
|
|
! loop over all the planet's bodies
|
|
do ipl=1, ubound(moons, 1)
|
|
! compute the pseudo distance
|
|
dx = fx - moons(ipl)%posx
|
|
dy = fy - moons(ipl)%posy
|
|
curdist = (dx*dx) + (dy*dy)
|
|
if (curdist .LT. smalldist) then
|
|
near = ipl
|
|
smalldist = curdist
|
|
endif
|
|
end do ! loop on all the moons, ipl index
|
|
|
|
cmap(ix, iy)%r = mod(near*13, 255)
|
|
cmap(ix, iy)%g = mod(near*14, 255)
|
|
cmap(ix, iy)%b = mod(near*15, 255)
|
|
|
|
enddo
|
|
enddo
|
|
|
|
call rgbpix_spit_as_pnm(cmap, fname)
|
|
|
|
deallocate(cmap)
|
|
|
|
end subroutine
|
|
!-----------------------------------------------------------------------
|
|
!-
|
|
! C'est ici que se passe le deplacement des choses mouvantes
|
|
!-
|
|
! Il y a deux manieres d'aborder les bords de l'univers (non, le combo
|
|
! segfault/coredump n'en fait pas partie).
|
|
!-
|
|
subroutine deplace_les_planetes(moons, clipit)
|
|
type(massbody), intent(inout) :: moons(:)
|
|
logical, intent(in) :: clipit
|
|
|
|
integer :: foo
|
|
real :: depx, depy
|
|
|
|
integer, parameter :: EE = 51
|
|
integer :: SW = S_WIDTH - EE
|
|
integer :: SH = S_HEIGHT - EE
|
|
|
|
do foo=1, ubound(moons, 1)
|
|
|
|
! print *, "----- deplace ",foo, "serial ", moons(foo)%serial
|
|
depx = moons(foo)%speed * sin(moons(foo)%heading)
|
|
depy = moons(foo)%speed * cos(moons(foo)%heading)
|
|
moons(foo)%posx = moons(foo)%posx + depx
|
|
moons(foo)%posy = moons(foo)%posy + depy
|
|
|
|
!-
|
|
! ici se pose une question pertinente sur la gestion des
|
|
! bords du chanmp. Clipping, Toring or Boucing ?
|
|
!-
|
|
if (clipit) then
|
|
if (moons(foo)%posx .GT. SW) moons(foo)%posx = SW
|
|
if (moons(foo)%posy .GT. SH) moons(foo)%posy = SH
|
|
if (moons(foo)%posx .LT. EE) moons(foo)%posx = EE
|
|
if (moons(foo)%posy .LT. EE) moons(foo)%posy = EE
|
|
! STOP 'BECAUSE WE ARE TOTALY FUCKED'
|
|
else
|
|
if (moons(foo)%posx .GT. SW) moons(foo)%posx = EE
|
|
if (moons(foo)%posy .GT. SH) moons(foo)%posy = EE
|
|
if (moons(foo)%posx .LT. EE) moons(foo)%posx = SW
|
|
if (moons(foo)%posy .LT. EE) moons(foo)%posy = SH
|
|
endif
|
|
|
|
moons(foo)%heading = moons(foo)%heading + (0.78*(rand()-0.50))
|
|
if (moons(foo)%heading .GT. 6.283185307) moons(foo)%heading = 0.0
|
|
if (moons(foo)%heading .LT. 0.000000001) moons(foo)%heading = 0.0
|
|
|
|
enddo
|
|
|
|
end subroutine
|
|
!-----------------------------------------------------------------------
|
|
!-----------------------------------------------------------------------
|
|
|
|
end program
|
|
|
|
|
|
|