2023-02-11 15:31:21 +01:00
|
|
|
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)
|
|
|
|
|
|
2023-02-11 16:54:55 +01:00
|
|
|
blouber = 0.1
|
2023-02-11 15:31:21 +01:00
|
|
|
do loop=0, 359
|
|
|
|
|
call spirale(picz, blouber, loop*9)
|
2023-02-11 16:54:55 +01:00
|
|
|
blouber = blouber + 0.3333
|
2023-02-11 15:31:21 +01:00
|
|
|
write (filename, "(a, i5.5, a)") "F/spi/", loop, ".pgm"
|
|
|
|
|
call spit_as_pgm_8(picz, trim(filename))
|
|
|
|
|
print *, loop, blouber
|
|
|
|
|
enddo
|
|
|
|
|
|
2023-02-11 16:54:55 +01:00
|
|
|
deallocate(picz)
|
|
|
|
|
|
2023-02-11 15:31:21 +01:00
|
|
|
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
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------
|
2023-05-07 08:53:58 +02:00
|
|
|
! La premiere spirale
|
|
|
|
|
! -------------------
|
2023-02-11 15:31:21 +01:00
|
|
|
|
|
|
|
|
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
|
2023-02-11 16:54:55 +01:00
|
|
|
kx = 1.55 * sin(angle+(0.04*radius))
|
2023-02-11 15:31:21 +01:00
|
|
|
rx = radius * kx
|
|
|
|
|
|
|
|
|
|
! ry = radius * cos(angle)
|
2023-02-11 16:54:55 +01:00
|
|
|
ky = cos(angle) + (0.5*cos(angle*6.0))
|
2023-02-11 15:31:21 +01:00
|
|
|
ry = radius * ky
|
2023-02-11 16:54:55 +01:00
|
|
|
radius = radius + 0.0245
|
2023-02-11 15:31:21 +01:00
|
|
|
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
|
|
|
|
|
|
