Fortraneries/GrafAnim/essai.f90

program essai

  use pixrgb
  implicit none

  integer                   :: nbarg
  integer                   :: param0 = 10
  character(len=256)        :: arg

  ! 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, *) param0
  endif

  allocate(pix(width, height))

  do seqnum = 0, param0
    nclock = float(seqnum) / float(param0)
    call rgbpix_set_to_rgb(pix, 0, 0, 0)

    kx = nclock * 0.35 * sin(nclock * 7.0)
    ky = nclock * 0.95 * cos(nclock * 7.0)
    call iterator (pix, kx, ky, 50000)

    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

contains
! ----------------------------------------------------------
!-
subroutine setpixel(pic, x, y)
  implicit none
  type(t_pixrgb), intent(inout)   :: pic(:,:)
  real, intent(in)                :: x, y 

  integer                         :: ix, iy

  ix = 600 - int (300.0 * x)
  iy = 600 - int (300.0 * y)

  ! 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

end program