col mapper : first real try

GravityField/animation.f90

@@ -10,9 +10,9 @@ program animation
   implicit none
 
   ! some configuration constants
-  integer, parameter      :: S_WIDTH  = 1600
+  integer, parameter      :: S_WIDTH  = 1024
-  integer, parameter      :: S_HEIGHT = 1600
+  integer, parameter      :: S_HEIGHT = 1024
-  integer, parameter      :: NB_BODY  = 60
+  integer, parameter      :: NB_BODY  = 50
 
   !!! WARNING : global variable !!!
   type(massbody)          :: planets(NB_BODY)
@@ -51,12 +51,67 @@ subroutine la_grande_boucle(start, nbre, moons)
     write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
     call save_bodies_to_txt_file (planets, filename)
 
+    write (filename, "(a, i5.5, a)") 'WS/colmap/', pass, '.pgm'
+    call make_color_map(planets, filename, S_WIDTH, S_HEIGHT)
+
   enddo
 
 call print_barycentre_bodies(moons)
 
 end subroutine
 
+!-----------------------------------------------------------------------
+!-
+subroutine make_color_map(moons, fname, width, height)
+  type(massbody), intent(in)       :: moons(:)
+  character(len=*), intent(in)     :: fname
+  integer, intent(in)              :: width, height
+
+  integer, dimension(:,:), allocatable     :: map
+  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
+
+  allocate (map(width, height), stat=errcode)
+  ! write(0, *) "errcode allocate ", errcode
+
+  map = -1       ! invalidate colmap
+
+  !             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)
+        ! compute the "fake" distance
+        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
+
+      map(ix, iy) = mod(near*13, 255)
+
+    enddo
+  enddo
+
+  call spit_as_pgm_8(map, fname)
+
+  deallocate(map)
+
+end subroutine
 !-----------------------------------------------------------------------
 !-
 !     C'est ici que se passe le deplacement des choses mouvantes