oups!

BloubWorld/.gitignore

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

BloubWorld/Makefile

@@ -1,6 +1,6 @@
 
 
-all:	genbloubs movebloubs exportbloubs
+all:	genbloubs movebloubs exportbloubs mergebloubs
 
 
 GFOPT = -Wall -Wextra -g -time
@@ -11,6 +11,12 @@ 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
@@ -33,5 +39,8 @@ 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              :: seq
+    integer              :: age
   end type t_bloubs
 
   contains               ! -----------------------------------------
@@ -47,8 +47,9 @@ 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)') '|  ', blb%nick, blb%num, life
+    write (0, '(4X,A3,A8,2X,I6,4X,A5,4X,I5)') '|  ',       &
+                                 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, '()')
@@ -74,42 +75,59 @@ module bloubspace
     if (5.0 .lt. blb%px) then
       blb%vx = -1.0 * blb%vx
       blb%px = 5.0
-      blb%seq = blb%seq + 1
+      blb%age = blb%age + 1
     endif
     if (-5.0 .gt. blb%px) then
       blb%vx = -1.0 * blb%vx
       blb%px = -5.0
-      blb%seq = blb%seq + 1
+      blb%age = blb%age + 1
     endif
 
     if (0.0 .gt. blb%py) then
       blb%vy = -1.0 * blb%vy
       blb%py = 0.0
-      blb%seq = blb%seq + 1
+      blb%age = blb%age + 1
     endif
     if (5.0 .lt. blb%py) then
       blb%vy = -1.0 * blb%vy
-      blb%seq = blb%seq + 1
+      blb%age = blb%age + 1
       blb%py = 5.0
     endif
 
     if (5.0 .lt. blb%pz) then
       blb%vz = -1.0 * blb%vz
-      blb%seq = blb%seq + 1
+      blb%age = blb%age + 1
       blb%pz = 5.0
     endif
     if (-5.0 .gt. blb%pz) then
       blb%vz = -1.0 * blb%vz
-      blb%seq = blb%seq + 1
+      blb%age = blb%age + 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%seq .gt. 6) then
+    if (blb%age .gt. 5) then
       blb%alive = .FALSE.
     endif
   end subroutine

BloubWorld/genbloubs.f90

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

BloubWorld/mathstuff.f90

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

BloubWorld/mergebloubs.f90

@@ -0,0 +1,154 @@
+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 (add_new_bloub) then
+  if (compteur .LT. 1500) then
 
-    call add_more_bloubs(outu, 8, 0.095)
+    call add_more_bloubs(outu, 8, 0.075)
 
   endif
 
@@ -110,8 +110,8 @@ contains
     bloub%alive = .TRUE.
     call random_pv(bloub)
     bloub%radius = wtf
-    bloub%seq    = foo
+    bloub%age   = foo
-    call display_bloub (bloub, "new bloub")
+    ! call display_bloub (bloub, "new bloub")
     write(un) bloub              ! no error control ?
 
   enddo

BloubWorld/povstuff.f90

@@ -22,6 +22,13 @@ 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,14 +7,15 @@
 
 INCFILE="bloubs.inc"
 TMPPNG="/dev/shm/bloubs7.png"
-POVOPT="+Q9 +a -v -d -W920 -H600 -WT2"
+POVOPT="+Q5 -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=4000
+NBIMG=600
 
 make all
 err=$?
@@ -27,9 +28,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 paraletrizable
+#    --> this function need to be parametrizable
 #
-./genbloubs ${BLBS_IN}  5000
+./genbloubs ${BLBS_IN}  100
 
 for idx in $(seq 0 $NBIMG)
 do
@@ -53,7 +54,7 @@ do
 	convert		${TMPPNG}			\
 			-font Courier-Bold		\
 			-pointsize 22			\
-			-fill CadetBlue			\
+			-fill Orange			\
 			-gravity south-east		\
 			-annotate +15+10 "$td"		\
 			-gravity south-west		\
@@ -66,6 +67,8 @@ do
 	mv ${BLBS_OUT} ${BLBS_IN}
 	echo
 
+	sleep 33
+
 done
 
 rm $LOGERR
@@ -73,6 +76,6 @@ rm $LOGERR
 # XXX convert -delay 10 -resize 50% -colors 192	\
 # XXX			$DDIR/????[0]*.png foo.gif
 
-./encode.sh
+nice ./encode.sh
 
 

BloubWorld/scene.pov

@@ -5,7 +5,7 @@
 #version 3.7;
 
 global_settings {
-                ambient_light rgb <0.12, 0.01, 0.01>
+                ambient_light rgb <0.12, 0.04, 0.04>
                 assumed_gamma 1.0
                 }
 
@@ -37,21 +37,34 @@ plane	{
 
 //  ----------------------------------------------------------
 
-#declare BH = 5;
+#declare BH = 5;		// H = taille en horizontal
-#declare BV = 5;
+#declare BV = 5;		// V = taille en vertical
-#declare BR = 0.025;
+#declare BR = 0.028;
 
 #declare Une_Borne = object
 {
-union	{
+merge	{
 	cylinder { <0, 0, 0>, <0, BV,   0>, BR     }
-	cylinder { <0, 0, 0>, <0, 0.02, 0>, BR*6   }
+	cylinder { <0, 0, 0>, <0, 0.04, 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,5 +1,9 @@
 
 julia
+pickover
 
 *.pgm
 *.gif
+*.asc
+*.png
+

Fraktalism/Makefile

@@ -16,4 +16,12 @@ 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,14 +13,13 @@ 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 *, "C = ", C
+    print *, "Const = ", C
 
     do ix = 1, width
       fx = (float(ix) / (float(width)/4.0) - 2.0)
@@ -28,24 +27,72 @@ subroutine simple_julia(pic, cx, cy, maxiter)
         fy = (float(iy) / (float(height)/4.0) - 2.0)
 
           ! ------ traitement du pixel
-          iter = 0
+          iter = 0  ; over_iter = .FALSE.
           Z = complex(fx, fy)
-          do while ( (modulus2(Z) .LT. 4.0) .AND.     &
+          do while (modulus2(Z) .LT. 4.0) 
-                     (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) = 0
+          else
             pic(ix, iy) = iter
-
+          endif
-          ! print *, ix, iy, "    ", fx, fy, "    ", iter
 
       enddo
     enddo 
 
-end subroutine
+end subroutine simple_julia
 !-----------------------------------------------------
+! 
+!  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(640, 480)    ::    picz
+    integer, dimension(512, 342)    ::    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, 120)
+    call simple_julia(picz, cx, cy, 250)
     call spit_as_pgm_8(picz, trim(filename))
 
 end program

Fraktalism/mkjuliagif.sh

@@ -1,10 +1,24 @@
 #!/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 / 147.0"      | bc -l)
+	bar=$(echo "$foo / 247.0"      | bc -l)
 	cx=$(echo "0.4 * c($foo)"     | bc -l)
 	cy=$(echo "0.4 * s($foo*2)"   | bc -l)
 

Fraktalism/pickover.f90

@@ -0,0 +1,31 @@
+! 
+!    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

@@ -0,0 +1,72 @@
+#!/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
 
-    print *, "> spit_as_pgm to ", fname
+    ! XXX 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
 
-    print *, "> spit_as_pgm_8 to ", fname
+    ! XXX print *, "> spit_as_pgm_8 to ", fname
     foo = MAXVAL(pic)
-    print *, "      max = ", foo
+    ! XXX print *, "      max = ", foo
     open(newunit=io, file=fname)
     write (io, '(a2)') "P2"
     write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)