BloubWorld/.gitignore

@@ -11,5 +11,4 @@ log.*
 exportbloubs
 genbloubs
 movebloubs
-mergebloubs
 

BloubWorld/Makefile

@@ -1,6 +1,6 @@
 
 
-all:	genbloubs movebloubs exportbloubs mergebloubs
+all:	genbloubs movebloubs exportbloubs
 
 
 GFOPT = -Wall -Wextra -g -time
@@ -11,12 +11,6 @@ OBJS  = bloubspace.o povstuff.o mathstuff.o
 initial.blbs:	genbloubs Makefile
 	./genbloubs $@ 1000
 
-in.blbs:	genbloubs Makefile
-	./genbloubs $@ 300
-
-out.blbs:	in.blbs mergebloubs Makefile
-	./mergebloubs $< $@
-
 # ------------------------------------------------------------
 
 bloubspace.o:	bloubspace.f90 Makefile
@@ -39,8 +33,5 @@ movebloubs:	movebloubs.f90 Makefile $(OBJS)
 exportbloubs:	exportbloubs.f90 Makefile $(OBJS)
 	gfortran $(GFOPT) $< $(OBJS)  -o $@
 
-mergebloubs:	mergebloubs.f90 Makefile $(OBJS)
-	gfortran $(GFOPT) $< $(OBJS)  -o $@
-
 # ------------------------------------------------------------
 

BloubWorld/bloubspace.f90

@@ -15,7 +15,7 @@ module bloubspace
     real                 :: px, py, pz
     real                 :: vx, vy, vz
     real                 :: radius
-    integer              :: age
+    integer              :: seq
   end type t_bloubs
 
   contains               ! -----------------------------------------
@@ -47,9 +47,8 @@ module bloubspace
     else
       life = "dead"
     endif
-    write (0, '(4X, A)') '+--------------- ' // message // " -------"
+    write (0, '(4X, A)') '+------------ ' // message
-    write (0, '(4X,A3,A8,2X,I6,4X,A5,4X,I5)') '|  ',       &
+    write (0, '(4X,A3,A8,2X,I6,4X,A5)') '|  ', blb%nick, blb%num, life
-                                 blb%nick, blb%num, life, blb%age
     write (0, '(4X,A3,3X,3(F8.3, 4X))') '| P', blb%px, blb%py, blb%pz
     write (0, '(4X,A3,3X,3(F8.3, 4X))') '| V', blb%vx, blb%vy, blb%vz
     write (0, '()')
@@ -75,59 +74,42 @@ module bloubspace
     if (5.0 .lt. blb%px) then
       blb%vx = -1.0 * blb%vx
       blb%px = 5.0
-      blb%age = blb%age + 1
+      blb%seq = blb%seq + 1
     endif
     if (-5.0 .gt. blb%px) then
       blb%vx = -1.0 * blb%vx
       blb%px = -5.0
-      blb%age = blb%age + 1
+      blb%seq = blb%seq + 1
     endif
 
     if (0.0 .gt. blb%py) then
       blb%vy = -1.0 * blb%vy
       blb%py = 0.0
-      blb%age = blb%age + 1
+      blb%seq = blb%seq + 1
     endif
     if (5.0 .lt. blb%py) then
       blb%vy = -1.0 * blb%vy
-      blb%age = blb%age + 1
+      blb%seq = blb%seq + 1
       blb%py = 5.0
     endif
 
     if (5.0 .lt. blb%pz) then
       blb%vz = -1.0 * blb%vz
-      blb%age = blb%age + 1
+      blb%seq = blb%seq + 1
       blb%pz = 5.0
     endif
     if (-5.0 .gt. blb%pz) then
       blb%vz = -1.0 * blb%vz
-      blb%age = blb%age + 1
+      blb%seq = blb%seq + 1
       blb%pz = -5.0
     endif
 
   end subroutine
 
   ! ----------------------------------------------------------------
