Fortraneries/GrafAnim/trigofest.f90

129 lines
3.3 KiB
Fortran
Raw Normal View History

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