making some funny gif89a

BloubWorld/bloubspace.f90

@@ -293,7 +293,6 @@ module bloubspace
   end subroutine
   ! ----------------------------------------------------------------
 
-
 end module
 
 

BloubWorld/listbloubs.f90

@@ -18,12 +18,13 @@ program movebloubs
   call getarg(1, infile)
 
   write (0, '(A)') &
-            "*** listing bloubs from "//trim(infile)
+            "***** listing bloubs from "//trim(infile)
 
   allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY"
   endif
+  ! run a molly-guard
   do i = 1, NB_MAX_BLOUBS
     bloubs(i)%alive = .FALSE.
   enddo
@@ -31,7 +32,7 @@ program movebloubs
   call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
   write(0, '(A,I6,1X,A)') "slurped ", nbgot, "bloubs"
 
-  do i=1,nbgot
+  do i=1, nbgot
     write(6, '(A8, 1X, 1L, 1X, I2, 3X, F8.3, 3X, 3F8.3, 3X, 3F8.3, 1X, I4)')  &
           bloubs(i)%nick, bloubs(i)%alive,               &
           bloubs(i)%state,                               &

BloubWorld/runme.sh

@@ -74,6 +74,7 @@ do
 	# mv ${BLBS_OUT} ${BLBS_IN}
 
 	echo
+	sleep 90
 
 done
 

Fraktalism/.gitignore

@@ -7,6 +7,7 @@ evolvopick
 henon
 essai
 
