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  = 82

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

  call init_random()
  call create_some_planets(planets, 1337e3, 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)
  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 = 45
  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.25*(rand()-0.499999))
    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