From 5b6df523fc55abfd90fb342fb2545ec952c4019d Mon Sep 17 00:00:00 2001 From: tTh Date: Mon, 5 Dec 2022 13:10:40 +0100 Subject: [PATCH] we are on a good way, maybe... --- GravityField/Makefile | 4 +-- GravityField/README.md | 22 ++++++++++++++-- GravityField/animation.f90 | 52 +++++++++++++++++++++++++----------- GravityField/realfield.f90 | 54 ++++++++++++++++++++++++-------------- GravityField/vision.pov | 15 ++++++++--- 5 files changed, 104 insertions(+), 43 deletions(-) diff --git a/GravityField/Makefile b/GravityField/Makefile index c2d1490..f3a654f 100644 --- a/GravityField/Makefile +++ b/GravityField/Makefile @@ -3,9 +3,9 @@ # GFOPT = -Wall -Wextra -g -time -I../Modules -MODOBJ = '../Modules/spitpgm.o' +MODOBJ = ../Modules/spitpgm.o -all: essai +all: essai animation # ----------- modules diff --git a/GravityField/README.md b/GravityField/README.md index 5dd6455..b9e3e53 100644 --- a/GravityField/README.md +++ b/GravityField/README.md @@ -1,5 +1,23 @@ -# Gravity Field +# Gravity Field Experiment -Some crude experiments to make fancy picture of a useless gravaity field. +_Some crude experiments to make fancy picture of a useless gravity field._ Expect bug party. + +## Le module `realfield` + +Les mécaniques sous-jacentes. Sans la moindre rigueur mathématique. + +## Le commandeur en chef + +C'est le logiciel sobrement nommé `animation` qui n'est absolument +pas fini. Par exemple, il n'est absolument pas paramétrable sans +passer per une recompilation. + +## Le raytracing + +Vous vous en doutez, c'est du POVray. + +## Conclusion + +Enjoy ! diff --git a/GravityField/animation.f90 b/GravityField/animation.f90 index a8c7419..041a93f 100644 --- a/GravityField/animation.f90 +++ b/GravityField/animation.f90 @@ -12,15 +12,16 @@ program animation ! some configuration constants integer, parameter :: S_WIDTH = 1024 integer, parameter :: S_HEIGHT = 1024 - integer, parameter :: NB_BODY = 150 + integer, parameter :: NB_BODY = 82 !!! 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 print_barycentre_bodies(planets) + + ! STOP 'BEFORE CRASH' call la_grande_boucle(0, 2000, planets) @@ -39,25 +40,37 @@ subroutine la_grande_boucle(start, nbre, moons) 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, *) filename - + write(0, '(3I5, " * ", a20)') start, nbre, pass, filename call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename) - - call deplace_les_planetes(moons) - enddo +call print_barycentre_bodies(moons) + end subroutine !----------------------------------------------------------------------- -subroutine deplace_les_planetes(moons) +!- +! 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 @@ -68,15 +81,24 @@ subroutine deplace_les_planetes(moons) !- ! ici se pose une question pertinente sur la gestion des - ! bords du chanmp. Cclippin or Boucing ? + ! bords du chanmp. Clipping, Toring 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 + 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.08*rand()) + 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 diff --git a/GravityField/realfield.f90 b/GravityField/realfield.f90 index bf73f49..cc2f361 100644 --- a/GravityField/realfield.f90 +++ b/GravityField/realfield.f90 @@ -9,11 +9,12 @@ module realfield implicit none !----------------------------------------------------------------------- +!- ! definition of structures !- type massbody - real :: posx, posy - real :: heading = 0.21 + real :: posx = 0, posy = 0 + real :: heading = 0.29 real :: speed = 1.017 real :: mass = 1.0 integer :: serial = 666 @@ -22,63 +23,76 @@ end type !----------------------------------------------------------------------- contains !----------------------------------------------------------------------- -subroutine barycentre_bodies(astres) +subroutine compute_barycentre_bodies(astres, bcx, bcy) type(massbody), intent(in) :: astres(:) - - real :: cx, cy + real, intent(out) :: bcx, bcy integer :: foo + real :: cx, cy - !- ! May be we have to use DOUBLE RPECSION here ? - !- cx = 0.0 cy = 0.0 do foo=1, ubound(astres, 1) cx = cx + astres(foo)%posx cy = cy + astres(foo)%posy enddo - cx = cx / real(ubound(astres, 1)) - cy = cy / real(ubound(astres, 1)) - print *, 'barycentre:', cx, cy + bcx = cx / real(ubound(astres, 1)) + bcy = cy / real(ubound(astres, 1)) +end subroutine +!----------------------------------------------------------------------- +subroutine print_barycentre_bodies(astres) + type(massbody), intent(in) :: astres(:) + real :: cx, cy + + call compute_barycentre_bodies(astres, cx, cy) + print *, "barycentre : ", cx, cy end subroutine !----------------------------------------------------------------------- !- -! make a few solid body to play with... +! make a few solid body to play with... +!- +! planets : an array of type(massbody) to be filled +! coef : for setting the mass of the body +! sx, sy : borders of the universe !- subroutine create_some_planets(planets, coef, sx, sy) type(massbody), intent(inout) :: planets(:) real, intent(in) :: coef integer, intent(in) :: sx, sy - integer :: foo character(100) :: fmt fmt = "(I4, ' | ', 2(F10.2, ' '), ' | ', 2F9.3, ' ', e12.3, I7)" do foo=1, ubound(planets, 1) - !- - ! the first planet is the home of Johnny Root - !- if (foo .EQ. 1) then + !- + ! the first planet is the home of Johnny Root + !- planets(1)%posx = sx / 2 planets(1)%posy = sy / 2 - planets(1)%mass = 37e8 + planets(1)%mass = 29e8 planets(1)%serial = 1337 + planets(1)%speed = 6.666 else + !- + ! others are planets for peones + !- planets(foo)%posx = rand() * real(sx-1) planets(foo)%posy = rand() * real(sy-1) planets(foo)%mass = 7e6 + coef*foo planets(foo)%heading = 3.14159 * rand() - if (rand() .LT. 0.01) planets(foo)%speed = 2.718 + if (rand() .LT. 0.08) planets(foo)%speed = 3.14159 planets(foo)%serial = foo*2 + 120 endif write (*, fmt) foo, planets(foo) enddo - end subroutine !----------------------------------------------------------------------- - +!- +! the basis of the kluge +!- function compute_gravity(fx, fy, body) real, intent(in) :: fx, fy type(massbody), intent(in) :: body @@ -88,7 +102,7 @@ function compute_gravity(fx, fy, body) rx = fx - body%posx ry = fy - body%posy dist = sqrt( (rx*rx) + (ry*ry) ) - if (dist .LT. 0.11) then + if (dist .LT. 0.08) then ! write (0, *) "dist too small ", dist compute_gravity = 0e0 else diff --git a/GravityField/vision.pov b/GravityField/vision.pov index 7737c29..6750852 100644 --- a/GravityField/vision.pov +++ b/GravityField/vision.pov @@ -14,6 +14,7 @@ global_settings { #include "colors.inc" #declare NormClock = clock / 2000.01; +#debug concat("- - - - - - - ", str(NormClock, 7, 5), "\n") // ---------------------------------------------------------------------- @@ -35,11 +36,17 @@ texture { } } -object { GravityField scale <4, 0.70, 4> } +object { GravityField scale <4, 0.60, 4> } // ---------------------------------------------------------------------- -cylinder { <0, -0.5, 0>, <0, 1, 0>, 0.0175 pigment { color Red } } +/* XXX +merge { + cylinder { <0, -0.5, 0>, <0, 1, 0>, 0.0175 } + sphere { <0, 1, 0>, 0.0175 } + pigment { color Red } + } +XXX */ light_source { < -2, 9.3, -7> color Gray90 } light_source { < -6, 9.3, -8> color Orange*0.75 } @@ -48,10 +55,10 @@ light_source { < -15, 2.3, 17> color Green*0.25 } // ---------------------------------------------------------------------- camera { - location <-8, 4-NormClock, 1 + 3*NormClock> + location <-8, 4-NormClock, 1 + (5*NormClock)> look_at <0, 0, 0> right x*image_width/image_height - angle 34 + angle 33 } // ----------------------------------------------------------------------