winter is coming
This commit is contained in:
parent
098b12cd61
commit
462d24b717
|
@ -1,46 +1,92 @@
|
|||
program essai
|
||||
use usegenplot
|
||||
|
||||
use pixrgb
|
||||
implicit none
|
||||
|
||||
integer :: foo, bar
|
||||
integer :: nbarg
|
||||
integer :: numframe = 0
|
||||
integer :: param0 = 10
|
||||
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()
|
||||
if (nbarg .GT. 0) then
|
||||
call GETARG(1, arg)
|
||||
! write (0, '(A40, A5)') "argument = ", arg
|
||||
read (arg, *) numframe
|
||||
read (arg, *) param0
|
||||
endif
|
||||
|
||||
write(0, '(A20, I5)') "frame number =", numframe
|
||||
allocate(pix(width, height))
|
||||
|
||||
call init_genplot("essai.genplot")
|
||||
call do_frame(7)
|
||||
do seqnum = 0, param0
|
||||
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
|
||||
do foo=20, 620, 50
|
||||
call gplt_line(foo, 20, bar, 460)
|
||||
call gplt_line(bar, 20, foo, 460)
|
||||
write (filename, "(a, i5.5, a)") "./F/np/", seqnum, ".pnm"
|
||||
write(0, *) seqnum, kx, ky, trim(filename)
|
||||
call rgbpix_spit_as_pnm_16(pix, trim(filename))
|
||||
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)
|
||||
integer, intent(in) :: color
|
||||
integer :: savecol
|
||||
ix = 600 - int (300.0 * x)
|
||||
iy = 600 - int (300.0 * y)
|
||||
|
||||
savecol = gplt_getcol()
|
||||
call gplt_setcol(color)
|
||||
call gplt_rect(0, 0, 640, 480)
|
||||
call gplt_setcol(savecol)
|
||||
! print *, ix, iy
|
||||
|
||||
if ( (ix .gt. lbound(pic, 1)) .and. (ix .lt. ubound(pic, 1)) &
|
||||
.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
|
||||
|
||||
|
|
|
@ -8,7 +8,7 @@ GFOPT = -Wall -Wextra -g -I.
|
|||
|
||||
all: chkpixels trnd t
|
||||
|
||||
# -----------------------------------------------
|
||||
# ---------------------------------------------------------
|
||||
|
||||
spitpgm.o: spitpgm.f90 Makefile
|
||||
gfortran $(GFOPT) -c $<
|
||||
|
@ -31,8 +31,7 @@ mathstuff2.o: mathstuff2.f90 Makefile
|
|||
noisepictures.o: noisepictures.f90 Makefile
|
||||
gfortran $(GFOPT) -c $<
|
||||
|
||||
|
||||
#
|
||||
#----------------------------------------------------------
|
||||
# making a fluffy archive
|
||||
#
|
||||
OBJECTS = spitpgm.o pixrgb.o \
|
||||
|
@ -43,7 +42,7 @@ OBJECTS = spitpgm.o pixrgb.o \
|
|||
libtth90modules.a: $(OBJECTS) Makefile
|
||||
$(AR) rs $@ $?
|
||||
|
||||
#
|
||||
#----------------------------------------------------------
|
||||
# programmes de testouille
|
||||
#
|
||||
|
||||
|
|
|
@ -85,20 +85,23 @@ subroutine noise_range_rgb16_pic(prgb, rngs, nbre)
|
|||
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
|
||||
integer, intent(in) :: rngs(6)
|
||||
integer, intent(in) :: nbre
|
||||
integer :: quux, ix, iy, width, height
|
||||
integer :: foo, ix, iy
|
||||
|
||||
print *, 'noise rgb16 range', nbre
|
||||
print *, 'ranges:'
|
||||
print *, rngs
|
||||
! print *, 'noise rgb16 range', nbre
|
||||
! print *, 'rngs', 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(), width )
|
||||
iy = 1 + mod ( irand(), height )
|
||||
prgb(ix, iy)%r = mod ( irand(), 65536 )
|
||||
prgb(ix, iy)%g = mod ( irand(), 65536 )
|
||||
prgb(ix, iy)%b = mod ( irand(), 65536 )
|
||||
ix = 1 + mod ( irand(), ubound(prgb, 1) )
|
||||
iy = 1 + mod ( irand(), ubound(prgb, 2) )
|
||||
prgb(ix, iy)%g = rngs(3) + mod(irand(), rngs(4) - rngs(3))
|
||||
|
||||
ix = 1 + mod ( irand(), ubound(prgb, 1) )
|
||||
iy = 1 + mod ( irand(), ubound(prgb, 2) )
|
||||
prgb(ix, iy)%b = rngs(5) + mod(irand(), rngs(6) - rngs(5))
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
|
|
|
@ -11,9 +11,9 @@ program essai
|
|||
write(0, *) "----------------- essai -------------------"
|
||||
|
||||
call init_random_seed() ! in module 'mathstuff'
|
||||
call test_noisepictures_rgb()
|
||||
! call test_noisepictures_rgb()
|
||||
call test_noisepictures_rgb_range()
|
||||
call test_noisepictures_gray()
|
||||
! call test_noisepictures_gray()
|
||||
|
||||
contains
|
||||
!-----------------------------------------------------------------------
|
||||
|
|
Loading…
Reference in New Issue