Fortraneries/GravityField/animation.f90

179 lines
5.4 KiB
Fortran
Raw Normal View History

2022-12-03 02:25:37 +01:00
!-----------------------------------------------------------------------
!-
! Project "gravity field" - Firts renderer
!-
!-----------------------------------------------------------------------
program animation
use realfield
2022-12-15 15:03:37 +01:00
use spitpgm ! extern module
2022-12-16 21:16:02 +01:00
use pixrgb ! extern module
2022-12-15 15:03:37 +01:00
2022-12-03 02:25:37 +01:00
implicit none
! some configuration constants
2022-12-13 23:03:01 +01:00
integer, parameter :: S_WIDTH = 1024
integer, parameter :: S_HEIGHT = 1024
2022-12-15 15:03:37 +01:00
integer, parameter :: NB_BODY = 51
2022-12-03 02:25:37 +01:00
2022-12-11 09:25:23 +01:00
!!! WARNING : global variable !!!
2022-12-03 02:25:37 +01:00
type(massbody) :: planets(NB_BODY)
call init_random()
2022-12-11 09:25:23 +01:00
call create_some_planets(planets, 1664e3, S_WIDTH , S_HEIGHT)
2022-12-05 13:10:40 +01:00
call print_barycentre_bodies(planets)
! STOP 'BEFORE CRASH'
2022-12-03 20:42:29 +01:00
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
2022-12-05 13:10:40 +01:00
! if second parameter is TRUE, use clipping,
! else use ?????ing
call deplace_les_planetes(moons, .TRUE.)
2022-12-03 20:42:29 +01:00
write (filename, "(a, i5.5, a)") 'WS/nanim/', pass, '.pgm'
2022-12-05 13:10:40 +01:00
write(0, '(3I5, " * ", a20)') start, nbre, pass, filename
2022-12-03 20:42:29 +01:00
call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
2022-12-11 09:25:23 +01:00
write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
call save_bodies_to_txt_file (planets, filename)
2022-12-16 21:16:02 +01:00
write (filename, "(a, i5.5, a)") 'WS/colmap/', pass, '.pnm'
2022-12-13 23:03:01 +01:00
call make_color_map(planets, filename, S_WIDTH, S_HEIGHT)
2022-12-03 20:42:29 +01:00
enddo
2022-12-03 02:25:37 +01:00
2022-12-05 13:10:40 +01:00
call print_barycentre_bodies(moons)
2022-12-03 20:42:29 +01:00
end subroutine
2022-12-03 02:25:37 +01:00
2022-12-13 23:03:01 +01:00
!-----------------------------------------------------------------------
!-
! this is going to go very complex
!-
2022-12-13 23:03:01 +01:00
subroutine make_color_map(moons, fname, width, height)
type(massbody), intent(in) :: moons(:)
character(len=*), intent(in) :: fname
integer, intent(in) :: width, height
2022-12-16 21:16:02 +01:00
type(t_pixrgb), dimension(:,:), allocatable :: cmap
2022-12-13 23:03:01 +01:00
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
2022-12-16 21:16:02 +01:00
allocate (cmap(width, height), stat=errcode)
2022-12-13 23:03:01 +01:00
! write(0, *) "errcode allocate ", errcode
2022-12-16 21:16:02 +01:00
! map = -1 ! invalidate colmap
2022-12-13 23:03:01 +01:00
! 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)
2022-12-15 15:03:37 +01:00
! compute the pseudo distance
2022-12-13 23:03:01 +01:00
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
2022-12-16 21:16:02 +01:00
cmap(ix, iy)%r = mod(near*13, 255)
cmap(ix, iy)%g = mod(near*14, 255)
cmap(ix, iy)%b = mod(near*15, 255)
2022-12-13 23:03:01 +01:00
enddo
enddo
2022-12-16 21:16:02 +01:00
call rgbpix_spit_as_pnm(cmap, fname)
2022-12-13 23:03:01 +01:00
2022-12-16 21:16:02 +01:00
deallocate(cmap)
2022-12-13 23:03:01 +01:00
end subroutine
2022-12-03 20:42:29 +01:00
!-----------------------------------------------------------------------
2022-12-05 13:10:40 +01:00
!-
! 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)
2022-12-03 20:42:29 +01:00
type(massbody), intent(inout) :: moons(:)
2022-12-05 13:10:40 +01:00
logical, intent(in) :: clipit
2022-12-03 20:42:29 +01:00
integer :: foo
real :: depx, depy
2022-12-12 00:58:58 +01:00
integer, parameter :: EE = 51
2022-12-05 13:10:40 +01:00
integer :: SW = S_WIDTH - EE
integer :: SH = S_HEIGHT - EE
2022-12-03 20:42:29 +01:00
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
2022-12-05 13:10:40 +01:00
! bords du chanmp. Clipping, Toring or Boucing ?
2022-12-03 20:42:29 +01:00
!-
2022-12-05 13:10:40 +01:00
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
2022-12-15 15:03:37 +01:00
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
2022-12-03 20:42:29 +01:00
enddo
end subroutine
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
2022-12-03 02:25:37 +01:00
end program
2022-12-03 20:42:29 +01:00