tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

saturday night fever is now commited

Browse Source
This commit is contained in:
tTh 2022-12-03 20:42:29 +01:00
parent 3c3d1c8906
commit 4853779493
11 changed files with 134 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
GravityField/.gitignore vendored
View File

@ -4,6 +4,8 @@ animation
WS/*.pgm
WS/*.png
WS/*/*.pgm
WS/*/*.png
*.gif
*.log

2
GravityField/WS/field/README.md Normal file
View File

@ -0,0 +1,2 @@
# placeholder

2
GravityField/WS/nanim/README.md Normal file
View File

@ -0,0 +1,2 @@
# placeholder

2
GravityField/WS/troid/README.md Normal file
View File

@ -0,0 +1,2 @@
# placeholder

77
GravityField/animation.f90
View File

@ -10,18 +10,81 @@ program animation
implicit none
! some configuration constants
integer, parameter :: S_WIDTH = 800
integer, parameter :: S_HEIGHT = 600
integer, parameter :: NB_BODY = 20
integer, parameter :: S_WIDTH = 1024
integer, parameter :: S_HEIGHT = 1024
integer, parameter :: NB_BODY = 150
!!! WARNING : global variables !!!
type(massbody) :: planets(NB_BODY)
integer :: foo
character(len=100) :: filename
! integer :: foo
call init_random()
call create_some_planets(planets, 13.37, 2048, 2048)
call create_some_planets(planets, 1337e3, S_WIDTH , S_HEIGHT)
call barycentre_bodies(planets)
call la_grande_boucle(0, 2000, planets)
STOP ': YOLO TIME'
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
write (filename, "(a, i5.5, a)") 'WS/nanim/', pass, '.pgm'
write(0, *) filename
call build_and_write_a_field(S_WIDTH, S_HEIGHT, moons, filename)
call deplace_les_planetes(moons)
enddo
end subroutine
!-----------------------------------------------------------------------
subroutine deplace_les_planetes(moons)
type(massbody), intent(inout) :: moons(:)
integer :: foo
real :: depx, depy
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. Cclippin 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
moons(foo)%heading = moons(foo)%heading + (0.08*rand())
if (moons(foo)%heading .GT. 6.2831853) moons(foo)%heading = 0.0
enddo
end subroutine
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
end program

19
GravityField/encode.sh
View File

@ -12,14 +12,31 @@ SDIR="$1"
FNAME="$2"
echo "Encoding from " $SDIR " to " $FNAME
#
# trying to guess the format of inoput files
#
firstfile=$(ls -1 $SDIR/* | head -1)
echo "first file :" $firstfile
filetype=$(file $firstfile | awk '{ print $2 }')
echo "file type :" $filetype
case $filetype in
PNG) extension=".png" ;;
Netpbm) extension=".pgm" ;;
*) extension=".binary" ;;
esac
echo "extension :" $extension
TITLE='---{ experimental gravity field }---'
ffmpeg -nostdin \
-loglevel warning \
-y -r 30 -f image2 -i $SDIR/%05d.pgm \
-y -r 30 -f image2 -i ${SDIR}/%05d${extension} \
-metadata artist='---{ tTh }---' \
-metadata title="${TITLE}" \
-c:v libx264 -pix_fmt yuv420p \
$FNAME
echo

2
GravityField/essai.f90
View File

@ -22,7 +22,7 @@ program essai
call create_some_planets(planets, 45e5, S_WIDTH, S_HEIGHT)
do foo=0, 1999
write (filename, "(a, i5.5, a)") 'WS/', foo, '.pgm'
write (filename, "(a, i5.5, a)") 'WS/field/', foo, '.pgm'
call build_and_write_a_field(S_WIDTH, S_HEIGHT, planets, filename)
! print *, trim(filename)
! OMG! two magic numbers, wtf?

19
GravityField/raytrace.sh
View File

@ -2,7 +2,7 @@
set -e
POVOPT=" -q9 +a -W800 -H600 +WT2 -d -v "
POVOPT=" -q9 +a -W1280 -H1024 +WT2 -d -v "
SOURCE="vision.pov"
TMPF="/dev/shm/gravfield.png"
@ -14,14 +14,20 @@ clock=$1
povray -i${SOURCE} -K${clock} $POVOPT -O${TMPF} 2> pov.stderr
timestamp=$(date | tr '01' 'Ol')
outfile=$(printf "WS/%05d.png" $clock)
timestamp=$(date -u +'%F %H:%M' | tr '01' 'Ol')
texte=$(printf "pass %04d" $clock | tr '01' 'Ol')
outfile=$(printf "WS/troid/%05d.png" $clock)
echo $timestamp $texte $outfile
convert ${TMPF} \
-pointsize 14 \
-pointsize 16 \
-font Courier-Bold \
-fill Orange \
-annotate +10+16 "$timestamp" \
-annotate +10+34 "$texte" \
-pointsize 8 \
-gravity south-west \
-annotate +10+6 "tTh & Konrad" \
${outfile}
}
@ -31,12 +37,13 @@ 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/%05d.png \
-metadata artist='---{ tTh }---' \
-y -r 30 -f image2 -i WS/trid/%05d.png \
-metadata artist='---{ tTh and Konrad }---' \
-metadata title="Experiment on Gravity Field" \
-c:v libx264 -pix_fmt yuv420p \
bar.mp4

19
GravityField/realfield.f90
View File

@ -13,8 +13,8 @@ module realfield
!-
type massbody
real :: posx, posy
real :: heading = 33.21
real :: speed = 1.007
real :: heading = 0.21
real :: speed = 1.017
real :: mass = 1.0
integer :: serial = 666
end type
@ -39,7 +39,7 @@ subroutine barycentre_bodies(astres)
enddo
cx = cx / real(ubound(astres, 1))
cy = cy / real(ubound(astres, 1))
print *, cx, cy
print *, 'barycentre:', cx, cy
end subroutine
!-----------------------------------------------------------------------
@ -57,16 +57,21 @@ subroutine create_some_planets(planets, coef, sx, sy)
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
planets(1)%posx = 10
planets(1)%posy = 10
planets(1)%mass = 7e8
planets(1)%posx = sx / 2
planets(1)%posy = sy / 2
planets(1)%mass = 37e8
planets(1)%serial = 1337
else
planets(foo)%posx = rand() * real(sx-1)
planets(foo)%posy = rand() * real(sy-1)
planets(foo)%mass = 7e6 + coef*foo
planets(foo)%serial = foo
planets(foo)%heading = 3.14159 * rand()
if (rand() .LT. 0.01) planets(foo)%speed = 2.718
planets(foo)%serial = foo*2 + 120
endif
write (*, fmt) foo, planets(foo)
enddo

2
GravityField/runme.sh
View File

@ -6,5 +6,5 @@ make essai
time ./essai | tee essai.log
./encode.sh WS/ foo.mp4
./encode.sh WS/field/ foo.mp4

21
GravityField/vision.pov
View File

@ -11,16 +11,15 @@ global_settings {
max_trace_level 6
}
#include "colors.inc"
#declare NormClock = clock / 2000.01;
// ----------------------------------------------------------------------
#declare HFDIR = "WS/";
#declare HFDIR = "WS/nanim/";
#declare HFCK = mod(clock, 2000);
#declare HFNAME = concat(HFDIR, str(HFCK , -5, 0), ".pgm");
#debug concat("- - - - - - - ", HFNAME, "\n")
#declare GravityField = object
@ -32,25 +31,27 @@ height_field {
}
texture {
pigment { color Gray80 }
finish { phong 2.0 }
finish { phong 0.50 }
}
}
object { GravityField scale <4, 1, 4> }
object { GravityField scale <4, 0.70, 4> }
// ----------------------------------------------------------------------
cylinder { <0, -0.5, 0>, <0, 1, 0>, 0.0175 pigment { color Red } }
light_source { < -2, 9.3, -7> color Gray90 }
light_source { < -5, 9.3, -7> color Orange*0.75 }
light_source { < -15, 2.3, 17> color Blue*0.50 }
light_source { < -6, 9.3, -8> color Orange*0.75 }
light_source { < -15, 2.3, 17> color Green*0.25 }
// ----------------------------------------------------------------------
camera {
location <-8, 4, 3>
location <-8, 4-NormClock, 1 + 3*NormClock>
look_at <0, 0, 0>
right x*image_width/image_height
angle 35
angle 34
}
// ----------------------------------------------------------------------