!----------------------------------------------------------------------- !- ! 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