tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: tTh:462d24b717c4a5d1d8937573a12cdfd7fed2e53f
Branches Tags
tTh:master
..
compare: tTh:920a864b227a31bcbc4c07ec8c441b6b1de90a2e
Branches Tags
tTh:master

No commits in common. "462d24b717c4a5d1d8937573a12cdfd7fed2e53f" and "920a864b227a31bcbc4c07ec8c441b6b1de90a2e" have entirely different histories.
462d24b717 ... 920a864b22

7 changed files with 152 additions and 170 deletions
Show Stats Expand all files Collapse all files

2
GrafAnim/.gitignore vendored
View File

@ -12,6 +12,4 @@ F/*.tga
*.gif *.gif
*.pnm *.pnm
*.pgm *.pgm
*.data
*.png

13
GrafAnim/Makefile
View File

@ -3,25 +3,26 @@
# #
GFOPT = -Wall -Wextra -g -time -I../Modules GFOPT = -Wall -Wextra -g -time -I../Modules
MYLIB = '../Modules/libtth90modules.a'
# ---- programmes # ---- programmes
essai: essai.f90 Makefile essai: essai.f90 usegenplot.o Makefile
gfortran $(GFOPT) $< $(MYLIB) -o $@ gfortran $(GFOPT) $< usegenplot.o -o $@
doubledice: doubledice.f90 Makefile \ doubledice: doubledice.f90 Makefile \
utils_ga.o usegenplot.o utils_ga.o usegenplot.o
gfortran $(GFOPT) $< usegenplot.o utils_ga.o -o $@ gfortran $(GFOPT) $< usegenplot.o utils_ga.o -o $@
doublegauss: doublegauss.f90 Makefile utils_ga.o doublegauss: doublegauss.f90 Makefile utils_ga.o
gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@ gfortran $(GFOPT) $< ../Modules/pixrgb.o utils_ga.o -o $@
trigofest: trigofest.f90 Makefile vue3axes.o utils_ga.o trigofest: trigofest.f90 Makefile vue3axes.o utils_ga.o
gfortran $(GFOPT) $< $(MYLIB) utils_ga.o -o $@ gfortran $(GFOPT) $< ../Modules/pixrgb.o ../Modules/spitpgm.o \
utils_ga.o -o $@
noisepic: noisepic.f90 Makefile noisepic: noisepic.f90 Makefile
gfortran $(GFOPT) $< $(MYLIB) \ gfortran $(GFOPT) $< ../Modules/spitpgm.o ../Modules/pixrgb.o \
../Modules/noisepictures.o \
-o $@ -o $@
# ---- modules locaux # ---- modules locaux

90
GrafAnim/essai.f90
View File

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

146
GrafAnim/noisepic.f90
View File

@ -3,15 +3,13 @@ program noisepic
use spitpgm use spitpgm
use pixrgb use pixrgb
use noisepictures use noisepictures
use mathstuff2
implicit none implicit none
integer :: numframe = 0 integer :: numframe = 0
integer :: nbarg integer :: nbarg, nbre
character(len=256) :: arg character(len=256) :: arg
integer :: ranges(6) integer :: ranges(6)
real :: fclock, kpi, r1, r3, r5
nbarg = IARGC() nbarg = IARGC()
if (nbarg .GT. 0) then if (nbarg .GT. 0) then
@ -20,48 +18,134 @@ program noisepic
read (arg, *) numframe read (arg, *) numframe
endif endif
call init_random_seed() ranges(1) = 10 ; ranges(2) = 90
ranges(3) = 110 ; ranges(4) = 166
kpi = 3.151592654 / 3.0 ranges(5) = 205 ; ranges(6) = 230
nbre = 1000+(numframe*555)
do numframe = 0, 479 call make_noise_bw_pic (numframe)
fclock = kpi * float(numframe) / 480.0
r1 = 27000 + 20000 * cos(fclock*26)
ranges(1) = nint(r1) ; ranges(2) = ranges(1)+300
r3 = 32000 + 28000 * cos(fclock*29)
ranges(3) = nint(r3) ; ranges(4) = ranges(3)+300
r5 = 29000 + 23000 * cos(fclock*32)
ranges(5) = nint(r5) ; ranges(6) = ranges(5)+300
print *, 'r123', numframe, fclock, r1, r3, r5
call make_noise_color_range_pic (numframe, ranges, 29000)
enddo
contains contains
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------
!-- !-
!-- ------------------------------------------------------------------ !- Black & White
subroutine make_noise_color_range_pic (seqv, rngs, nbre) !-
subroutine make_noise_bw_pic (value)
implicit none implicit none
integer, intent(in) :: seqv, nbre integer, intent(in) :: value
integer :: foo
integer, dimension(:,:), allocatable :: pic
character (len=280) :: filename
allocate(pic(320, 240))
pic = 30 !- clear the picz
call srand(value+34)
foo = irand()
print *, 'val=', value, ' rnd=', foo
! call plot_noise_bw_pic(pic, 15000)
call noise_gray8_pic(pic, 15000)
write (filename, "(a, i5.5, a)") "", value, ".pgm"
call spit_as_pgm_8(pic, trim(filename))
end subroutine
!-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------
!-
!- Colorized
!-
subroutine make_noise_color_pic (value)
implicit none
integer, intent(in) :: value
integer :: foo
type(t_pixrgb), dimension(:,:), allocatable :: pix
character (len=280) :: filename
allocate(pix(320, 240))
call rgbpix_set_to_rgb(pix, 30, 30, 60)
call srand(value+34)
foo = irand()
print *, 'val=', value, ' rnd=', foo
call plot_noise_color_pic(pix, 15000)
write (filename, "(a, i5.5, a)") "./", value, ".pnm"
call rgbpix_spit_as_pnm_8(pix, trim(filename))
end subroutine
!-- ------------------------------------------------------------------
subroutine plot_noise_color_pic(prgb, nbre)
implicit none
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
integer, intent(in) :: nbre
integer :: quux, ix, iy, width, height
width = ubound(prgb, 1) ; height = ubound(prgb, 2)
do quux=1, nbre
ix = 1 + mod ( irand(), width )
iy = 1 + mod ( irand(), height )
prgb(ix, iy)%r = 64 + mod ( irand(), 127 )
prgb(ix, iy)%g = 64 + mod ( irand(), 127 )
prgb(ix, iy)%b = 64 + mod ( irand(), 127 )
enddo
end subroutine
!-- ------------------------------------------------------------------
!-
!- Colorized with range
!-
subroutine plot_noise_color_range_pic(prgb, nbre)
implicit none
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
integer, intent(in) :: nbre
integer :: quux, ix, iy, width, height
width = ubound(prgb, 1) ; height = ubound(prgb, 2)
do quux=1, nbre
ix = 1 + mod ( irand(), width )
iy = 1 + mod ( irand(), height )
prgb(ix, iy)%r = 64 + mod ( irand(), 127 )
prgb(ix, iy)%g = 64 + mod ( irand(), 127 )
prgb(ix, iy)%b = 64 + mod ( irand(), 127 )
enddo
end subroutine
!-- ------------------------------------------------------------------
subroutine make_noise_color_range_pic (value, rngs, nbre)
implicit none
integer, intent(in) :: value, nbre
integer, intent(in) :: rngs(6) integer, intent(in) :: rngs(6)
integer :: foo
type(t_pixrgb), allocatable :: pix(:,:) type(t_pixrgb), allocatable :: pix(:,:)
character (len=280) :: filename character (len=280) :: filename
allocate(pix(640, 480)) allocate(pix(320, 240))
call rgbpix_set_to_rgb(pix, 0, 0, 0) call rgbpix_set_to_rgb(pix, 0, 0, 0)
write (filename, "(a, i5.5, a)") "./F/np/", seqv, ".pnm" call srand(value+34)
! print *, 'filename: ', trim(filename) foo = irand()
print *, 'color_range: val=', value, 'rnd=', foo, 'nbre=', nbre
call noise_range_rgb16_pic(pix, rngs, nbre) write (filename, "(a, i5.5, a)") "./F/np/", value, ".pnm"
call rgbpix_spit_as_pnm_16(pix, trim(filename)) print *, 'filename: ', trim(filename)
call plot_noise_color_range_pic(pix, nbre)
call rgbpix_spit_as_pnm_8(pix, trim(filename))
deallocate(pix) deallocate(pix)
end subroutine end subroutine
!-- ------------------------------------------------------------------ !-- ------------------------------------------------------------------
end program end program

9
Modules/Makefile
View File

@ -6,9 +6,9 @@
GFOPT = -Wall -Wextra -g -I. GFOPT = -Wall -Wextra -g -I.
all: chkpixels trnd t all: chkpixels t
# --------------------------------------------------------- # -----------------------------------------------
spitpgm.o: spitpgm.f90 Makefile spitpgm.o: spitpgm.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<
@ -31,7 +31,8 @@ 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 \
@ -42,7 +43,7 @@ OBJECTS = spitpgm.o pixrgb.o \
libtth90modules.a: $(OBJECTS) Makefile libtth90modules.a: $(OBJECTS) Makefile
$(AR) rs $@ $? $(AR) rs $@ $?
#---------------------------------------------------------- #
# programmes de testouille # programmes de testouille
# #

29
Modules/noisepictures.f90
View File

@ -75,35 +75,6 @@ subroutine noise_rgb16_pic(prgb, nbre)
prgb(ix, iy)%b = mod ( irand(), 65536 ) prgb(ix, iy)%b = mod ( irand(), 65536 )
enddo enddo
end subroutine
!-----------------------------------------------------------------------
! new: Sat Jun 10 06:50:51 UTC 2023
subroutine noise_range_rgb16_pic(prgb, rngs, nbre)
implicit none
type(t_pixrgb), dimension(:,:), intent(inout) :: prgb
integer, intent(in) :: rngs(6)
integer, intent(in) :: nbre
integer :: foo, ix, iy
! print *, 'noise rgb16 range', nbre
! print *, 'rngs', rngs
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))
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 end subroutine
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
end module noisepictures end module noisepictures

33
Modules/trnd.f90
View File

@ -6,14 +6,13 @@ program essai
use noisepictures use noisepictures
implicit none implicit none
! integer :: foo, bar integer :: foo, bar
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_gray()
! call test_noisepictures_gray()
contains contains
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
@ -38,32 +37,6 @@ subroutine test_noisepictures_rgb ()
deallocate (pix) deallocate (pix)
end subroutine
!-----------------------------------------------------------------------
! new: Sat Jun 10 06:50:51 UTC 2023
subroutine test_noisepictures_rgb_range ()
implicit none
type(t_pixrgb), allocatable :: pix (:,:)
integer :: nombre
integer :: ranges(6)
print *, '------ test des noisepictures RGB range'
allocate(pix(800, 600))
nombre = (800*600)/4
call rgbpix_set_to_rgb(pix, 0, 0, 0)
ranges(1) = 0 ; ranges(2) = 21000
ranges(3) = 22000 ; ranges(4) = 43000
ranges(5) = 44400 ; ranges(6) = 63000
call noise_range_rgb16_pic(pix, ranges, nombre)
call rgbpix_spit_as_pnm_16(pix, 'rngs16.pnm')
deallocate (pix)
end subroutine end subroutine
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
subroutine test_noisepictures_gray () subroutine test_noisepictures_gray ()