-  function distance_of_bloubs(bla, blb)
-    type(t_bloubs), intent(in)   :: bla, blb
-    real                         :: distance_of_bloubs
-
-    real            :: dx, dy, dz
-
-    dx = (bla%px-blb%px)**2
-    dy = (bla%py-blb%py)**2
-    dz = (bla%pz-blb%pz)**2
-
-    distance_of_bloubs = sqrt(dx + dy +dz)
-
-  end function
-
-  ! ----------------------------------------------------------------
-  !          kill a bloub under condition(s)
-
   subroutine green_soylent (blb)
     type(t_bloubs), intent (inout)  :: blb
-    if (blb%age .gt. 5) then
+    if (blb%seq .gt. 6) then
       blb%alive = .FALSE.
     endif
   end subroutine

BloubWorld/genbloubs.f90

@@ -28,12 +28,11 @@ program genbloubs
 
   do i = 1, nbbloubs
 
-    bloub%nick    = 'noname  '
+    bloub%nick = 'noname  '
-    bloub%num     = i + 41
+    bloub%alive = .TRUE.
-    bloub%alive   = .TRUE.
     call random_pv(bloub)
-    bloub%radius  = 0.025
+    bloub%radius = 0.025
-    bloub%age     = 0
+    bloub%seq    = 0
 
     write(idu) bloub              ! no error control ?
 

BloubWorld/mathstuff.f90

@@ -5,7 +5,6 @@ module mathstuff
   contains
 
   ! ----------------------------------------------------------------
-  !   really quick'n'dirty hack
 
   subroutine init_random_seed()
 

BloubWorld/mergebloubs.f90

@@ -1,154 +0,0 @@
-program mergebloubs
-
-  use bloubspace
-  implicit none
-
-  integer, parameter       :: NB_MAX_BLOUBS = 20000
-
-  character(200)           :: infile, outfile
-  type(t_bloubs)           :: bloub, newbloub
-  integer                  :: inu, outu, errcode
-
-  type(t_bloubs), dimension(:), allocatable  :: les_bloubs
-  integer                                    :: i, idx, nbr_merge
-  real                                       :: rval
-  logical                                    :: merged
-
-! --------------- check command line parameters
-  if (IARGC() .ne. 2) then
-    STOP ": NEED IN AND OUT FILENAME"
-  endif
-  call getarg(1, infile)
-  call getarg(2, outfile)
-
-  write(0, '(2A20, I8)') trim(infile), trim(outfile), NB_MAX_BLOUBS
-
-! --------------- allocate memory for the people
-
-  allocate (les_bloubs(NB_MAX_BLOUBS), stat=errcode)
-  if (0 .NE. errcode) then
-    STOP " : NO ENOUGH MEMORY"
-  endif
-
-  do i = 1, NB_MAX_BLOUBS
-    les_bloubs(i)%alive = .FALSE.
-  enddo
-
-! --------------- open / creat the files
-
-  open(newunit=inu,                                          &
-                  file=trim(infile), form='unformatted',     &
-                  iostat=errcode,                            &
-                  action='read', status='old')
-  if (0 .ne. errcode) then
-    STOP " : CAN'T OPEN FILE " // trim(infile)
-  endif
-
-  open(newunit=outu,                                         &
-                  file=trim(outfile), form='unformatted',    &
-                  iostat=errcode,                            &
-                  action='write', status='replace')
-  if (0 .ne. errcode) then
-    STOP " : CAN'T OPEN " // trim(outfile) // "FOR WRITE"
-  endif
-
-! --------------- read the first bloub
-
-  idx = 1
-
-  read (unit=inu, iostat=errcode) bloub
-    if (0 .ne. errcode) then
-      STOP " : ERR READING FIRST BLOUB"
-    endif
-  call display_bloub (bloub, "first bloub")
-  les_bloubs(idx) = bloub
-  idx = idx + 1
-
-! --------------- loop over the other bloubs
-  nbr_merge = 0
-
-  do                 ! infinite loop
-
-    print *, "============ PASS ", idx
-    ! read the next bloub from input file
-    read (unit=inu, iostat=errcode) bloub
-      if (0 .ne. errcode) then
-        exit
-      endif
-    !! call display_bloub (bloub, "next bloub")
-
-    if (.NOT. bloub%alive) then
-      STOP " : I HAVE READ A DEAD BLOUB"
-    endif
-
-    ! check with all the previuous blobs
-    merged = .FALSE.
-    do i = 1, idx-1
-      if (.NOT. les_bloubs(i)%alive) then
-        ! print *, "dead bloub at ", i, " on ", idx
-        ! call display_bloub(les_bloubs(i), "DEAD ? WTF ?")
-        cycle
-      endif
-
-      rval = distance_of_bloubs(les_bloubs(i), bloub)
-
-      if (rval .LT. (les_bloubs(i)%radius + bloub%radius)) then
-        print *, "contact : ", i, idx, rval
-        call merge_two_bloubs(les_bloubs(i), bloub, newbloub)
-        les_bloubs(i)%alive = .FALSE.
-        nbr_merge = nbr_merge + 1
-        merged = .TRUE.
-      endif
-
-    enddo
-    if (merged) then
-      ! put new bloub in the list
-      les_bloubs(idx) = newbloub
-    else
-      ! put old bloub in the list
-      les_bloubs(idx) = bloub
-    endif
-
-    idx = idx + 1
-
-    ! print *, "idx = ", idx
-
-  enddo              ! end of infinit... WHAT?
-
-! --------------- is the job done ?
-
-  close(inu)    ;    close(outu)
-
-  write(0, '()')
-  write(0, '(I5, A)') nbr_merge, " merges"
-  write(0, '(A)') "--- mergebloubs . . . . . . .  [done]"
-
-! --------------------------------------------------------------
-contains
-
-  subroutine merge_two_bloubs(bla, blb, blr)
-      type(t_bloubs), intent(in)   :: bla, blb
-      type(t_bloubs), intent(out)  :: blr
-
-      blr%nick     = "newbie  "
-      blr%num      = 0                !    ???
-
-      blr%px = (bla%px + blb%px) / 2.0
-      blr%py = (bla%py + blb%py) / 2.0
-      blr%pz = (bla%pz + blb%pz) / 2.0
-
-      blr%vx = (bla%vx + blb%vx) / 2.0
-      blr%vy = (bla%vy + blb%vy) / 2.0
-      blr%vz = (bla%vz + blb%vz) / 2.0
-
-      blr%radius = (bla%radius + blb%radius) / 1.414
-      blr%age = min(bla%age, blb%age)
-
-      ! bring it to life !
-      blr%alive    = .TRUE.
-
-  end subroutine
-
-end program
-
-

