Fortraneries/GravityField/animation.f90

!-----------------------------------------------------------------------
!-
!       Project "gravity field" - Firts renderer
!-
!-----------------------------------------------------------------------
program animation

  use realfield
  use spitpgm               
  implicit none

  ! some configuration constants
  integer, parameter      :: S_WIDTH  = 1024
  integer, parameter      :: S_HEIGHT = 1024
  integer, parameter      :: NB_BODY  = 150

  !!! WARNING : global variables !!!
  type(massbody)          :: planets(NB_BODY)
  ! integer                 :: foo

  call init_random()
  call create_some_planets(planets, 1337e3, S_WIDTH , S_HEIGHT)
  call barycentre_bodies(planets)

  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
  
    write (filename, "(a, i5.5, a)") 'WS/nanim/', pass, '.pgm'
    write(0, *) filename

    call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)

    call deplace_les_planetes(moons)

  enddo

end subroutine

!-----------------------------------------------------------------------
subroutine deplace_les_planetes(moons)
  type(massbody), intent(inout)    :: moons(:)

  integer                 :: foo
  real                    :: depx, depy

  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. Cclippin or Boucing ?
    !-
    if (moons(foo)%posx .GT. S_WIDTH)   moons(foo)%posx = 0.0
    if (moons(foo)%posy .GT. S_HEIGHT)  moons(foo)%posy = 0.0
    if (moons(foo)%posx .LT. 0)         moons(foo)%posx = S_WIDTH
    if (moons(foo)%posy .LT. 0)         moons(foo)%posy = S_HEIGHT

    moons(foo)%heading = moons(foo)%heading + (0.08*rand())
    if (moons(foo)%heading .GT. 6.2831853) moons(foo)%heading = 0.0

  enddo

end subroutine
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

end program