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.01 do loop=0, 359 call spirale(picz, blouber, loop*9) blouber = blouber * 1.0259 write (filename, "(a, i5.5, a)") "F/spi/", loop, ".pgm" call spit_as_pgm_8(picz, trim(filename)) print *, loop, blouber enddo 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 premirere 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 = sin(angle*2) rx = radius * kx ! ry = radius * cos(angle) ky = cos(angle) + (0.5*cos(angle*4.0)) ry = radius * ky radius = radius + 0.025 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