BloubWorld/movebloubs.f90

@@ -11,7 +11,7 @@ program movebloubs
   integer                  :: compteur, killed
   type(t_bloubs)           :: bloub
   double precision         :: bx, by, bz
-  ! logical                  :: add_new_bloub = .TRUE.
+  logical                  :: add_new_bloub = .TRUE.
   ! real                     :: rnd
 
   call init_random_seed()
@@ -78,9 +78,9 @@ program movebloubs
   ! ok, we have read all the bloubs in the input file
 
   ! insert some fancy conditional here
-  if (compteur .LT. 1500) then
+  if (add_new_bloub) then
 
-    call add_more_bloubs(outu, 8, 0.075)
+    call add_more_bloubs(outu, 8, 0.095)
 
   endif
 
@@ -110,8 +110,8 @@ contains
     bloub%alive = .TRUE.
     call random_pv(bloub)
     bloub%radius = wtf
-    bloub%age   = foo
+    bloub%seq    = foo
-    ! call display_bloub (bloub, "new bloub")
+    call display_bloub (bloub, "new bloub")
     write(un) bloub              ! no error control ?
 
   enddo

BloubWorld/povstuff.f90

@@ -22,13 +22,6 @@ module povstuff
 
   ! ----------------------------------------------------------------
 
-  subroutine start_of_inc_file (fd)
-    integer, intent (in)             :: fd
-
-    write(fd, '(A)') "// DON'T EDIT THIS FILE !"
-
-  end subroutine
-
   ! ----------------------------------------------------------------
   ! we need some primitives for the gestion of colors.
   ! may be a small database indexed by name ?

BloubWorld/runme.sh

