winter is coming

GrafAnim/.gitignore

@@ -12,4 +12,6 @@ F/*.tga
 *.gif
 *.pnm
 *.pgm
+*.data
+*.png
 

GrafAnim/Makefile

@@ -3,26 +3,25 @@
 #
 
 GFOPT = -Wall -Wextra -g -time  -I../Modules
+MYLIB = '../Modules/libtth90modules.a'
 
 # ---- programmes
 
-essai:	essai.f90 usegenplot.o Makefile
-	gfortran $(GFOPT) $< usegenplot.o -o $@
+essai:	essai.f90 Makefile
+	gfortran $(GFOPT) $< $(MYLIB) -o $@
 
 doubledice:	doubledice.f90 Makefile	\
 		utils_ga.o usegenplot.o
 	gfortran $(GFOPT) $< usegenplot.o utils_ga.o -o $@
 
 doublegauss:	doublegauss.f90 Makefile utils_ga.o
-	gfortran $(GFOPT) $<  ../Modules/pixrgb.o  utils_ga.o -o $@
+	gfortran $(GFOPT) $<  $(MYLIB)  utils_ga.o -o $@
 
 trigofest:	trigofest.f90 Makefile vue3axes.o utils_ga.o
-	gfortran $(GFOPT) $<  ../Modules/pixrgb.o  ../Modules/spitpgm.o \
-			utils_ga.o -o $@
+	gfortran $(GFOPT) $<  $(MYLIB) utils_ga.o -o $@
 
 noisepic:	noisepic.f90  Makefile
-	gfortran $(GFOPT) $< ../Modules/spitpgm.o ../Modules/pixrgb.o	\
-				../Modules/noisepictures.o		\
+	gfortran $(GFOPT) $< $(MYLIB)			\
 		-o $@
 
 # ---- modules locaux

GrafAnim/essai.f90

@@ -1,46 +1,92 @@
 program essai
-  use usegenplot
+
+  use pixrgb
   implicit none
 
-  integer                   :: foo, bar
   integer                   :: nbarg
-  integer                   :: numframe = 0
+  integer                   :: param0 = 10
   character(len=256)        :: arg
 
-  ! write(0, *)   "------------ essai graf anim ---------------"
+  ! integer                   :: foo, bar
+
+  integer                   :: width  = 512
+  integer                   :: height = 342
+  integer                   :: seqnum
+  real                      :: nclock, kx, ky
+  character (len=280)       :: filename
+
+  type(t_pixrgb), allocatable      :: pix(:,:)
+
+  write(0, *)   "--------- essai FLUFFYWAVES ------------"
 
   nbarg = IARGC()
   if (nbarg .GT. 0) then
        call GETARG(1, arg)
        ! write (0, '(A40, A5)') "argument = ",  arg
-       read (arg, *) numframe
+       read (arg, *) param0
   endif
 
-  write(0, '(A20, I5)')  "frame number =", numframe
+  allocate(pix(width, height))
 
-  call init_genplot("essai.genplot")
-  call do_frame(7)
+  do seqnum = 0, param0
+    nclock = float(seqnum) / float(param0)
+    call rgbpix_set_to_rgb(pix, 0, 0, 0)
 
-  call gplt_setcol(2)
+    kx = nclock * 0.35 * sin(nclock * 7.0)
+    ky = nclock * 0.95 * cos(nclock * 7.0)
+    call iterator (pix, kx, ky, 50000)
 
-  bar = (numframe * 20) - 120
-  do foo=20, 620, 50
-    call gplt_line(foo, 20, bar, 460)
-    call gplt_line(bar, 20, foo, 460)
+    write (filename, "(a, i5.5, a)") "./F/np/", seqnum, ".pnm"
+    write(0, *)  seqnum, kx, ky, trim(filename)
+    call rgbpix_spit_as_pnm_16(pix, trim(filename))
   enddo
 
-  call end_genplot("done for today")
+contains
+! ----------------------------------------------------------
+!-
+subroutine setpixel(pic, x, y)
+  implicit none
+  type(t_pixrgb), intent(inout)   :: pic(:,:)
+  real, intent(in)                :: x, y 
 
-contains        !------------------------------------------
+  integer                         :: ix, iy
 
-subroutine do_frame(color)
-  integer, intent(in)           :: color
-  integer                       :: savecol
+  ix = 600 - int (300.0 * x)
+  iy = 600 - int (300.0 * y)
 
-  savecol = gplt_getcol()
-  call gplt_setcol(color)
-  call gplt_rect(0, 0, 640, 480)
-  call gplt_setcol(savecol)
+  ! print *, ix, iy
+
+  if ( (ix .gt. lbound(pic, 1)) .and. (ix .lt. ubound(pic, 1))    &
+               .and.                                              &
+       (iy .gt. lbound(pic, 2)) .and. (iy .lt. ubound(pic, 2)) )  &
+  then
+     pic(ix, iy)%g = 65000
+     pic(ix, iy)%b = 20000
+  else
+     ! XXX write(0, *) 'out', ix, iy
+  endif
+
+end subroutine
+
+! ----------------------------------------------------------
+!-
+subroutine iterator(img, x0, y0, nbi)
+  implicit none
+  type(t_pixrgb), intent(inout)   :: img(:,:)
+  real, intent(in)                :: x0, y0
+  integer, intent(in)             :: nbi
+  real                            :: xa, ya, xb, yb
+  integer                         :: bcl
+
+  xa = x0      ;     ya = y0
+
+  do bcl=0, nbi
+    xb = xa - 0.4 * sin ( ya + sin( 0.4 * ya ) )
+    yb = ya - 0.4 * sin ( xa + sin(  -2 * xa ) )
+    call setpixel(img, xb, yb)
+    xa = xb
+    ya = yb
+  enddo
 
 end subroutine
 

GrafAnim/noisepic.f90

@@ -3,13 +3,15 @@ program noisepic
   use spitpgm
   use pixrgb
   use noisepictures
+  use mathstuff2
   implicit none
 
   integer                   :: numframe = 0
 
-  integer                   :: nbarg, nbre
+  integer                   :: nbarg
   character(len=256)        :: arg
   integer                   :: ranges(6)
+  real                      :: fclock, kpi, r1, r3, r5
 
   nbarg = IARGC()
   if (nbarg .GT. 0) then
@@ -18,134 +20,48 @@ program noisepic
        read (arg, *) numframe
   endif
 
-  ranges(1) = 10    ;    ranges(2) = 90
-  ranges(3) = 110   ;    ranges(4) = 166
-  ranges(5) = 205   ;    ranges(6) = 230
-  nbre = 1000+(numframe*555)
-  call make_noise_bw_pic (numframe)
+  call init_random_seed()
+
+  kpi = 3.151592654 / 3.0
+
+  do numframe = 0, 479
+    fclock = kpi * float(numframe) / 480.0
+    r1 = 27000 + 20000 * cos(fclock*26)
+    ranges(1) = nint(r1)    ; ranges(2) = ranges(1)+300
+
+    r3 = 32000 + 28000 * cos(fclock*29)
+    ranges(3) = nint(r3)    ; ranges(4) = ranges(3)+300
+
+    r5 = 29000 + 23000 * cos(fclock*32)
+    ranges(5) = nint(r5)    ; ranges(6) = ranges(5)+300
+
+    print *, 'r123', numframe, fclock, r1, r3, r5
+
+    call make_noise_color_range_pic (numframe, ranges, 29000)
+  enddo
 
 contains
 !-- ------------------------------------------------------------------
-!-
-!-	Black & White
-!-
-subroutine make_noise_bw_pic (value)
-  implicit none
-  integer, intent(in)        :: value
-
-  integer                               :: foo
-  integer, dimension(:,:), allocatable  ::  pic
-  character (len=280)                   ::    filename
-
-  allocate(pic(320, 240))
-
-  pic = 30                   !- clear the picz
-
-  call srand(value+34)
-  foo = irand()
-  print *, 'val=', value, '       rnd=', foo
-
-  ! call plot_noise_bw_pic(pic, 15000)
-  call noise_gray8_pic(pic, 15000)
-
-  write (filename, "(a, i5.5, a)") "", value, ".pgm"
-  call spit_as_pgm_8(pic, trim(filename))
-end subroutine
+!--
 !-- ------------------------------------------------------------------
-!-- ------------------------------------------------------------------
-!-
-!-	Colorized
-!-
-subroutine make_noise_color_pic (value)
+subroutine make_noise_color_range_pic (seqv, rngs, nbre)
   implicit none
-  integer, intent(in)        :: value
-
-  integer                               :: foo
-  type(t_pixrgb), dimension(:,:), allocatable :: pix
-  character (len=280)                   ::    filename
-
-  allocate(pix(320, 240))
-  call rgbpix_set_to_rgb(pix, 30, 30, 60)
-
-  call srand(value+34)
-  foo = irand()
-  print *, 'val=', value, '       rnd=', foo
-
-  call plot_noise_color_pic(pix, 15000)
-
-  write (filename, "(a, i5.5, a)") "./", value, ".pnm"
-  call rgbpix_spit_as_pnm_8(pix, trim(filename))
-
-end subroutine
-!-- ------------------------------------------------------------------
-
-subroutine plot_noise_color_pic(prgb, nbre)
-  implicit none
-  type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
-  integer, intent(in)                           :: nbre
-  integer :: quux, ix, iy, width, height
-
-  width = ubound(prgb, 1)  ;  height = ubound(prgb, 2)
-
-  do quux=1, nbre
-    ix = 1 + mod ( irand(), width )
-    iy = 1 + mod ( irand(), height )
-    prgb(ix, iy)%r = 64 + mod ( irand(), 127 )
-    prgb(ix, iy)%g = 64 + mod ( irand(), 127 )
-    prgb(ix, iy)%b = 64 + mod ( irand(), 127 )
-
-  enddo
-
-end subroutine
-!-- ------------------------------------------------------------------
-!-
-!-	Colorized with range
-!-
-subroutine plot_noise_color_range_pic(prgb, nbre)
-  implicit none
-  type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
-  integer, intent(in)                           :: nbre
-  integer :: quux, ix, iy, width, height
-
-  width = ubound(prgb, 1)  ;  height = ubound(prgb, 2)
-
-  do quux=1, nbre
-    ix = 1 + mod ( irand(), width )
-    iy = 1 + mod ( irand(), height )
-    prgb(ix, iy)%r = 64 + mod ( irand(), 127 )
-    prgb(ix, iy)%g = 64 + mod ( irand(), 127 )
-    prgb(ix, iy)%b = 64 + mod ( irand(), 127 )
-  enddo
-
-end subroutine
-!-- ------------------------------------------------------------------
-
-subroutine make_noise_color_range_pic (value, rngs, nbre)
-  implicit none
-  integer, intent(in)        :: value, nbre
+  integer, intent(in)        :: seqv, nbre
   integer, intent(in)        :: rngs(6)
 
-  integer                          :: foo
   type(t_pixrgb), allocatable      :: pix(:,:)
   character (len=280)              :: filename
 
-  allocate(pix(320, 240))
+  allocate(pix(640, 480))
   call rgbpix_set_to_rgb(pix, 0, 0, 0)
 
-  call srand(value+34)
-  foo = irand()
-  print *, 'color_range: val=', value, 'rnd=', foo, 'nbre=', nbre
+  write (filename, "(a, i5.5, a)") "./F/np/", seqv, ".pnm"
+  ! print *, 'filename: ', trim(filename)
 
-  write (filename, "(a, i5.5, a)") "./F/np/", value, ".pnm"
-  print *, 'filename: ', trim(filename)
-
-  call plot_noise_color_range_pic(pix, nbre)
-
-  call rgbpix_spit_as_pnm_8(pix, trim(filename))
+  call noise_range_rgb16_pic(pix, rngs, nbre)
+  call rgbpix_spit_as_pnm_16(pix, trim(filename))
 
   deallocate(pix)
-
 end subroutine
-
 !-- ------------------------------------------------------------------
 end program

Modules/Makefile

@@ -6,9 +6,9 @@
 
 GFOPT  =  -Wall -Wextra -g -I.
 
-all:	chkpixels t
+all:	chkpixels trnd    t
 
-# -----------------------------------------------
+# ---------------------------------------------------------
 
 spitpgm.o:		spitpgm.f90 Makefile
 	gfortran $(GFOPT) -c $<
@@ -31,8 +31,7 @@ mathstuff2.o:	mathstuff2.f90 Makefile
 noisepictures.o:	noisepictures.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-
-#
+#----------------------------------------------------------
 #	making a fluffy archive
 #
 OBJECTS =	spitpgm.o		pixrgb.o	\
@@ -43,7 +42,7 @@ OBJECTS =	spitpgm.o		pixrgb.o	\
 libtth90modules.a:	$(OBJECTS) Makefile
 	$(AR) 	rs $@ $?
 
-#
+#----------------------------------------------------------
 #     programmes de testouille
 #
 

Modules/noisepictures.f90

@@ -75,6 +75,35 @@ subroutine noise_rgb16_pic(prgb, nbre)
     prgb(ix, iy)%b = mod ( irand(), 65536 )
   enddo
 
+end subroutine
+!-----------------------------------------------------------------------
+! new: Sat Jun 10 06:50:51 UTC 2023
+
+subroutine noise_range_rgb16_pic(prgb, rngs, nbre)
+  implicit none
+
+  type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
+  integer, intent(in)                           :: rngs(6)
+  integer, intent(in)                           :: nbre
+  integer                                       :: foo, ix, iy
+
+  ! print *, 'noise rgb16 range', nbre
+  ! print *, 'rngs', rngs
+
+  do foo = 1, nbre
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
+    prgb(ix, iy)%r = rngs(1) + mod(irand(), rngs(2) - rngs(1))
+
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
+    prgb(ix, iy)%g = rngs(3) + mod(irand(), rngs(4) - rngs(3))
+
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
+    prgb(ix, iy)%b = rngs(5) + mod(irand(), rngs(6) - rngs(5))
+  enddo
+
 end subroutine
 !-----------------------------------------------------------------------
 end module noisepictures

Modules/trnd.f90

@@ -6,13 +6,14 @@ program essai
   use noisepictures
   implicit none
 
-  integer                     :: foo, bar
+  ! integer                     :: foo, bar
 
   write(0, *)   "----------------- essai -------------------"
 
   call init_random_seed()           ! in module 'mathstuff'
-  call test_noisepictures_rgb()
-  call test_noisepictures_gray()
+  ! call test_noisepictures_rgb()
+  call test_noisepictures_rgb_range()
+  ! call test_noisepictures_gray()
 
 contains
 !-----------------------------------------------------------------------
@@ -37,6 +38,32 @@ subroutine test_noisepictures_rgb ()
 
   deallocate (pix)
 
+end subroutine
+!-----------------------------------------------------------------------
+! new: Sat Jun 10 06:50:51 UTC 2023
+
+subroutine test_noisepictures_rgb_range ()
+  implicit none
+
+  type(t_pixrgb), allocatable       :: pix (:,:)
+  integer                           :: nombre
+  integer                           :: ranges(6)
+
+  print *, '------ test des noisepictures RGB range'
+
+  allocate(pix(800, 600))
+  nombre = (800*600)/4
+
+  call rgbpix_set_to_rgb(pix, 0, 0, 0)
+  ranges(1) = 0           ;    ranges(2) = 21000
+  ranges(3) = 22000       ;    ranges(4) = 43000
+  ranges(5) = 44400       ;    ranges(6) = 63000
+
+  call noise_range_rgb16_pic(pix, ranges, nombre)
+  call rgbpix_spit_as_pnm_16(pix, 'rngs16.pnm')
+
+  deallocate (pix)
+
 end subroutine
 !-----------------------------------------------------------------------
 subroutine test_noisepictures_gray ()