+frames/*
 WS/*.dat
 WS/*.txt
 WS/*.inc

Fraktalism/Makefile

@@ -11,10 +11,14 @@ mods/spitpgm.o:		mods/spitpgm.f90 Makefile
 mods/points3d.o:	mods/points3d.f90 Makefile
 	gfortran $(GFOPT) -c $< -o $@
 
+mods/xperiment.o:	mods/xperiment.f90 Makefile
+	gfortran $(GFOPT) -c $< -o $@
+
 fraktals.o:	fraktals.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-OBJS  = mods/spitpgm.o mods/points3d.o fraktals.o 
+OBJS  = mods/spitpgm.o mods/points3d.o mods/xperiment.o 	\
+	fraktals.o 
 
 # ---------------------------------------------
 

Fraktalism/README.md

@@ -8,8 +8,8 @@ qui montre ma première expérience dans ce domaine.
 
 ## La technique
 
-Le gros des calculs de fractales est fait dans XXX, et la gestion
-des pixels 'physiques' est fait dans YYY
+Le gros des calculs de fractales est fait dans `mods/fraktals.f90`,
+et la gestion des pixels 'physiques' est fait dans `mods/spitpgm`.
 
 Les fonctions d'usage général sont dans
 [mods/](répertoire mods/) ave trop peu

Fraktalism/essai.f90

@@ -1,9 +1,36 @@
 !-----------------------------------------------------
 program essai
+
   use spitpgm
+  use fraktals
+  use points3d
+  use xperiment
 
   implicit none
 
+  integer, dimension(:,:), allocatable    ::    picz
+  integer                                 ::    W, H, foo
+  integer                                 ::    errcode
+  character(200)                          ::    filename
+  real                                    ::    kx, ky
+
+  write(0, *) "============= essai =============="
+
+  W = 320     ;       H = 240
+
+  call srand(666)
+
+  allocate(picz(W,H), stat=errcode)
+
+  do foo=1, 360
+    write (filename, "(a, i5.5, a)") "frames/popcorn/", foo, ".pnm"
+    write(0, *) "-------->", trim(filename), "<"
+    kx   = 50.0 * sin(real(foo)*25.133)
+    ky   = 50.0 * cos(real(foo)*25.133)
+    write(0, *) foo, kx, ky
+    call parasites_0(picz, kx, ky, 233)
+    call spit_as_pgm_8(picz, trim(filename))
+  enddo
 
 !-----------------------------------------------------
 end program

Fraktalism/fraktals.f90

@@ -3,12 +3,51 @@ module fraktals
   use points3d
 
   implicit none
-!-----------------------------------------------------
-
-!-----------------------------------------------------
   contains
 
-!-----------------------------------------------------
+!===============================================================
+!	nouveau 28 mai 2022 (again) 
+! source:
+!    Fractal Creation with FRACTINT
+!
+subroutine parasites_0(pic, cx, cy, maxiter)
+    implicit none
+
+    ! here is the wtf
+    integer, intent(inout), dimension (:,:)  ::  pic
+
+    real, intent(in)                         ::  cx, cy
+    integer, intent(in)                      ::  maxiter
+
+    integer      ::  ix, iy, width, height
+    real         ::  fx, fy, coef
+    logical      ::  burps
+    ! write(0, *) "subroutine parasites_0" , maxiter
+    ! write(0, *) "constantes", cx, cy
+ 
+    width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
+    coef   = float(maxiter)
+
+    do ix = 1, width
+      fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
+      burps = (RAND() .lt. 0.01)
+      do iy = 1, height
+        fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
+
+        if (burps) then
+          pic(ix, iy) = int(fx * fy * coef * 1.005)
+        else
+          pic(ix, iy) = int(fx * fy * coef)
+        endif
+
+      enddo
+    enddo
+
+end subroutine parasites_0
+
+
+!===============================================================
+
 subroutine simple_julia(pic, cx, cy, maxiter)
     implicit none
     integer, intent(inout), dimension (:,:)  ::  pic
@@ -59,8 +98,8 @@ subroutine simple_julia(pic, cx, cy, maxiter)
     enddo        ! ix
 
 end subroutine simple_julia
-!-----------------------------------------------------
-! 
+!===============================================================
+ 
 !  d'après les pages 91/92 du livre de Roger T Stevens
 !       "Fractal programming in C"
 ! 
@@ -130,7 +169,7 @@ subroutine plot_pickover(pic, count)
 
 end subroutine plot_pickover
 
-!-----------------------------------------------------
+!===============================================================
 ! 
 !  d'après les pages NN/NN du livre de Roger T Stevens
 !       "Fractal programming in C"
@@ -144,15 +183,15 @@ subroutine lorentz_0(pic, count)
 ! XXX    double precision      :: ka, kb, kc, kd
 ! XXX    integer               :: i, w, h, px, py
 
-
+   write(0, *) "proc lorentz_0, count is ", count
 
 end subroutine lorentz_0
 
-!-----------------------------------------------------------
+!===============================================================
 !           -- some support functions --
 !-----------------------------------------------------------
 !       usage : evolvopick & voxelize
-  subroutine interp4dp (ina, inb, out, dpk)
+subroutine interp4dp (ina, inb, out, dpk)
     double precision, dimension(4), intent(in)   :: ina, inb
     double precision, dimension(4), intent(out)  :: out
     double precision, intent(in)                 :: dpk
@@ -162,7 +201,7 @@ end subroutine lorentz_0
       out(foo) = (ina(foo) * (1.0-dpk)) + (inb(foo) * (dpk))
     enddo
 
-  end subroutine
+end subroutine
 !-----------------------------------------------------------
 
 function dist0 (x, y)

Fraktalism/mkvoxvidz.sh

@@ -57,7 +57,7 @@ do
 	grep 'Parse Time' WS/toto.err
 	grep 'Trace Time' WS/toto.err
 
-	echo ; sleep 10
+	echo 
 
 done
 

Fraktalism/mods/documention.md

@@ -2,8 +2,10 @@
 
 ## Points 3d
 
+Bientôt les quaternions ?
 
 ## Portable Net Map
 
-.pgm
+Fichiers de type `PGM` utilisés ici en version 16 bits, donc
+65536 niveaux de gris.
 

Fraktalism/mods/points3d.f90

@@ -49,7 +49,8 @@ subroutine write_points3d(array, start, length, fname)
     open(newunit=io, file=fname)
     do i = 1, length
        j = i + start
-       write(io, '(3F12.6)') array(j)%x, array(j)%y, array(j)%z
+       write(io, '(3F12.6, I8)')           &
+             array(j)%x, array(j)%y, array(j)%z, array(j)%seq
     enddo
     close(io)
 

Fraktalism/mods/xperiment.f90

@@ -0,0 +1,65 @@
+module xperiment
+
+  implicit none
+  contains
+
+!===============================================================
+! nouveau 24 mai 2022
+
+subroutine parasites_0(pic, cx, cy, maxiter)
+    implicit none
+
+    ! here is the wtf
+    integer, intent(inout), dimension (:,:)  ::  pic
+
+    real, intent(in)                         ::  cx, cy
+    integer, intent(in)                      ::  maxiter
+
+    integer      ::  ix, iy, width, height
+    real         ::  fx, fy, coef
+    logical      ::  burps
+    ! write(0, *) "subroutine parasites_0" , maxiter
+    ! write(0, *) "constantes", cx, cy
+ 
+    width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
+    coef   = float(maxiter)
+
+    do ix = 1, width
+      fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
+      burps = (RAND() .lt. 0.01)
+      do iy = 1, height
+        fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
+
+        if (burps) then
+          pic(ix, iy) = int(fx * fy * coef * 1.005)
+        else
+          pic(ix, iy) = int(fx * fy * coef)
+        endif
+
+      enddo
+    enddo
+
+end subroutine parasites_0
+
+!---------------------------------------------------------------
+!
+!    aucune idee de l'utilisation de ce truc !
+!
+subroutine loop_of_parasites_0(nbre, mode)
+    implicit none
+    integer, intent(in)       :: nbre, mode
+
+    integer                   :: idx
+
+    if (mode .NE. 0)  STOP "BAD MODE"
+
+    do idx = 0, nbre
+
+      write(0, *) "popcorn loop ", idx
+
+    enddo
+
+end subroutine loop_of_parasites_0
+
+!===============================================================
+end module xperiment

Fraktalism/voxelize.f90

@@ -9,7 +9,7 @@ program voxelize
 
   implicit none
 
-  integer, parameter                          :: DIMC = 180
+  integer, parameter                          :: DIMC = 320
   integer, dimension(:,:,:), allocatable      :: cube
   type(t_point3d), dimension(:), allocatable  :: points
   integer                                     :: errcode, foo, argc
@@ -35,7 +35,7 @@ program voxelize
     STOP " : NO ENOUGH MEMORY FOR CUBE"
   endif
 
-  nbr_points = 7000000
+  nbr_points = 9000000
   allocate(points(nbr_points), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY FOR POINTS"

GrafAnim/.gitignore

@@ -0,0 +1,3 @@
+
+essai
+

GrafAnim/Makefile

@@ -0,0 +1,12 @@
+#
+# Fortraneries by tTh - Graf Anim
+#
+
+GFOPT = -Wall -Wextra -g -time
+
+essai:	essai.f90 usegenplot.o Makefile
+	gfortran $(GFOPT) $< usegenplot.o -o $@
+
+usegenplot.o:	usegenplot.f90 Makefile
+	gfortran $(GFOPT) -c $<
+

GrafAnim/README.md

@@ -0,0 +1,5 @@
+# GrafAnim
+
+Quelques essais approximatifs pour faire des graphiques inutiles,
+dans une démarche mettant en avant la techno-futilité
+

GrafAnim/essai.f90

@@ -0,0 +1,13 @@
+program essai
+
+  use usegenplot
+  implicit none
+
+  ! integer                     :: foo, bar
+
+  write(0, *)   "------------ essai graf anim ---------------"
+
+  call init_genplot('essai.genplot')
+
+end program
+

GrafAnim/go.sh

@@ -0,0 +1,6 @@
+#!/bin/bash
+
+set -e
+
+make essai
+

GrafAnim/usegenplot.f90

@@ -0,0 +1,19 @@
+module usegenplot
+
+  implicit none
+  contains
+
+! -------------------------------------------------------------------
+
+subroutine init_genplot(filename)
+
+  character(200) :: filename
+
+  write(0, *)   '-------- init genplot '
+
+end subroutine
+
+! -------------------------------------------------------------------
+
+end module
+

RandomStuff/.gitignore

@@ -0,0 +1,5 @@
+
+
+essai
+displaykinds
+

RandomStuff/Makefile

@@ -0,0 +1,22 @@
+#
+# Fortraneries by tTh - Random Stuff
+#
+
+GFOPT = -Wall -Wextra -g -time
+
+all:		essai displaykinds
+
+# -----------------------------------------------------
+
+mathstuff2.o:	mathstuff2.f90 Makefile
+	gfortran $(GFOPT) -c $<
+
+# -----------------------------------------------------
+
+essai:		essai.f90 Makefile mathstuff2.o
+	gfortran $(GFOPT) $< mathstuff2.o -o $@
+
+displaykinds:	displaykinds.f90 Makefile
+	gfortran $(GFOPT) $< -o $@
+
+# -----------------------------------------------------

RandomStuff/README.md

@@ -1,9 +1,17 @@
 # Random Stuff
 
-Warning, non-sense inside !
+Warning, isometime, there was non-sense inside !
 
 ## Utilities
 
+- some basic mathematical functions.
 
 ## Debug tools
 
+- display all the KIND= variants.
+
+## Useless
+
+- write a few simple cli games.
+
+

RandomStuff/displaykinds.f90

@@ -0,0 +1,5 @@
+program displaykinds
+
+        print *, "--- display all kind's variants ---"
+
+end program

RandomStuff/essai.f90

@@ -0,0 +1,21 @@
+program essai
+
+  use mathstuff2
+  implicit none
+
+  integer                     :: foo, bar
+  real                        :: quux
+  double precision            :: somme
+
+  write(0, *)   "----------------- essai -------------------"
+
+  call init_random_seed()           ! in module 'mathstuff'
+  somme = 0.0
+  do foo=1, 500
+    quux = rand() + rand()
+    somme = somme + quux
+    bar = mod(irand(), 7)
+    print *, foo, quux, somme/foo, bar
+  enddo
+
+end program

RandomStuff/mathstuff2.f90

@@ -0,0 +1,33 @@
+module mathstuff2
+
+! XXX This module was a copy of mathstuff.f90 fromthe BloubWorld
+! XXX                wil be moved in an other place some day...
+
+  implicit none
+  contains
+
+  ! ----------------------------------------------------------------
+  !   really quick'n'dirty hack
+  !                  not really tested yet...
+
+  subroutine init_random_seed()
+
+    integer, dimension(3) :: tarray
+    integer               :: t3, foo
+    real                  :: dummy
+    call itime(tarray)
+    t3 = 3600*tarray(1) + 60*tarray(2) + tarray(3)
+    ! write(0, '(A,3I3,A,I6)') "sranding: ", tarray, " --> ", t3
+    call srand(t3)
+
+    ! after initializing the random generator engine,
+    ! you MUST use it for initializing the initializer
+    do foo=1, tarray(1)+5
+      dummy = rand()
+    enddo
+
+  end subroutine 
+
+  ! ----------------------------------------------------------------
+end module mathstuff2
+

SoundBrotching/.gitignore

@@ -9,6 +9,7 @@
 text2wav
 wav2text
 text2ao
+essai
 
 panoramix
 genwaves

SoundBrotching/Makefile

@@ -4,7 +4,7 @@
 
 GOPT = -Wall -Wextra -time -g 
 
-all:	panoramix genwaves 
+all:	panoramix genwaves essai
 
 # ----------------------------------------------------------
 #
@@ -16,6 +16,10 @@ FLIBS = soundbrotch.o
 soundbrotch.o:	soundbrotch.f90 Makefile
 	gfortran $(GOPT) -c $< 
 
+# some test...
+essai:		essai.f90  Makefile $(FLIBS)
+	gfortran $(GOPT) $< $(FLIBS) -o $@
+
 # main proggies
 panoramix:	panoramix.f90 Makefile $(FLIBS)
 	gfortran $(GOPT) $< $(FLIBS) -o $@

SoundBrotching/demos.sh

@@ -8,7 +8,7 @@ DATAFILE="waves.text"
 
 OUTWAV="quux.wav"
 
-./genwaves | ./panoramix | tee $DATAFILE | c-tools/text2wav $OUTWAV
+./genwaves | tee $DATAFILE | c-tools/text2wav $OUTWAV
 
 sndfile-spectrogram				\
 	--min-freq=30 --max-freq=4000		\

SoundBrotching/essai.f90

@@ -0,0 +1,21 @@
+program essai
+
+  use soundbrotch
+  ! -----------------------------
+  implicit none
+
+  integer          :: n
+  real             :: freq
+
+  write(0, *) "*** On essaye des trucs (shotgun!) ***"
+
+  call soundbrotch_version()
+
+  do n = 20, 85
+    freq = midi2freq(n)
+    write(0, '(12X, I5, 5X, F9.3)') n, freq
+    call sinw_burst2i(6, 22000, freq, freq, 0.9)
+    call silence_burst2i(800)
+  end do
+
+end program

SoundBrotching/genwaves.f90

@@ -11,12 +11,13 @@ program genwaves
   write(0, *) "*** Genwaves ***"
   call soundbrotch_version()
 
-  do clock = 1, 8
+  do clock = 1, 11
     fleft  = real(100 * clock)
-    fright = real(150 * clock)
+    fright = real(116 * clock)
     write(0, '(1X,I8, 9X, F8.2, 6X, F8.2)') clock, fleft, fright
-    call sinw_burst2i(6, 4800, fleft, fright, 0.7)
+    call sinw_burst2i(6, 23200, fleft, fright, 0.7)
   enddo
+  call silence_burst2i(1337)
 
 end program
 

SoundBrotching/panoramix.f90

@@ -21,11 +21,11 @@ program panoramix
     endif
 
     !  *** NON WORKING CODE ***
-    phi   = real(nblus) / 60000.0
+    phi   = real(nblus) / 44100.0
     ka    = sin(phi)
     value = (real(left)+real(right)) / 2.05
-    left  = int(value*ka)
-    right = int(value*(1.0-ka))
+    left  = int(value * ka)
+    right = int(value * (1.0-ka))
 
     print *, left, right
 

SoundBrotching/soundbrotch.f90

@@ -7,12 +7,19 @@ module soundbrotch
     integer             :: right
   end type
   ! ---------------------------------------------------------
+  !      some private variables
+  
+  integer, private               :: samplerate    = 48000
+  real, private                  :: diapason      = 440.0
   contains
   ! ---------------------------------------------------------
-
   subroutine soundbrotch_version ()
     write(0, '(1X,A)') "--- this is soundbrotch version alpha 666"
+    write(0, *) "--- samplerate", samplerate
+    write(0, *) "--- diapason  ", diapason
   end subroutine
+  ! ---------------------------------------------------------
+  ! ---------------------------------------------------------
 
   ! ---------------------------------------------------------
   !        premier essai, le prototype peut changer !
@@ -25,31 +32,55 @@ module soundbrotch
 
     integer                    :: idx, left, right
     real                       :: coef
-    integer, save              :: oldl=0, oldr=0
 
-    coef = (3.141592654 * 2.0) / 44.1e3
+    if (dst .NE. 6) then
+      STOP '   OUPS!'
+    endif
+
+    coef = (3.141592654 * 2.0) / real(samplerate)
     do idx=0, numbs
       left  = INT(32e3 * level * sin(coef*real(idx)*fra))
-      left  = (left  + oldl) / 2
       right = INT(32e3 * level * sin(coef*real(idx)*frb))
-      right = (right + oldr) / 2
-      print *, left, right
-      oldl  = left
-      oldr  = right
-    enddo
-    ! add silence at the end of the burst
-    left  = 0
-    right = 0
-    do idx=0, numbs/3
-      left  = (left  + oldl) / 2
-      right = (right + oldr) / 2
-      print *, 0, 0
-      oldl  = left
-      oldr  = right
+      call xper_spit_2i(left, right)
     enddo
 
   end subroutine
   ! ---------------------------------------------------------
+  !        mmmm ?
+  subroutine silence_burst2i(nbsmpl)
+    integer, intent(in)     :: nbsmpl
+    integer                 :: idx
+    do idx=0, nbsmpl
+      call xper_spit_2i(0, 0)
+    enddo
+  end subroutine
+  ! ---------------------------------------------------------
+  !        mmmm ?
+  subroutine xper_spit_2i(lsmpl, rsmpl)
+    integer, intent(in)     :: lsmpl, rsmpl
+    integer, save           :: oldl, oldr
+    integer                 :: tmpl, tmpr
 
+    tmpl = (lsmpl + oldl) / 2
+    tmpr = (rsmpl + oldr) / 2
+    print *, tmpl, tmpr
+    oldl = tmpl
+    oldr = tmpr
+
+  end subroutine
+  ! ---------------------------------------------------------
+  ! 
+  function midi2freq(note)
+    integer, intent(in)    :: note
+    real                   :: midi2freq
+
+    real                   :: freq
+
+    freq = (DIAPASON/32.0) * (2.0 ** (real(note - 9) / 12.0));
+    ! write(0, *) "> ", note, freq
+
+    midi2freq = freq
+
+  end function
 end module