winter is coming

This commit is contained in:
tTh 2023-10-10 22:08:50 +02:00
parent 098b12cd61
commit 462d24b717
4 changed files with 87 additions and 39 deletions

View File

@ -1,46 +1,92 @@
program essai program essai
use usegenplot
use pixrgb
implicit none implicit none
integer :: foo, bar
integer :: nbarg integer :: nbarg
integer :: numframe = 0 integer :: param0 = 10
character(len=256) :: arg character(len=256) :: arg
! write(0, *) "------------ essai graf anim ---------------" ! 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() nbarg = IARGC()
if (nbarg .GT. 0) then if (nbarg .GT. 0) then
call GETARG(1, arg) call GETARG(1, arg)
! write (0, '(A40, A5)') "argument = ", arg ! write (0, '(A40, A5)') "argument = ", arg
read (arg, *) numframe read (arg, *) param0
endif endif
write(0, '(A20, I5)') "frame number =", numframe allocate(pix(width, height))
call init_genplot("essai.genplot") do seqnum = 0, param0
call do_frame(7) nclock = float(seqnum) / float(param0)
call rgbpix_set_to_rgb(pix, 0, 0, 0)
call gplt_setcol(2) kx = nclock * 0.35 * sin(nclock * 7.0)
ky = nclock * 0.95 * cos(nclock * 7.0)
call iterator (pix, kx, ky, 50000)
bar = (numframe * 20) - 120 write (filename, "(a, i5.5, a)") "./F/np/", seqnum, ".pnm"
do foo=20, 620, 50 write(0, *) seqnum, kx, ky, trim(filename)
call gplt_line(foo, 20, bar, 460) call rgbpix_spit_as_pnm_16(pix, trim(filename))
call gplt_line(bar, 20, foo, 460)
enddo enddo
call end_genplot("done for today") contains
! ----------------------------------------------------------
!-
subroutine setpixel(pic, x, y)
implicit none
type(t_pixrgb), intent(inout) :: pic(:,:)
real, intent(in) :: x, y
contains !------------------------------------------ integer :: ix, iy
subroutine do_frame(color) ix = 600 - int (300.0 * x)
integer, intent(in) :: color iy = 600 - int (300.0 * y)
integer :: savecol
savecol = gplt_getcol() ! print *, ix, iy
call gplt_setcol(color)
call gplt_rect(0, 0, 640, 480) if ( (ix .gt. lbound(pic, 1)) .and. (ix .lt. ubound(pic, 1)) &
call gplt_setcol(savecol) .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 subroutine

View File

@ -8,7 +8,7 @@ GFOPT = -Wall -Wextra -g -I.
all: chkpixels trnd t all: chkpixels trnd t
# ----------------------------------------------- # ---------------------------------------------------------
spitpgm.o: spitpgm.f90 Makefile spitpgm.o: spitpgm.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
@ -31,8 +31,7 @@ mathstuff2.o: mathstuff2.f90 Makefile
noisepictures.o: noisepictures.f90 Makefile noisepictures.o: noisepictures.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
#----------------------------------------------------------
#
# making a fluffy archive # making a fluffy archive
# #
OBJECTS = spitpgm.o pixrgb.o \ OBJECTS = spitpgm.o pixrgb.o \
@ -43,7 +42,7 @@ OBJECTS = spitpgm.o pixrgb.o \
libtth90modules.a: $(OBJECTS) Makefile libtth90modules.a: $(OBJECTS) Makefile
$(AR) rs $@ $? $(AR) rs $@ $?
# #----------------------------------------------------------
# programmes de testouille # programmes de testouille
# #

View File

@ -85,20 +85,23 @@ subroutine noise_range_rgb16_pic(prgb, rngs, nbre)
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
integer, intent(in) :: rngs(6) integer, intent(in) :: rngs(6)
integer, intent(in) :: nbre integer, intent(in) :: nbre
integer :: quux, ix, iy, width, height integer :: foo, ix, iy
print *, 'noise rgb16 range', nbre ! print *, 'noise rgb16 range', nbre
print *, 'ranges:' ! print *, 'rngs', rngs
print *, rngs
width = ubound(prgb, 1) ; height = ubound(prgb, 2) do foo = 1, nbre
ix = 1 + mod ( irand(), ubound(prgb, 1) )
iy = 1 + mod ( irand(), ubound(prgb, 2) )
prgb(ix, iy)%r = rngs(1) + mod(irand(), rngs(2) - rngs(1))
do quux=1, nbre ix = 1 + mod ( irand(), ubound(prgb, 1) )
ix = 1 + mod ( irand(), width ) iy = 1 + mod ( irand(), ubound(prgb, 2) )
iy = 1 + mod ( irand(), height ) prgb(ix, iy)%g = rngs(3) + mod(irand(), rngs(4) - rngs(3))
prgb(ix, iy)%r = mod ( irand(), 65536 )
prgb(ix, iy)%g = mod ( irand(), 65536 ) ix = 1 + mod ( irand(), ubound(prgb, 1) )
prgb(ix, iy)%b = mod ( irand(), 65536 ) iy = 1 + mod ( irand(), ubound(prgb, 2) )
prgb(ix, iy)%b = rngs(5) + mod(irand(), rngs(6) - rngs(5))
enddo enddo
end subroutine end subroutine

View File

@ -11,9 +11,9 @@ program essai
write(0, *) "----------------- essai -------------------" write(0, *) "----------------- essai -------------------"
call init_random_seed() ! in module 'mathstuff' call init_random_seed() ! in module 'mathstuff'
call test_noisepictures_rgb() ! call test_noisepictures_rgb()
call test_noisepictures_rgb_range() call test_noisepictures_rgb_range()
call test_noisepictures_gray() ! call test_noisepictures_gray()
contains contains
!----------------------------------------------------------------------- !-----------------------------------------------------------------------