program trigofest

!-
!      ces divagations me viennent de superbes codes en Processing
!      allez visiter https://bleuje.com/tutorial1/ c'est d'la balle
!-

  use      spitpgm            ! in ../Modules 
  implicit none

  integer, dimension(:,:), allocatable    ::  picz
  integer                                 ::  W, H
  integer                                 ::  errcode
  integer                                 ::  loop
  character(200)                          ::  filename
  real                                    ::  blouber
!-------------------------------------------------------------

  W = 512     ;       H = 342
  allocate(picz(W,H), stat=errcode)

  blouber = 0.1
  do loop=0, 359
    call spirale(picz, blouber, loop*9)
    blouber = blouber + 0.3333
    write (filename, "(a, i5.5, a)") "F/spi/", loop, ".pgm"
    call spit_as_pgm_8(picz, trim(filename))
    print *, loop, blouber
  enddo

  deallocate(picz)

  STOP ': WORLD FINISHED'

contains        !------------------------------------------
!-------------------------------------------------------------
!       Lowlevel functions
!       ------------------

subroutine plot_a_dot(pic, ix, iy, val)
  implicit none
  integer, dimension(:,:), intent(out)   :: pic
  integer, intent(in)                    :: ix, iy, val

  integer             :: lx, ly, ux, uy

  lx = lbound(pic, 1)     ;     ux = ubound(pic, 1)
  ly = lbound(pic, 2)     ;     uy = ubound(pic, 2)

  ! write(0, *) 'plot dot ' , ix, iy
  ! write(0, *) '  X size ' , lx, ux
  ! write(0, *) '  Y size ' , ly, uy

  if ( ix .LT. lx ) then
    ! write(0, *) 'UNDER, IX', ix, 'LX', lx
    ! STOP ': UNDER ZERO'
    return
  endif
  if ( ix .GT. ux )  then
    ! write(0, *) 'OVER, IX',  ix, 'UX', ux
    ! STOP ': OVER9000 '
    return
  endif

  if ( iy .LT. ly ) then
    ! write(0, *) 'UNDER, IY', iy, 'LY', ly
    ! STOP ': UNDER ZERO'
    return
  endif
  if ( iy .GT. uy )  then
    ! write(0, *) 'OVER, IY',  iy, 'UY', uy
    ! STOP ': OVER9000 '
    return
  endif

  if ( (val .LT. 0) .OR. (val .GT. 255) ) then
    write(0, *) 'VAL = ', val
    STOP ': BAD PIXEL VALUE'
  endif

  pic(ix, iy) = val

end subroutine

!-------------------------------------------------------------
!            La premiere spirale
!            -------------------

subroutine spirale(pic, inirad, param)
  implicit none
  integer, dimension(:,:), intent(out)   :: pic
  real, intent(in)                       :: inirad
  integer, intent(in)                    :: param

  real                                   ::    angle, radius, rx, ry
  real                                   ::    kx, ky
  integer                                ::    foo, ix, iy

  pic = 0        ! clear the picture

  radius = inirad

  do foo=0, 360*15
    angle = real(foo) * 0.01745329252

    ! rx = radius * sin(angle) * 1.21
    kx = 1.55 * sin(angle+(0.04*radius))
    rx = radius * kx

    ! ry = radius * cos(angle)
    ky = cos(angle) + (0.5*cos(angle*6.0))
    ry = radius * ky
    radius = radius + 0.0245
    ix = int(rx) + W/2
    iy = int(ry) + H/2

    ! print *, foo, ix, iy
    call plot_a_dot(picz, ix, iy, 255-mod(foo+param, 255));

  enddo

end subroutine

!-------------------------------------------------------------
!-------------------------------------------------------------

end program