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

Compare commits

base: tTh:362121740226e50be6b000c1c0fa268a3fc2a693
Branches Tags
tTh:master
..
compare: tTh:414572133db8ff0d22a0df1d6ec3cb6b5de8a10d
Branches Tags
tTh:master

No commits in common. "362121740226e50be6b000c1c0fa268a3fc2a693" and "414572133db8ff0d22a0df1d6ec3cb6b5de8a10d" have entirely different histories.
3621217402 ... 414572133d

9 changed files with 86 additions and 166 deletions
Show Stats Expand all files Collapse all files

2
BloubWorld/Makefile
View File

@ -31,7 +31,7 @@ out.lst: out.blbs exportbloubs Makefile
# ------------------------------------------------------------ # ------------------------------------------------------------
bloubspace.o: bloubspace.f90 Makefile bloubspace.o: bloubspace.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -pg -c $<
povstuff.o: povstuff.f90 Makefile povstuff.o: povstuff.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<

90
BloubWorld/bloubspace.f90
View File

@ -71,62 +71,39 @@ module bloubspace
subroutine random_pv (blb) subroutine random_pv (blb)
type(t_bloubs), intent (out) :: blb type(t_bloubs), intent (out) :: blb
blb%px = 3.57 * (rand() - 0.50) blb%px = 4.33 * (rand() - 0.50)
blb%py = 2.66 * (rand() - 0.50) blb%py = 3.70 * (rand() - 0.50)
blb%pz = 3.57 * (rand() - 0.50) blb%pz = 4.51 * (rand() - 0.50)
blb%vx = (rand()) / 2.500 blb%vx = (rand()) / 2.000
if (blb%px .LT. 0.0) blb%vx = -blb%vx if (blb%px .LT. 0.0) blb%vx = -blb%vx
blb%vy = (rand()) / 4.000 blb%vy = (rand()) / 3.200
if (blb%py .LT. 0.0) blb%vy = -blb%vx if (blb%py .LT. 0.0) blb%vy = -blb%vx
blb%vz = (rand()) / 2.500 blb%vz = (rand()) / 2.000
if (blb%pz .LT. 0.0) blb%vz = -blb%vz if (blb%pz .LT. 0.0) blb%vz = -blb%vz
blb%state = 0 blb%state = 0
blb%alive = .TRUE. blb%alive = .TRUE.
blb%age = 0 blb%age = 0
blb%agemax = 300 blb%agemax = 500
end subroutine end subroutine
! ---------------------------------------------------------------- ! ----------------------------------------------------------------
! Load a blbs file into an array of bloubs ! Load a blbs file into an array of bloubs
subroutine spit_bloubs_to_file (fname, blbarray, towrite) subroutine spit_bloubs_to_file (fname, blbarray, towrite)
character(*), intent(in) :: fname character(*), intent(in) :: fname
type(t_bloubs), dimension(:) :: blbarray type(t_bloubs), dimension(:) :: blbarray
integer, intent(in) :: towrite integer, intent(in) :: towrite
integer :: errcode, output, foo, spitted write (0, '(" spiting", (I6), "bloubs to", (A), "file")') &
character(200) :: chaine
write (0, '(" spitting", (I6), " bloubs to ", (A), " file")') &
towrite, trim(fname) towrite, trim(fname)
open( newunit=output, & STOP ' : NOT IMPLEMENTED'
file=trim(fname), form='unformatted', &
iostat=errcode, iomsg=chaine, &
action='write', status='replace')
if (0 .ne. errcode) then
write(0, '(" errcode ", I8, 2X, A)') errcode, chaine
STOP " : CAN'T OPEN FILE " // trim(fname)
endif
spitted = 0 end subroutine
do foo=1, towrite
if (blbarray(foo)%alive) then
write(output, iostat=errcode) blbarray(foo)
if (0 .ne. errcode) then
STOP " : WRITE ERROR TO " // trim(fname)
endif
spitted = spitted + 1
endif
enddo
close(output)
write(0, '(1X, "spitted ", I6, " bloubs")') spitted
end subroutine spit_bloubs_to_file
! ---------------------------------------------------------------- ! ----------------------------------------------------------------
! Dump an array of bloubs to a blbs file. ! Dump an array of bloubs to a blbs file.
! !
@ -137,7 +114,6 @@ module bloubspace
character(200) :: chaine character(200) :: chaine
integer :: input, errcode, idx integer :: input, errcode, idx
integer :: capacity
type(t_bloubs) :: bloub type(t_bloubs) :: bloub
write(0, '(" slurping from file [", (A), "]")') trim(infile) write(0, '(" slurping from file [", (A), "]")') trim(infile)
@ -152,7 +128,6 @@ module bloubspace
endif endif
! write(0, '((A, I3))') " slurping from unit ", input ! write(0, '((A, I3))') " slurping from unit ", input
capacity = ubound(blbarray, 1)
nbread = 0 nbread = 0
idx = 1; idx = 1;
do do
@ -168,15 +143,12 @@ module bloubspace
blbarray(idx) = bloub blbarray(idx) = bloub
idx = idx + 1 idx = idx + 1
endif endif
if (idx .GT. capacity) then
exit
endif
enddo enddo
close(input) ! no error checking ? close(input) ! no error checking ?
! write(0, '(" have read ", (I8), " bloubs")') nbread
end subroutine slurp_bloubs_file_in_array write(0, '(" read ", (I8), " bloubs")') nbread
end subroutine
! ---------------------------------------------------------------- ! ----------------------------------------------------------------
! Display a bloub content to stderr ! Display a bloub content to stderr
@ -206,6 +178,7 @@ module bloubspace
real, intent (in) :: coef real, intent (in) :: coef
! we must check that this bloub is alive ? ! we must check that this bloub is alive ?
blb%px = blb%px + (blb%vx * coef) blb%px = blb%px + (blb%vx * coef)
blb%py = blb%py + (blb%vy * coef) blb%py = blb%py + (blb%vy * coef)
blb%pz = blb%pz + (blb%vz * coef) blb%pz = blb%pz + (blb%vz * coef)
@ -216,46 +189,41 @@ module bloubspace
! detection des collisions avec les parois de la boite ! detection des collisions avec les parois de la boite
! laquelle boite gagnerais beaucoup a etre parametrable. ! laquelle boite gagnerais beaucoup a etre parametrable.
! !
subroutine bound_a_bloub (blb) subroutine bound_a_blob (blb)
type(t_bloubs), intent (inout) :: blb type(t_bloubs), intent (inout) :: blb
real, parameter :: SH = 6.0 if ( 5.0 .lt. (blb%px + blb%radius)) then
real, parameter :: SV = 4.0
! X axis
if ((blb%px + blb%radius) .GT. SH) then
blb%vx = -1.0 * blb%vx blb%vx = -1.0 * blb%vx
blb%px = SH- blb%radius blb%px = 5.0
blb%age = blb%age + 1 blb%age = blb%age + 1
endif endif
if ((blb%px - blb%radius) .LT. -SH) then if (-5.0 .gt. (blb%px + blb%radius)) then
blb%vx = -1.0 * blb%vx blb%vx = -1.0 * blb%vx
blb%px = -SH + blb%radius blb%px = -5.0
blb%age = blb%age + 1 blb%age = blb%age + 1
endif endif
! vertical axe Y ! vertical axe
if ((blb%py - blb%radius) .LT. -SV) then if (-4.99 .gt. (blb%py + blb%radius)) then
blb%vy = -1.0 * blb%vy blb%vy = -1.0 * blb%vy
blb%py = -SV + blb%radius blb%py = blb%radius
blb%age = blb%age + 1 blb%age = blb%age + 1
endif endif
if ((blb%py + blb%radius) .GT. SV) then ! overshoot ? if ( 4.99 .lt. (blb%py + blb%radius)) then ! overshoot ?
blb%vy = -1.0 * blb%vy blb%vy = -1.0 * blb%vy
blb%age = blb%age + 1 blb%age = blb%age + 1
blb%py = SV - blb%radius blb%py = 5.0 - blb%radius !!
endif endif
! Z axis if ( 5.0 .lt. (blb%pz + blb%radius)) then
if ((blb%pz + blb%radius) .GT. SH) then
blb%vz = -1.0 * blb%vz blb%vz = -1.0 * blb%vz
blb%age = blb%age + 1 blb%age = blb%age + 1
blb%pz = SH - blb%radius blb%pz = 5.0
endif endif
if ((blb%pz + blb%radius) .LT. -SH) then if (-5.0 .gt. (blb%pz + blb%radius)) then
blb%vz = -1.0 * blb%vz blb%vz = -1.0 * blb%vz
blb%age = blb%age + 1 blb%age = blb%age + 1
blb%pz = -SH + blb%radius blb%pz = -5.0
endif endif
end subroutine end subroutine
@ -281,7 +249,7 @@ module bloubspace
subroutine green_soylent (blb) subroutine green_soylent (blb)
type(t_bloubs), intent (inout) :: blb type(t_bloubs), intent (inout) :: blb
if (blb%age .gt. 24) then if (blb%age .gt. 18) then
blb%alive = .FALSE. blb%alive = .FALSE.
endif endif