@@ -7,15 +7,14 @@
 
 INCFILE="bloubs.inc"
 TMPPNG="/dev/shm/bloubs7.png"
-POVOPT="+Q5 -a -v -d -W920 -H600 -WT2"
+POVOPT="+Q9 +a -v -d -W920 -H600 -WT2"
 DDIR="frames"
 LOGERR="log.error"
 
-# --- put the work file in ramdisk
 BLBS_IN="/dev/shm/in.blbs"
 BLBS_OUT="/dev/shm/out.blbs"
 
-NBIMG=600
+NBIMG=4000
 
 make all
 err=$?
@@ -28,9 +27,9 @@ printf "\n#declare NbImg = %d;\n" $NBIMG > nbimg.inc
 
 #
 #    first, we have to make a seminal buch of bloubs
-#    --> this function need to be parametrizable
+#    --> this function need to be paraletrizable
 #
-./genbloubs ${BLBS_IN}  100
+./genbloubs ${BLBS_IN}  5000
 
 for idx in $(seq 0 $NBIMG)
 do
@@ -54,7 +53,7 @@ do
 	convert		${TMPPNG}			\
 			-font Courier-Bold		\
 			-pointsize 22			\
-			-fill Orange			\
+			-fill CadetBlue			\
 			-gravity south-east		\
 			-annotate +15+10 "$td"		\
 			-gravity south-west		\
@@ -67,8 +66,6 @@ do
 	mv ${BLBS_OUT} ${BLBS_IN}
 	echo
 
-	sleep 33
-
 done
 
 rm $LOGERR
@@ -76,6 +73,6 @@ rm $LOGERR
 # XXX convert -delay 10 -resize 50% -colors 192	\
 # XXX			$DDIR/????[0]*.png foo.gif
 
-nice ./encode.sh
+./encode.sh
 
 

BloubWorld/scene.pov

@@ -5,7 +5,7 @@
 #version 3.7;
 
 global_settings {
-                ambient_light rgb <0.12, 0.04, 0.04>
+                ambient_light rgb <0.12, 0.01, 0.01>
                 assumed_gamma 1.0
                 }
 
