Compare commits

..

5 Commits

Author SHA1 Message Date
tTh
5b6df523fc we are on a good way, maybe... 2022-12-05 13:10:40 +01:00
tTh
8c9625b7df update to current wopzer 2022-12-05 12:51:22 +01:00
tTh
f105d95571 fine tuning 2022-12-05 12:47:51 +01:00
tTh
2f2ae51352 + *.stderr 2022-12-04 23:50:16 +01:00
tTh
046c9f0b56 two small fix 2022-12-04 17:49:49 +01:00
10 changed files with 123 additions and 59 deletions

View File

@ -1,4 +1,4 @@
program genbloubs
program exportbloubs
use bloubspace
implicit none
@ -11,7 +11,7 @@ program genbloubs
! parsing command line
i = IARGC()
if (1 .ne. i) then
STOP ' :BAD COMMAND LINE'
STOP ' : BAD COMMAND LINE'
endif
call getarg(1, filename)

View File

@ -11,7 +11,7 @@ WS/*/*.png
*.log
*.mp4
pov.stderr
*.stderr
foo.pgm
bar.pgm

View File

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

View File

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

View File

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

View File

@ -27,7 +27,7 @@ case $filetype in
esac
echo "extension :" $extension
TITLE='---{ experimental gravity field }---'
TITLE=$(printf -- '---{ experimental gravity field %d }---' $$)
ffmpeg -nostdin \
-loglevel warning \
@ -37,6 +37,6 @@ ffmpeg -nostdin \
-c:v libx264 -pix_fmt yuv420p \
$FNAME
echo
echo $FNAME ' ..... [done]'

View File

@ -2,16 +2,20 @@
set -e
POVOPT=" -q9 +a -W1280 -H1024 +WT2 -d -v "
POVOPT=" -q9 +a -W1024 -H768 +WT2 -d -v "
SOURCE="vision.pov"
TMPF="/dev/shm/gravfield.png"
date > pov.stderr
# ---------------------------------------
une_passe ()
{
clock=$1
cp pov.stderr old.stderr
povray -i${SOURCE} -K${clock} $POVOPT -O${TMPF} 2> pov.stderr
timestamp=$(date -u +'%F %H:%M' | tr '01' 'Ol')
@ -20,14 +24,14 @@ outfile=$(printf "WS/troid/%05d.png" $clock)
echo $timestamp $texte $outfile
convert ${TMPF} \
-pointsize 16 \
-pointsize 24 \
-font Courier-Bold \
-fill Orange \
-annotate +10+16 "$timestamp" \
-annotate +10+34 "$texte" \
-pointsize 8 \
-annotate +15+16 "$timestamp" \
-annotate +15+38 "$texte" \
-pointsize 16 \
-gravity south-west \
-annotate +10+6 "tTh & Konrad" \
-annotate +15+6 "tTh & Konrad" \
${outfile}
}
@ -37,12 +41,11 @@ for foo in $(seq 0 1999)
do
echo '............' $foo
une_passe $foo
exit
done
ffmpeg -nostdin \
-loglevel warning \
-y -r 30 -f image2 -i WS/trid/%05d.png \
-y -r 30 -f image2 -i WS/troid/%05d.png \
-metadata artist='---{ tTh and Konrad }---' \
-metadata title="Experiment on Gravity Field" \
-c:v libx264 -pix_fmt yuv420p \

View File

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

View File

@ -2,9 +2,9 @@
set -e # stop on error
make essai
make animation
time ./essai | tee essai.log
time ./animation | tee animation.log
./encode.sh WS/field/ foo.mp4
./encode.sh WS/nanim/ quux.mp4

View File

@ -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
}
// ----------------------------------------------------------------------