diff --git a/GrafAnim/essai.f90 b/GrafAnim/essai.f90 index d761c4f..5c91bd7 100644 --- a/GrafAnim/essai.f90 +++ b/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 diff --git a/Modules/Makefile b/Modules/Makefile index 48c4d45..6c89703 100644 --- a/Modules/Makefile +++ b/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 # diff --git a/Modules/noisepictures.f90 b/Modules/noisepictures.f90 index 77fa8cc..48b4965 100644 --- a/Modules/noisepictures.f90 +++ b/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 *, 'ranges:' - print *, rngs + ! print *, 'noise rgb16 range', nbre + ! print *, 'rngs', 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(), width ) - iy = 1 + mod ( irand(), height ) - prgb(ix, iy)%r = mod ( irand(), 65536 ) - prgb(ix, iy)%g = mod ( irand(), 65536 ) - prgb(ix, iy)%b = mod ( irand(), 65536 ) + 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 diff --git a/Modules/trnd.f90 b/Modules/trnd.f90 index 28f9413..b049dc9 100644 --- a/Modules/trnd.f90 +++ b/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 !-----------------------------------------------------------------------