@@ -37,34 +37,21 @@ plane	{
 
 //  ----------------------------------------------------------
 
-#declare BH = 5;		// H = taille en horizontal
+#declare BH = 5;
-#declare BV = 5;		// V = taille en vertical
+#declare BV = 5;
-#declare BR = 0.028;
+#declare BR = 0.025;
 
 #declare Une_Borne = object
 {
-merge	{
+union	{
 	cylinder { <0, 0, 0>, <0, BV,   0>, BR     }
-	cylinder { <0, 0, 0>, <0, 0.04, 0>, BR*6   }
+	cylinder { <0, 0, 0>, <0, 0.02, 0>, BR*6   }
 	}
 }
 
-#declare Cadre_Haut = object
-{
-merge {
-	cylinder { <-BH, 0, -BH>, <-BH, 0,  BH>, BR    }
-	cylinder { < BH, 0, -BH>, < BH, 0,  BH>, BR    }
-	cylinder { < BH, 0, -BH>, <-BH, 0, -BH>, BR    }
-	cylinder { < BH, 0,  BH>, <-BH, 0,  BH>, BR    }
-	}
-pigment { color Gray50 }
-}
-
 #declare Les_Bornes = object
 {
 union	{
-	object { Cadre_Haut translate y*(BV-0.05) }
-
 	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 } }

Fraktalism/.gitignore

@@ -1,9 +1,5 @@
 
 julia
-pickover
 
 *.pgm
 *.gif
-*.asc
-*.png
-

Fraktalism/Makefile

@@ -16,12 +16,4 @@ OBJS = spitpgm.o fraktals.o
 julia:		julia.f90 Makefile $(OBJS)
 	gfortran $(GFOPT) $<  $(OBJS)    -o $@
 
-pickover:	pickover.f90 Makefile $(OBJS)
-	gfortran $(GFOPT) $<  $(OBJS)    -o $@
-
-# ---------------------------------------------
-
-foo.pgm:	pickover Makefile
-	./pickover $@ > /dev/null
-
 # ---------------------------------------------

Fraktalism/fraktals.f90

@@ -13,13 +13,14 @@ subroutine simple_julia(pic, cx, cy, maxiter)
     real         ::  fx, fy
     complex      ::  Z, C
     integer      ::  iter
-    logical      ::  over_iter
 
     width  = ubound(pic, 1)
     height = ubound(pic, 2)
+    ! print *, "image size : ", width, height
+    ! print *, "constante  : ", cx, cy
 
     C = complex(cx, cy)
-    print *, "Const = ", C
+    ! print *, "C = ", C
 
     do ix = 1, width
       fx = (float(ix) / (float(width)/4.0) - 2.0)
@@ -27,72 +28,24 @@ subroutine simple_julia(pic, cx, cy, maxiter)
         fy = (float(iy) / (float(height)/4.0) - 2.0)
 
           ! ------ traitement du pixel
-          iter = 0  ; over_iter = .FALSE.
+          iter = 0
           Z = complex(fx, fy)
-          do while (modulus2(Z) .LT. 4.0) 
+          do while ( (modulus2(Z) .LT. 4.0) .AND.     &
-
+                     (iter < maxiter) )
             Z = (Z * Z) + C
             iter = iter + 1
 
-            if (iter .GE. maxiter) then
-              over_iter = .TRUE.
-              exit
-            endif
-
           end do
 
-          if (over_iter) then
+          pic(ix, iy) = iter
-            pic(ix, iy) = 0
+
-          else
+          ! print *, ix, iy, "    ", fx, fy, "    ", iter
-            pic(ix, iy) = iter
-          endif
 
       enddo
     enddo 
 
-end subroutine simple_julia
+end subroutine
 !-----------------------------------------------------
-! 
-!  d'après les pages 91/92 du livre de Roger T Stevens
-!       "Fractal programming in C"
-! 
-subroutine pickover_0(pic, count)
-    implicit none
-    integer, intent(inout), dimension (:,:)  ::  pic
-    integer, intent(in)                      ::  count
-
-    double precision      :: xa, ya, za, xb, yb, zb
-    double precision      :: ka, kb, kc, kd
-    integer               :: i, w, h, px, py
-
-    ka = 2.24 ; kb = 0.43 ; kc = -0.65 ; kd = -2.43
-    xa = 0.00 ; ya = 0.00 ; za = 0.0
-
-    w  = ubound(pic, 1)
-    h = ubound(pic, 2)
-
-    do i=1, count
-
-      xb = sin(ka*ya) - za*cos(kb*xa)
-      yb = za*sin(kc*xa) - cos(kd*ya)
-      zb = sin(xa)
-
-      px = (xb * (w/4.05)) + (w / 2)
-      py = (yb * (h/4.05)) + (h / 2)
-
-      pic(px, py) = 200              ! WARNING COREDUMP
-
-      print *, xb, yb, zb
-      
-      xa = xb ; ya = yb ; za = zb 
-
-    enddo
-
-end subroutine pickover_0
-!-----------------------------------------------------
-!           -- some support functions --
-!-----------------------------------------------------
-
 function dist0 (x, y)
   implicit none
   real, intent(in)    :: x, y

Fraktalism/julia.f90

@@ -10,21 +10,21 @@ program julia
 
     implicit none
 
-    integer, dimension(512, 342)    ::    picz
+    integer, dimension(640, 480)    ::    picz
     integer                         ::    argc
     character(200)                  ::    filename, string
     real                            ::    cx, cy
 
     argc = IARGC()
     if (3 .NE. argc) then
-      STOP ": JULIA PROGGY NEED PARAMETERS !"
+      STOP ": JULIA PROGGY NEED PARAMETERS"
     endif
 
     call getarg(1, filename)
     call getarg(2, string)       ;   read (string, *) cx
     call getarg(3, string)       ;   read (string, *) cy
 
-    call simple_julia(picz, cx, cy, 250)
+    call simple_julia(picz, cx, cy, 120)
     call spit_as_pgm_8(picz, trim(filename))
 
 end program

Fraktalism/mkjuliagif.sh

@@ -1,24 +1,10 @@
 #!/bin/bash
 
-#
-#	build the prog
-#
-
-make julia
-if [ $? -ne 0 ] ; then
-	echo
-	echo "Make error " $?
-	exit 1
-fi
-
-#
-#	run the prog
-#
 for foo in $(seq 0 39)
 do
 
 	img=$(printf "frames/%05d.pgm" $foo)
-	bar=$(echo "$foo / 247.0"      | bc -l)
+	bar=$(echo "$foo / 147.0"      | bc -l)
 	cx=$(echo "0.4 * c($foo)"     | bc -l)
 	cy=$(echo "0.4 * s($foo*2)"   | bc -l)
 

Fraktalism/pickover.f90

@@ -1,31 +0,0 @@
-! 
-!    this is the main programm
-! 
-!-----------------------------------------------------
-
-program pickover
-
-    use spitpgm
-    use fraktals
-
-    implicit none
-
-    integer, dimension(800, 600)    ::    picz
-    integer                         ::    argc
-    character(200)                  ::    filename
-
-    argc = IARGC()
-    if (1 .NE. argc) then
-      STOP ": PICKOVER NEED A FILENAME !"
-    endif
-
-    call getarg(1, filename)
-
-    write (0, "(A)") "Pickover -> "//trim(filename)
-
-    call pickover_0(picz, 50000)
-    call spit_as_pgm_8(picz, trim(filename))
-
-end program
-
-!-----------------------------------------------------

Fraktalism/plotpick.sh

@@ -1,72 +0,0 @@
-#!/bin/bash
-
-ASCFILE="nuage.asc"
-IMAGE="pick3d.png"
-
-make pickover
-if [ $? -ne 0 ] ; then
-	echo
-	echo "Make error " $?
-	exit 1
-fi
-
-./pickover foo.pgm > $ASCFILE
-if [ $? -ne 0 ] ; then
-	echo
-	echo "Pickover error " $?
-	exit 1
-fi
-
-
-# ----------------------------------------------------
-function plot_this_pic()
-{
-local imgname="$1"
-local angle="$2"
-
-printf "== %s == %3d ==\n" $imgname $angle
-
-gnuplot << __EOC__
-	set term png    size 800,480
-	set output      "${imgname}"
-
-	set title "3D Pickover"
-	unset grid
-	unset tics
-
-	set view 70, $angle, 1.20
-	set xrange [ -2.10 : 2.10 ]
-	set yrange [ -2.10 : 2.10 ]
-	set zrange [ -1.00 : 1.00 ]
-
-	splot "${ASCFILE}" notitle with dots lt rgb "blue"
-__EOC__
-}
-
-# ----------------------------------------------------
-ddir="frames"
-
-rm $ddir/p???.png
-
-idx=0
-for angle in $(seq 0 6 360)
-do
-
-	fname=$(printf "%s/p%03d.png" $ddir $idx)
-
-	plot_this_pic $fname $angle
-
-	idx=$(( idx + 1 ))
-
-done
-
-convert -delay 10 $ddir/p???.png pickover.gif
-
-echo '[done]'
-
-# ------------------------------------------ EOJ -----
-
-
-
-
-

Fraktalism/spitpgm.f90

@@ -15,7 +15,7 @@ subroutine spit_as_pgm(pic, fname)
     integer   :: ix, iy
     real      :: fk, fpix
 
-    ! XXX print *, "> spit_as_pgm to ", fname
+    print *, "> spit_as_pgm to ", fname
 
     open(newunit=io, file=fname)
     write (io, '(a2)') "P2"
@@ -50,9 +50,9 @@ subroutine spit_as_pgm_8(pic, fname)
     integer   :: io, foo
     integer   :: ix, iy
 
-    ! XXX print *, "> spit_as_pgm_8 to ", fname
+    print *, "> spit_as_pgm_8 to ", fname
     foo = MAXVAL(pic)
-    ! XXX print *, "      max = ", foo
+    print *, "      max = ", foo
     open(newunit=io, file=fname)
     write (io, '(a2)') "P2"
     write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)