winter is coming

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")
+  do seqnum = 0, param0
-  call do_frame(7)
+    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
+    write (filename, "(a, i5.5, a)") "./F/np/", seqnum, ".pnm"
-  do foo=20, 620, 50
+    write(0, *)  seqnum, kx, ky, trim(filename)
-    call gplt_line(foo, 20, bar, 460)
+    call rgbpix_spit_as_pnm_16(pix, trim(filename))
-    call gplt_line(bar, 20, foo, 460)
   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)
+  ix = 600 - int (300.0 * x)
-  integer, intent(in)           :: color
+  iy = 600 - int (300.0 * y)
-  integer                       :: savecol
 
-  savecol = gplt_getcol()
+  ! print *, ix, iy
-  call gplt_setcol(color)
+
-  call gplt_rect(0, 0, 640, 480)
+  if ( (ix .gt. lbound(pic, 1)) .and. (ix .lt. ubound(pic, 1))    &
-  call gplt_setcol(savecol)
+               .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
 

Modules/Makefile

@@ -8,7 +8,7 @@ GFOPT  =  -Wall -Wextra -g -I.
 
 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

@@ -85,20 +85,23 @@ subroutine noise_range_rgb16_pic(prgb, rngs, nbre)
   type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
   integer, intent(in)                           :: rngs(6)
   integer, intent(in)                           :: nbre
-  integer :: quux, ix, iy, width, height
+  integer                                       :: foo, ix, iy
 
-  print *, 'noise rgb16 range', nbre
+  ! print *, 'noise rgb16 range', nbre
-  print *, 'ranges:'
+  ! print *, 'rngs', rngs
-  print *, rngs
 
-  width = ubound(prgb, 1)  ;  height = ubound(prgb, 2)
+  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))
 
-  do quux=1, nbre
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
-    ix = 1 + mod ( irand(), width )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
-    iy = 1 + mod ( irand(), height )
+    prgb(ix, iy)%g = rngs(3) + mod(irand(), rngs(4) - rngs(3))
-    prgb(ix, iy)%r = mod ( irand(), 65536 )
+
-    prgb(ix, iy)%g = mod ( irand(), 65536 )
+    ix = 1 + mod ( irand(), ubound(prgb, 1) )
-    prgb(ix, iy)%b = mod ( irand(), 65536 )
+    iy = 1 + mod ( irand(), ubound(prgb, 2) )
+    prgb(ix, iy)%b = rngs(5) + mod(irand(), rngs(6) - rngs(5))
   enddo
 
 end subroutine

Modules/trnd.f90

@@ -11,9 +11,9 @@ program essai
   write(0, *)   "----------------- essai -------------------"
 
   call init_random_seed()           ! in module 'mathstuff'
-  call test_noisepictures_rgb()
+  ! call test_noisepictures_rgb()
   call test_noisepictures_rgb_range()
-  call test_noisepictures_gray()
+  ! call test_noisepictures_gray()
 
 contains
 !-----------------------------------------------------------------------