9
BloubWorld/exportbloubs.f90
View File

@ -15,7 +15,7 @@ program genbloubs
endif endif
call getarg(1, filename) call getarg(1, filename)
write (0, '(A, A)') "### exporting from ", trim(filename) write (0, '(A, A)') "*** exporting from ", trim(filename)
open(unit=idu, file=trim(filename), form='unformatted', & open(unit=idu, file=trim(filename), form='unformatted', &
iostat=errcode, & iostat=errcode, &
@ -32,11 +32,8 @@ program genbloubs
if (0 .ne. errcode) then if (0 .ne. errcode) then
exit exit
endif endif
if (bloub%alive) then print *, bloub%px, bloub%py, bloub%pz, bloub%radius, bloub%age
print *, bloub%px, bloub%py, bloub%pz, bloub%radius, & compte = compte + 1
bloub%age, bloub%state
compte = compte + 1
endif
enddo enddo
write(0, '(1X, I8, A)') compte, " bloubs exported" write(0, '(1X, I8, A)') compte, " bloubs exported"

1
BloubWorld/genbloubs.f90
View File

@ -1,7 +1,6 @@
program genbloubs program genbloubs
use bloubspace use bloubspace
use mathstuff
integer :: nbbloubs integer :: nbbloubs
integer :: i integer :: i

50
BloubWorld/mergebloubs.f90
View File

@ -7,15 +7,14 @@ program mergebloubs
use bloubspace use bloubspace
implicit none implicit none
integer, parameter :: NB_MAX_BLOUBS = 250000 integer, parameter :: NB_MAX_BLOUBS = 25000
character(200) :: infile, outfile character(200) :: infile, outfile
! type(t_bloubs) :: bloub, newbloub type(t_bloubs) :: bloub, newbloub
integer :: errcode, nbgot integer :: inu, outu, errcode
type(t_bloubs), dimension(:), allocatable :: bloubs
integer :: ia, ib, contacts type(t_bloubs), dimension(:), allocatable :: les_bloubs
real :: dist,radd
type(t_bloubs) :: merged
! --------------- check command line parameters ! --------------- check command line parameters
if (IARGC() .ne. 2) then if (IARGC() .ne. 2) then
@ -24,42 +23,13 @@ program mergebloubs
call getarg(1, infile) call getarg(1, infile)
call getarg(2, outfile) call getarg(2, outfile)
write(0, '(A, 2A15, I8)') "### mergebloubs ", & write(0, '(A, 2A20, I8)') "*** mergebloubs ", &
trim(infile), trim(outfile), NB_MAX_BLOUBS trim(infile), trim(outfile), NB_MAX_BLOUBS
allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY"
endif
call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot) STOP '[done]'
write(0, '(A,I6,1X,A)') " slurped ", nbgot, "bloubs"
contacts = 0
do ia = 1, nbgot
! print *, ia, " = ", les_bloubs(ia)%nick, les_bloubs(ia)%num
do ib = ia+1, nbgot
dist = distance_of_bloubs(bloubs(ia), bloubs(ib))
radd = bloubs(ia)%radius + bloubs(ib)%radius
if (dist .LT. radd) then
contacts = contacts + 1
call merge_two_bloubs(bloubs(ia), bloubs(ib), merged)
bloubs(ia) = merged
bloubs(ia)%nick = "marged"
bloubs(ia)%state = 1;
bloubs(ib)%alive = .FALSE.
endif
enddo
enddo
call spit_bloubs_to_file (outfile, bloubs, nbgot)
print *, contacts, "contacts pour ", nbgot, "bloubs"
! STOP 'mergebloubs [done]'
! ==============================================================
! --------------------------------------------------------------
contains contains
subroutine merge_two_bloubs(bla, blb, blr) subroutine merge_two_bloubs(bla, blb, blr)
@ -77,7 +47,7 @@ contains
blr%vy = (bla%vy + blb%vy) / 2.0 blr%vy = (bla%vy + blb%vy) / 2.0
blr%vz = (bla%vz + blb%vz) / 2.0 blr%vz = (bla%vz + blb%vz) / 2.0
blr%radius = (bla%radius + blb%radius) / 2.222 blr%radius = (bla%radius + blb%radius) / 2.718
blr%age = min(bla%age, blb%age) blr%age = min(bla%age, blb%age)
! bring it to life ! ! bring it to life !

31
BloubWorld/movebloubs.f90
View File

@ -24,7 +24,7 @@ program movebloubs
call getarg(2, outfile) call getarg(2, outfile)
write (0, '(A)') & write (0, '(A)') &
"### moving bloubs from "//trim(infile)//" to "//trim(outfile) "*** moving bloubs from "//trim(infile)//" to "//trim(outfile)
open(newunit=inu, & open(newunit=inu, &
file=trim(infile), form='unformatted', & file=trim(infile), form='unformatted', &
@ -56,16 +56,17 @@ program movebloubs
endif endif
! moving, morphing and boundingboxing ! moving, morphing and boundingboxing
call move_bloub (bloub, 0.185) call move_bloub (bloub, 0.185)
call bound_a_bloub (bloub) call bound_a_blob (bloub)
if (bloub%radius .GT. 0.0238) then if (bloub%radius .GT. 0.0155) then
bloub%radius = bloub%radius * 0.996 bloub%radius = bloub%radius * 0.9970
endif endif
call green_soylent (bloub) call green_soylent (bloub)
if (.NOT. bloub%alive) then if (.NOT. bloub%alive) then
! write(0, '(A)') " KILL!" ! write(0, '(A)') " KILL!"
killed = killed + 1 killed = killed + 1
! cycle ! ???
endif endif
! calcul du barycentre ! calcul du barycentre
@ -73,13 +74,11 @@ program movebloubs
by = by + dble(bloub%py) by = by + dble(bloub%py)
bz = bz + dble(bloub%pz) bz = bz + dble(bloub%pz)
if (bloub%alive) then write(outu, iostat=errcode) bloub ! no error control ?
write(outu, iostat=errcode) bloub if (0 .ne. errcode) then
if (0 .ne. errcode) then STOP " : WRITE ERROR TO " // trim(outfile)
STOP " : WRITE ERROR TO " // trim(outfile)
endif
compteur = compteur + 1
endif endif
compteur = compteur + 1
enddo ! end of main loop enddo ! end of main loop
@ -89,15 +88,15 @@ program movebloubs
! insert some fancy conditional here ! insert some fancy conditional here
if (compteur .LT. 200) then if (compteur .LT. 200) then
call add_more_bloubs(outu, 4, 0.1056) call add_more_bloubs(outu, 5, 0.1333)
endif endif
! insert some very fancy conditional here ! insert some very fancy conditional here
if (compteur .LT. 800) then if (compteur .LT. 3000) then
rnd = rand() rnd = rand()
write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd
if (rnd .LT. 0.0604) then if (rnd .LT. 0.0455) then
call add_more_bloubs(outu, 11, 0.099) call add_more_bloubs(outu, 24, 0.0999)
endif endif
endif endif
@ -121,7 +120,7 @@ contains
type(t_bloubs) :: bloub type(t_bloubs) :: bloub
integer :: foo, count integer :: foo, count
count = nbre+mod(irand(), 6) count = nbre+mod(irand(), 9)
write(0, '(A,I4,1X,A)') "adding", count, "bloubs" write(0, '(A,I4,1X,A)') "adding", count, "bloubs"
do foo=1, count do foo=1, count

13
BloubWorld/runme.sh
View File

@ -10,7 +10,7 @@ TMPPNG="/dev/shm/bloubs7.png"
POVOPT="+Q9 +a -v -d -W1600 -H1200 -WT2" POVOPT="+Q9 +a -v -d -W1600 -H1200 -WT2"
DDIR="frames/a" DDIR="frames/a"
LOGERR="log.error" LOGERR="log.error"
TXTCOLOR="GreenYellow" TXTCOLOR="RosyBrown"
# --- put the work file in ramdisk # --- put the work file in ramdisk
BLBS_IN="/dev/shm/in.blbs" BLBS_IN="/dev/shm/in.blbs"
@ -54,7 +54,7 @@ do
convert ${TMPPNG} \ convert ${TMPPNG} \
-font Courier-Bold \ -font Courier-Bold \
-pointsize 28 \ -pointsize 24 \
-fill "$TXTCOLOR" \ -fill "$TXTCOLOR" \
-gravity south-east \ -gravity south-east \
-annotate +25+5 "$td" \ -annotate +25+5 "$td" \
@ -62,17 +62,16 @@ do
-annotate +25+5 "$hi" \ -annotate +25+5 "$hi" \
-pointsize 48 \ -pointsize 48 \
-gravity north-east \ -gravity north-east \
-annotate +45+5 "$count" \ -annotate +25+5 "$count" \
-gravity north-west \ -gravity north-west \
-annotate +45+5 "BloubWorld" \ -annotate +25+5 "BloubWorld" \
$PNG $PNG
echo $PNG '[done]' echo $PNG '[done]'
./movebloubs ${BLBS_IN} ${BLBS_OUT} ./movebloubs ${BLBS_IN} ${BLBS_OUT}
./mergebloubs ${BLBS_OUT} ${BLBS_IN} # ./mergebloubs ${BLBS_OUT} ${BLBS_IN}
# mv ${BLBS_OUT} ${BLBS_IN} mv ${BLBS_OUT} ${BLBS_IN}
echo echo
done done

38
BloubWorld/scene.pov
View File

@ -11,6 +11,8 @@ global_settings {
#include "colors.inc" #include "colors.inc"
#include "WS/nbimg.inc" #include "WS/nbimg.inc"
#declare NormClock = clock / NbImg; #declare NormClock = clock / NbImg;
@ -26,16 +28,16 @@ global_settings {
object { object {
Bloubs Bloubs
finish { phong 0.57 specular 0.57 } finish { phong 0.55 specular 0.55 }
} }
object { object {
union { union {
plane { <1, 0, 0>, -37 } plane { <1, 0, 0>, -32 }
plane { <1, 0, 0>, 37 } plane { <1, 0, 0>, 32 }
plane { <0, 1, 0>, -27 } plane { <0, 1, 0>, -24 }
plane { <0, 1, 0>, 27 } plane { <0, 1, 0>, 24 }
plane { <0, 0, 1>, 69 } plane { <0, 0, 1>, 50 }
texture { texture {
pigment { color srgb <0.125, 0.144, 0.111> } pigment { color srgb <0.125, 0.144, 0.111> }
@ -44,19 +46,17 @@ object {
} }
} }
// object { cylinder { <0, 0, 0>, <10, 0, 0>, 0.05 pigment { color Cyan } } }
// ---------------------------------------------------------- // ----------------------------------------------------------
#declare BH = 6; // H = taille en horizontal #declare BH = 5; // H = taille en horizontal
#declare BV = 4; // V = taille en vertical #declare BV = 5; // V = taille en vertical
#declare BR = 0.034; #declare BR = 0.032;
#declare Une_Borne = object #declare Une_Borne = object
{ {
merge { merge {
cylinder { <0, BV, 0>, <0, -BV, 0>, BR } cylinder { <0, BV, 0>, <0, -BV, 0>, BR }
cylinder { <0, 0.014, 0>, <0, -0.014, 0>, BR*4 } cylinder { <0, 0.012, 0>, <0, -0.012, 0>, BR*4 }
} }
} }
@ -75,8 +75,8 @@ pigment { color Gray40 }
#declare Les_Bornes = object #declare Les_Bornes = object
{ {
union { union {
#local E = 0.0015; #local E = 0.002;
object { Un_Cadre translate y*(BV-E) } object { Un_Cadre translate y*(BV-E) }
object { Un_Cadre translate -y*(BV-E) } object { Un_Cadre translate -y*(BV-E) }
object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue } } object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue } }
@ -109,12 +109,12 @@ union {
} }
// ---------------------------------------------------------- // ----------------------------------------------------------
light_source { <19, -12+NormClock, -17> color Gray80 } light_source { <19, -12, -17> color Gray80 }
light_source { <11, 14-NormClock, 9> color Gray60 } light_source { <11, 14, 9> color Gray60 }
#declare XCAM = 8 - ( 15 * NormClock); #declare XCAM = 8 - ( 15 * NormClock);
#declare YCAM = -1.1 + (0.95 * NormClock); #declare YCAM = 1 + (0.75 * NormClock);
#declare ZCAM = -13.10; #declare ZCAM = -17.5;
#declare XLAT = Bary_X; #declare XLAT = Bary_X;
#declare YLAT = Bary_Y; #declare YLAT = Bary_Y;
@ -126,5 +126,5 @@ camera {
location <XCAM, YCAM, ZCAM> location <XCAM, YCAM, ZCAM>
look_at <XLAT, YLAT, ZLAT> look_at <XLAT, YLAT, ZLAT>
right x*image_width/image_height right x*image_width/image_height
angle 86 angle 66
} }

18
BloubWorld/toinc.awk
View File

@ -1,6 +1,4 @@
#
# Input for this script is generated by 'exportbloubs.f90'
# #
# this code is (C) 2022 tTh # this code is (C) 2022 tTh
# #
@ -15,19 +13,9 @@ BEGIN {
{ {
age = $5 age = $5
merged = $6 if (age < 2) color = "Orange"
else if (age > 8) color = "Gray70"
color = "Cyan" else color = "Sienna"
if (age < 2) color = "Yellow"
if (merged) {
if (age > 12) color = "Orange"
else color = "Red"
}
else {
if (age > 12) color = "CadetBlue"
else color = "Aquamarine"
}
bx += $1 bx += $1
by += $2 by += $2
bz += $3 bz += $3