diff --git a/BloubWorld/Makefile b/BloubWorld/Makefile index 03a4d92..ac8904a 100644 --- a/BloubWorld/Makefile +++ b/BloubWorld/Makefile @@ -31,7 +31,7 @@ out.lst: out.blbs exportbloubs Makefile # ------------------------------------------------------------ bloubspace.o: bloubspace.f90 Makefile - gfortran $(GFOPT) -pg -c $< + gfortran $(GFOPT) -c $< povstuff.o: povstuff.f90 Makefile gfortran $(GFOPT) -c $< diff --git a/BloubWorld/bloubspace.f90 b/BloubWorld/bloubspace.f90 index 78d8b3c..4a01154 100644 --- a/BloubWorld/bloubspace.f90 +++ b/BloubWorld/bloubspace.f90 @@ -71,39 +71,62 @@ module bloubspace subroutine random_pv (blb) type(t_bloubs), intent (out) :: blb - blb%px = 4.33 * (rand() - 0.50) - blb%py = 3.70 * (rand() - 0.50) - blb%pz = 4.51 * (rand() - 0.50) + blb%px = 3.57 * (rand() - 0.50) + blb%py = 2.66 * (rand() - 0.50) + blb%pz = 3.57 * (rand() - 0.50) - blb%vx = (rand()) / 2.000 + blb%vx = (rand()) / 2.500 if (blb%px .LT. 0.0) blb%vx = -blb%vx - blb%vy = (rand()) / 3.200 + blb%vy = (rand()) / 4.000 if (blb%py .LT. 0.0) blb%vy = -blb%vx - blb%vz = (rand()) / 2.000 + blb%vz = (rand()) / 2.500 if (blb%pz .LT. 0.0) blb%vz = -blb%vz blb%state = 0 blb%alive = .TRUE. blb%age = 0 - blb%agemax = 500 + blb%agemax = 300 end subroutine ! ---------------------------------------------------------------- ! Load a blbs file into an array of bloubs subroutine spit_bloubs_to_file (fname, blbarray, towrite) - character(*), intent(in) :: fname type(t_bloubs), dimension(:) :: blbarray integer, intent(in) :: towrite - write (0, '(" spiting", (I6), "bloubs to", (A), "file")') & + integer :: errcode, output, foo, spitted + character(200) :: chaine + + write (0, '(" spitting", (I6), " bloubs to ", (A), " file")') & towrite, trim(fname) - STOP ' : NOT IMPLEMENTED' + open( newunit=output, & + 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 - end subroutine + spitted = 0 + 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. ! @@ -114,6 +137,7 @@ module bloubspace character(200) :: chaine integer :: input, errcode, idx + integer :: capacity type(t_bloubs) :: bloub write(0, '(" slurping from file [", (A), "]")') trim(infile) @@ -128,6 +152,7 @@ module bloubspace endif ! write(0, '((A, I3))') " slurping from unit ", input + capacity = ubound(blbarray, 1) nbread = 0 idx = 1; do @@ -143,12 +168,15 @@ module bloubspace blbarray(idx) = bloub idx = idx + 1 endif + if (idx .GT. capacity) then + exit + endif enddo close(input) ! no error checking ? + ! write(0, '(" have read ", (I8), " bloubs")') nbread - write(0, '(" read ", (I8), " bloubs")') nbread - end subroutine + end subroutine slurp_bloubs_file_in_array ! ---------------------------------------------------------------- ! Display a bloub content to stderr @@ -178,7 +206,6 @@ module bloubspace real, intent (in) :: coef ! we must check that this bloub is alive ? - blb%px = blb%px + (blb%vx * coef) blb%py = blb%py + (blb%vy * coef) blb%pz = blb%pz + (blb%vz * coef) @@ -189,41 +216,46 @@ module bloubspace ! detection des collisions avec les parois de la boite ! laquelle boite gagnerais beaucoup a etre parametrable. ! - subroutine bound_a_blob (blb) + subroutine bound_a_bloub (blb) type(t_bloubs), intent (inout) :: blb - if ( 5.0 .lt. (blb%px + blb%radius)) then + real, parameter :: SH = 6.0 + real, parameter :: SV = 4.0 + + ! X axis + if ((blb%px + blb%radius) .GT. SH) then blb%vx = -1.0 * blb%vx - blb%px = 5.0 + blb%px = SH- blb%radius blb%age = blb%age + 1 endif - if (-5.0 .gt. (blb%px + blb%radius)) then + if ((blb%px - blb%radius) .LT. -SH) then blb%vx = -1.0 * blb%vx - blb%px = -5.0 + blb%px = -SH + blb%radius blb%age = blb%age + 1 endif - ! vertical axe - if (-4.99 .gt. (blb%py + blb%radius)) then + ! vertical axe Y + if ((blb%py - blb%radius) .LT. -SV) then blb%vy = -1.0 * blb%vy - blb%py = blb%radius + blb%py = -SV + blb%radius blb%age = blb%age + 1 endif - if ( 4.99 .lt. (blb%py + blb%radius)) then ! overshoot ? + if ((blb%py + blb%radius) .GT. SV) then ! overshoot ? blb%vy = -1.0 * blb%vy blb%age = blb%age + 1 - blb%py = 5.0 - blb%radius !! + blb%py = SV - blb%radius endif - if ( 5.0 .lt. (blb%pz + blb%radius)) then + ! Z axis + if ((blb%pz + blb%radius) .GT. SH) then blb%vz = -1.0 * blb%vz blb%age = blb%age + 1 - blb%pz = 5.0 + blb%pz = SH - blb%radius endif - if (-5.0 .gt. (blb%pz + blb%radius)) then + if ((blb%pz + blb%radius) .LT. -SH) then blb%vz = -1.0 * blb%vz blb%age = blb%age + 1 - blb%pz = -5.0 + blb%pz = -SH + blb%radius endif end subroutine @@ -249,7 +281,7 @@ module bloubspace subroutine green_soylent (blb) type(t_bloubs), intent (inout) :: blb - if (blb%age .gt. 18) then + if (blb%age .gt. 24) then blb%alive = .FALSE. endif diff --git a/BloubWorld/genbloubs.f90 b/BloubWorld/genbloubs.f90 index aeac7b2..2baa7aa 100644 --- a/BloubWorld/genbloubs.f90 +++ b/BloubWorld/genbloubs.f90 @@ -1,6 +1,7 @@ program genbloubs use bloubspace + use mathstuff integer :: nbbloubs integer :: i diff --git a/BloubWorld/mergebloubs.f90 b/BloubWorld/mergebloubs.f90 index 56a34dd..df553d9 100644 --- a/BloubWorld/mergebloubs.f90 +++ b/BloubWorld/mergebloubs.f90 @@ -7,14 +7,15 @@ program mergebloubs use bloubspace implicit none - integer, parameter :: NB_MAX_BLOUBS = 25000 + integer, parameter :: NB_MAX_BLOUBS = 250000 character(200) :: infile, outfile - type(t_bloubs) :: bloub, newbloub - integer :: inu, outu, errcode - - type(t_bloubs), dimension(:), allocatable :: les_bloubs - + ! type(t_bloubs) :: bloub, newbloub + integer :: errcode, nbgot + type(t_bloubs), dimension(:), allocatable :: bloubs + integer :: ia, ib, contacts + real :: dist,radd + type(t_bloubs) :: merged ! --------------- check command line parameters if (IARGC() .ne. 2) then @@ -23,13 +24,42 @@ program mergebloubs call getarg(1, infile) call getarg(2, outfile) - write(0, '(A, 2A20, I8)') "*** mergebloubs ", & + write(0, '(A, 2A15, I8)') "### mergebloubs ", & trim(infile), trim(outfile), NB_MAX_BLOUBS + allocate (bloubs(NB_MAX_BLOUBS), stat=errcode) + if (0 .NE. errcode) then + STOP " : NO ENOUGH MEMORY" + endif - STOP '[done]' + call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot) + 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 subroutine merge_two_bloubs(bla, blb, blr) @@ -47,7 +77,7 @@ contains blr%vy = (bla%vy + blb%vy) / 2.0 blr%vz = (bla%vz + blb%vz) / 2.0 - blr%radius = (bla%radius + blb%radius) / 2.718 + blr%radius = (bla%radius + blb%radius) / 2.222 blr%age = min(bla%age, blb%age) ! bring it to life ! diff --git a/BloubWorld/movebloubs.f90 b/BloubWorld/movebloubs.f90 index 593ef87..b344dcf 100644 --- a/BloubWorld/movebloubs.f90 +++ b/BloubWorld/movebloubs.f90 @@ -24,7 +24,7 @@ program movebloubs call getarg(2, outfile) write (0, '(A)') & - "*** moving bloubs from "//trim(infile)//" to "//trim(outfile) + "### moving bloubs from "//trim(infile)//" to "//trim(outfile) open(newunit=inu, & file=trim(infile), form='unformatted', & @@ -56,17 +56,16 @@ program movebloubs endif ! moving, morphing and boundingboxing - call move_bloub (bloub, 0.185) - call bound_a_blob (bloub) - if (bloub%radius .GT. 0.0155) then - bloub%radius = bloub%radius * 0.9970 + call move_bloub (bloub, 0.185) + call bound_a_bloub (bloub) + if (bloub%radius .GT. 0.0238) then + bloub%radius = bloub%radius * 0.996 endif call green_soylent (bloub) if (.NOT. bloub%alive) then ! write(0, '(A)') " KILL!" killed = killed + 1 - ! cycle ! ??? endif ! calcul du barycentre @@ -74,11 +73,13 @@ program movebloubs by = by + dble(bloub%py) bz = bz + dble(bloub%pz) - write(outu, iostat=errcode) bloub ! no error control ? - if (0 .ne. errcode) then - STOP " : WRITE ERROR TO " // trim(outfile) + if (bloub%alive) then + write(outu, iostat=errcode) bloub + if (0 .ne. errcode) then + STOP " : WRITE ERROR TO " // trim(outfile) + endif + compteur = compteur + 1 endif - compteur = compteur + 1 enddo ! end of main loop @@ -88,15 +89,15 @@ program movebloubs ! insert some fancy conditional here if (compteur .LT. 200) then - call add_more_bloubs(outu, 5, 0.1333) + call add_more_bloubs(outu, 4, 0.1056) endif ! insert some very fancy conditional here - if (compteur .LT. 3000) then + if (compteur .LT. 800) then rnd = rand() write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd - if (rnd .LT. 0.0455) then - call add_more_bloubs(outu, 24, 0.0999) + if (rnd .LT. 0.0604) then + call add_more_bloubs(outu, 11, 0.099) endif endif @@ -120,7 +121,7 @@ contains type(t_bloubs) :: bloub integer :: foo, count - count = nbre+mod(irand(), 9) + count = nbre+mod(irand(), 6) write(0, '(A,I4,1X,A)') "adding", count, "bloubs" do foo=1, count diff --git a/BloubWorld/runme.sh b/BloubWorld/runme.sh index 189a59f..5a2c5a4 100755 --- a/BloubWorld/runme.sh +++ b/BloubWorld/runme.sh @@ -10,7 +10,7 @@ TMPPNG="/dev/shm/bloubs7.png" POVOPT="+Q9 +a -v -d -W1600 -H1200 -WT2" DDIR="frames/a" LOGERR="log.error" -TXTCOLOR="RosyBrown" +TXTCOLOR="GreenYellow" # --- put the work file in ramdisk BLBS_IN="/dev/shm/in.blbs" @@ -54,7 +54,7 @@ do convert ${TMPPNG} \ -font Courier-Bold \ - -pointsize 24 \ + -pointsize 28 \ -fill "$TXTCOLOR" \ -gravity south-east \ -annotate +25+5 "$td" \ @@ -62,16 +62,17 @@ do -annotate +25+5 "$hi" \ -pointsize 48 \ -gravity north-east \ - -annotate +25+5 "$count" \ + -annotate +45+5 "$count" \ -gravity north-west \ - -annotate +25+5 "BloubWorld" \ + -annotate +45+5 "BloubWorld" \ $PNG echo $PNG '[done]' ./movebloubs ${BLBS_IN} ${BLBS_OUT} - # ./mergebloubs ${BLBS_OUT} ${BLBS_IN} - mv ${BLBS_OUT} ${BLBS_IN} + ./mergebloubs ${BLBS_OUT} ${BLBS_IN} + # mv ${BLBS_OUT} ${BLBS_IN} + echo done diff --git a/BloubWorld/scene.pov b/BloubWorld/scene.pov index 91327ea..bf975b7 100644 --- a/BloubWorld/scene.pov +++ b/BloubWorld/scene.pov @@ -11,8 +11,6 @@ global_settings { #include "colors.inc" - - #include "WS/nbimg.inc" #declare NormClock = clock / NbImg; @@ -28,16 +26,16 @@ global_settings { object { Bloubs - finish { phong 0.55 specular 0.55 } + finish { phong 0.57 specular 0.57 } } object { union { - plane { <1, 0, 0>, -32 } - plane { <1, 0, 0>, 32 } - plane { <0, 1, 0>, -24 } - plane { <0, 1, 0>, 24 } - plane { <0, 0, 1>, 50 } + plane { <1, 0, 0>, -37 } + plane { <1, 0, 0>, 37 } + plane { <0, 1, 0>, -27 } + plane { <0, 1, 0>, 27 } + plane { <0, 0, 1>, 69 } texture { pigment { color srgb <0.125, 0.144, 0.111> } @@ -46,17 +44,19 @@ object { } } +// object { cylinder { <0, 0, 0>, <10, 0, 0>, 0.05 pigment { color Cyan } } } + // ---------------------------------------------------------- -#declare BH = 5; // H = taille en horizontal -#declare BV = 5; // V = taille en vertical -#declare BR = 0.032; +#declare BH = 6; // H = taille en horizontal +#declare BV = 4; // V = taille en vertical +#declare BR = 0.034; #declare Une_Borne = object { merge { cylinder { <0, BV, 0>, <0, -BV, 0>, BR } - cylinder { <0, 0.012, 0>, <0, -0.012, 0>, BR*4 } + cylinder { <0, 0.014, 0>, <0, -0.014, 0>, BR*4 } } } @@ -75,8 +75,8 @@ pigment { color Gray40 } #declare Les_Bornes = object { union { - #local E = 0.002; - object { Un_Cadre translate y*(BV-E) } + #local E = 0.0015; + object { Un_Cadre translate y*(BV-E) } object { Un_Cadre translate -y*(BV-E) } object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue } } @@ -109,12 +109,12 @@ union { } // ---------------------------------------------------------- -light_source { <19, -12, -17> color Gray80 } -light_source { <11, 14, 9> color Gray60 } +light_source { <19, -12+NormClock, -17> color Gray80 } +light_source { <11, 14-NormClock, 9> color Gray60 } #declare XCAM = 8 - ( 15 * NormClock); -#declare YCAM = 1 + (0.75 * NormClock); -#declare ZCAM = -17.5; +#declare YCAM = -1.1 + (0.95 * NormClock); +#declare ZCAM = -13.10; #declare XLAT = Bary_X; #declare YLAT = Bary_Y; @@ -126,5 +126,5 @@ camera { location look_at right x*image_width/image_height - angle 66 + angle 86 } diff --git a/BloubWorld/toinc.awk b/BloubWorld/toinc.awk index e11f1b6..c30345e 100644 --- a/BloubWorld/toinc.awk +++ b/BloubWorld/toinc.awk @@ -1,4 +1,6 @@ +# +# Input for this script is generated by 'exportbloubs.f90' # # this code is (C) 2022 tTh # @@ -13,9 +15,19 @@ BEGIN { { age = $5 - if (age < 2) color = "Orange" - else if (age > 8) color = "Gray70" - else color = "Sienna" + merged = $6 + + color = "Cyan" + 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 by += $2 bz += $3