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

nasty bug added

Browse Source
This commit is contained in:
tth 2022-02-08 02:53:49 +01:00
parent a693302969
commit d84c6d969c
10 changed files with 152 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
BloubWorld/.gitignore vendored
View File

@ -2,7 +2,9 @@
bloubs.inc
*.gif
*.blbs
*.mp4
frames/*
log.*
exportbloubs
genbloubs

5
BloubWorld/Makefile
View File

@ -5,6 +5,7 @@ all: genbloubs movebloubs exportbloubs
GFOPT = -Wall -Wextra -g -time
OBJS = bloubspace.o povstuff.o
# ------------------------------------------------------------
initial.blbs: genbloubs Makefile
@ -23,10 +24,10 @@ povstuff.o: povstuff.f90 Makefile
genbloubs: genbloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $(OBJS) $< -o $@
movebloubs: movebloubs.f90 Makefile bloubspace.o
movebloubs: movebloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $(OBJS) $< -o $@
exportbloubs: exportbloubs.f90 Makefile bloubspace.o
exportbloubs: exportbloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $(OBJS) $< -o $@
# ------------------------------------------------------------

68
BloubWorld/bloubspace.f90
View File

@ -21,7 +21,6 @@ module bloubspace
contains ! -----------------------------------------
subroutine random_pv (blb)
type(t_bloubs), intent (inout) :: blb
blb%px = rand() - 0.50
@ -32,8 +31,29 @@ module bloubspace
blb%vy = (rand() - 0.5) / 4.000
blb%vz = (rand() - 0.5) / 4.000
end subroutine
blb%alive = .TRUE.
end subroutine
! ----------------------------------------------------------------
subroutine display_bloub (blb, message)
type(t_bloubs), intent (in) :: blb
character(*), intent (in) :: message
character(5) :: life
if (blb%alive) then
life = "alive"
else
life = "dead"
endif
write (0, '(A)') '------------- ' // message
write (0, '(4X,A8,2X,I6,4X,A5)') blb%nick, blb%num, blb%alive
write (0, '(4X,A1,3X,3(F8.3, 4X))') 'P', blb%px, blb%py, blb%pz
write (0, '(4X,A1,3X,3(F8.3, 4X))') 'V', blb%vx, blb%vy, blb%vz
write (0, '()')
end subroutine
! ----------------------------------------------------------------
subroutine move_bloub (blb, coef)
@ -45,10 +65,52 @@ module bloubspace
blb%px = blb%px + (blb%vx * coef)
blb%py = blb%py + (blb%vy * coef)
blb%pz = blb%pz + (blb%vz * coef)
blb%seq = blb%seq + 1
end subroutine
! ----------------------------------------------------------------
subroutine bound_a_blob (blb)
type(t_bloubs), intent (inout) :: blb
if (5.0 .lt. blb%px) then
blb%vx = -1.0 * blb%vx
blb%px = 5.0
blb%seq = blb%seq + 1
endif
if (-5.0 .gt. blb%px) then
blb%vx = -1.0 * blb%vx
blb%px = -5.0
blb%seq = blb%seq + 1
endif
if (0.0 .gt. blb%py) then
blb%vy = -1.0 * blb%vy
blb%py = 0.0
endif
if (3.0 .lt. blb%py) then
blb%vy = -1.0 * blb%vy
blb%py = 3.0
endif
if (5.0 .lt. blb%pz) then
blb%vz = -1.0 * blb%vz
blb%pz = 5.0
endif
if (-5.0 .gt. blb%pz) then
blb%vz = -1.0 * blb%vz
blb%pz = -5.0
endif
end subroutine
! ----------------------------------------------------------------
subroutine green_soylent (blb)
type(t_bloubs), intent (inout) :: blb
if (blb%seq .gt. 200) then
blb%alive = .FALSE.
endif
end subroutine
! ----------------------------------------------------------------
end module

13
BloubWorld/encode.sh Executable file
View File

@ -0,0 +1,13 @@
#!/bin/bash
DDIR="frames/"
ffmpeg -nostdin \
-loglevel info \
-y -r 25 -f image2 -i $DDIR/%05d.png \
-metadata artist='---[ tTh ]---' \
-metadata title='---[ BloubWorld ]---' \
-c:v libx264 -pix_fmt yuv420p \
bloubworld.mp4

2
BloubWorld/exportbloubs.f90
View File

@ -36,6 +36,8 @@ program genbloubs
compte = compte + 1
enddo
write(0, '(1X, I5, A)') compte, " bloubs exported"
close(idu)
end program

2
BloubWorld/genbloubs.f90
View File

@ -31,7 +31,7 @@ program genbloubs
bloub%nick = 'noname '
bloub%alive = .TRUE.
call random_pv(bloub)
bloub%radius = 0.025
bloub%radius = 0.028
bloub%seq = 0
write(idu) bloub ! no error control ?

38
BloubWorld/movebloubs.f90
View File

@ -9,6 +9,7 @@ program movebloubs
integer :: inu, outu, errcode, i
type(t_bloubs) :: bloub
double precision :: bx, by, bz
logical :: add_new_bloub = .FALSE.
i = IARGC()
if (i .ne. 2) then
@ -33,7 +34,7 @@ program movebloubs
iostat=errcode, &
action='write', status='replace')
if (0 .ne. errcode) then
STOP " : CAN'T WRITE TO " // trim(outfile)
STOP " : CAN'T OPEN " // trim(outfile) // "FOR WRITE"
endif
bx = 0.0; by = 0.0; bz = 0.0
@ -44,28 +45,39 @@ program movebloubs
exit
endif
call move_bloub (bloub, 1.10)
! moving and boundingboxing
call move_bloub (bloub, 0.11)
call bound_a_blob(bloub)
! calcul du barycentre
bx = bx + bloub%px
by = by + bloub%py
bz = bz + bloub%pz
! boundingbox action
if (0.0 .gt. bloub%py) then
bloub%vy = -1.0 * bloub%vy
bloub%py = 0.0
write(outu, iostat=errcode) bloub ! no error control ?
if (0 .ne. errcode) then
STOP " : WRITE ERROR TO " // trim(outfile)
endif
if (3.0 .lt. bloub%py) then
bloub%vy = -1.0 * bloub%vy
bloub%py = 3.0
endif
write(outu) bloub ! no error control ?
enddo
if (add_new_bloub) then
! and now, we inject a new bloub in the universe
bloub%nick = 'newbie '
bloub%alive = .TRUE.
call random_pv(bloub)
bloub%radius = 0.042
bloub%seq = 0
!
! where is the bug ?
!
call display_bloub (bloub, "new bloub")
write(outu) bloub ! no error control ?
endif
! ther was some strange bias in this data
! may be a random not symetric around 0.0 ?
write (0, '(A,3(F11.3,3X))') "barycentre : ", bx, by, bz
close(inu) ; close(outu)

9
BloubWorld/povstuff.f90
View File

@ -4,16 +4,15 @@ module povstuff
! ----------------------------------------------------------------
type t_boundb
!
real :: BBminX, BBmaxX, BBminY, BBmaxY, BBminZ, BBmaxZ
integer :: id
!
end type
contains ! -----------------------------------------
subroutine show_bbox( bbox )
type (t_boundb), intent(in) :: bbox
print *, bbox%bbminx, bbox%bbminy, bbox%bbminz
@ -22,6 +21,10 @@ module povstuff
end subroutine
! ----------------------------------------------------------------
! we need some primitives for the gestion of colors.
! may be a small database indexed by name ?
! XXX
! ----------------------------------------------------------------
end module

25
BloubWorld/runme.sh
View File

@ -7,7 +7,7 @@
INCFILE="bloubs.inc"
TMPPNG="/dev/shm/bloubs7.png"
POVOPT="+Q9 +a -v -d -W640 -H480"
POVOPT="+Q9 +a -v -d -W920 -H600"
DDIR="frames"
LOGERR="log.error"
@ -22,9 +22,9 @@ fi
# first, we have to make a seminal buch of bloubs
# --> this function need to be paraletrizable
#
./genbloubs in.blbs 10000
./genbloubs in.blbs 100000
for idx in $(seq 0 50)
for idx in $(seq 0 800)
do
echo "======== run passe $idx ========="
@ -32,15 +32,21 @@ do
./exportbloubs in.blbs | awk -f toinc.awk > $INCFILE
povray -Iscene.pov -K${idx} -O${TMPPNG} ${POVOPT} 2> $LOGERR
grep "Trace Tim" $LOGERR
if [ 0 -ne $? ] ; then
tail -15 $LOGERR
sleep 30
else
grep "Trace Time" $LOGERR
fi
txt=$(date +'%F %R:%S')
td=$(date +'%F %R:%S')
txt=$(printf "%9d %5d %s" $$ $idx "${td}")
PNG=$(printf "%s/%05d.png" ${DDIR} $idx)
echo $txt
echo "$txt"
convert ${TMPPNG} \
-font fixed \
-pointsize 16 \
-pointsize 20 \
-fill orange \
-gravity south-east \
-annotate +15+10 "$txt" \
@ -56,6 +62,9 @@ done
rm $LOGERR
convert -delay 10 -colors 192 $DDIR/*.png foo.gif
convert -delay 10 -resize 50% -colors 192 \
$DDIR/????[0]*.png foo.gif
./encode.sh

27
BloubWorld/scene.pov
View File

@ -5,7 +5,7 @@
#version 3.7;
global_settings {
ambient_light rgb <0.02, 0.02, 0.09>
ambient_light rgb <0.09, 0.02, 0.02>
assumed_gamma 1.0
}
@ -31,16 +31,25 @@ plane {
// ----------------------------------------------------------
#declare Les_Bornes = object
{
#declare BH = 5;
#declare BV = 3;
#declare BR = 0.02;
#declare BR = 0.025;
#declare Une_Borne = object
{
union {
cylinder { <-BH, 0, -BH>, <-BH, BV, -BH>, BR pigment { color Blue } }
cylinder { < BH, 0, -BH>, < BH, BV, -BH>, BR pigment { color Green } }
cylinder { <-BH, 0, BH>, <-BH, BV, BH>, BR pigment { color Green } }
cylinder { < BH, 0, BH>, < BH, BV, BH>, BR pigment { color Red } }
cylinder { <0, 0, 0>, <0, BV, 0>, BR }
cylinder { <0, 0, 0>, <0, 0.03, 0>, BR*4 }
}
}
#declare Les_Bornes = object
{
union {
object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue } }
object { Une_Borne translate < BH, 0, -BH> pigment { color Green } }
object { Une_Borne translate <-BH, 0, BH> pigment { color Green } }
object { Une_Borne translate < BH, 0, BH> pigment { color Red } }
}
}
@ -49,7 +58,7 @@ object { Les_Bornes }
// ----------------------------------------------------------
light_source { <4, 12, -11> color Gray80 }
light_source { <4, 9, 9> color White }
// light_source { <4, 19, 9> color White }
camera {
location <7, 5, -16>