117 lines
3.6 KiB
Fortran
117 lines
3.6 KiB
Fortran
!-----------------------------------------------------------------------
|
|
!-
|
|
! Project "gravity field" - Firts renderer
|
|
!-
|
|
!-----------------------------------------------------------------------
|
|
program animation
|
|
|
|
use realfield
|
|
use spitpgm
|
|
implicit none
|
|
|
|
! some configuration constants
|
|
integer, parameter :: S_WIDTH = 1600
|
|
integer, parameter :: S_HEIGHT = 1600
|
|
integer, parameter :: NB_BODY = 60
|
|
|
|
!!! 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)
|
|
|
|
enddo
|
|
|
|
call print_barycentre_bodies(moons)
|
|
|
|
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.73*(rand()-0.50))
|
|
if (moons(foo)%heading .GT. 6.2831853) moons(foo)%heading = 0.0
|
|
if (moons(foo)%heading .LT. 0.0000001) moons(foo)%heading = 0.0
|
|
|
|
enddo
|
|
|
|
end subroutine
|
|
!-----------------------------------------------------------------------
|
|
!-----------------------------------------------------------------------
|
|
|
|
end program
|
|
|
|
|
|
|