minor changes also here

This commit is contained in:
tTh 2023-02-11 20:29:07 +01:00
parent c05d80a223
commit 87ff3d8815
7 changed files with 193 additions and 8 deletions

View File

@ -13,6 +13,8 @@ un peu foireux sur les tracés de ligne...
Distorsions approximatives de la courbe de Lissajous. Distorsions approximatives de la courbe de Lissajous.
Expériences inspirées par https://bleuje.com/tutorial1/ que c'est d'la balle !
## doubledice ## doubledice
Ou comment dessiner des gaussiennes. Ou comment dessiner des gaussiennes.

View File

@ -1,9 +1,61 @@
program doubledice program doubledice
use usegenplot use usegenplot
use utils_ga
implicit none implicit none
call init_genplot("essai.genplot") integer :: nbarg, numframe
character(len=256) :: arg
integer :: idx, foo, bar, xpos
integer :: buckets(12)
call end_genplot("OK boomer") nbarg = IARGC()
if (nbarg .GT. 0) then
call GETARG(1, arg)
! write (0, '(A40, A5)') "argument = ", arg
read (arg, *) numframe
endif
write(0, '(" ------------- DOUBLE DICE ----------")')
write(0, '(" --> frame number:", I5)') numframe
call init_genplot("dummy.genplot")
call gplt_rect(0, 0, 800, 600)
call gplt_setcol(3)
call gplt_rect(8, 8, 48, 38)
call gplt_setcol(2)
buckets = 0
do idx=1, numframe
call jouer_un_tour(buckets, idx)
foo = maxval(buckets)
! write(0, *) "max value", foo
enddo
call gplt_line(5, 40, 795, 40)
do bar=1, 12
xpos = bar*50 + 25
! write(0, *) bar, xpos, buckets(bar)
call gplt_rect(xpos, 41, xpos+50, 41+15*buckets(bar))
enddo
call end_genplot("OK boomer...")
contains
! ---------------------------------------------------------
subroutine jouer_un_tour(table, compte)
integer,intent(inout) :: table(12)
integer, intent(in) :: compte
integer :: DA, DB, valeur
DA = fair_random_dice()
DB = fair_random_dice()
valeur = DA + DB
! write(0, *) "pass ", compte, " = ", DA, DB, valeur
table(valeur) = table(valeur) + 1
end subroutine
end program end program

33
GrafAnim/doublegauss.f90 Normal file
View File

@ -0,0 +1,33 @@
program doublegauss
use pixrgb
use utils_ga
implicit none
type(t_pixrgb), allocatable :: pic(:,:)
character (len=80) :: filename
integer :: pass, iter
integer :: xrnd, yrnd
write(0, *) "----- making a doublegauss picture ----"
allocate(pic(320, 240))
call rgbpix_set_to_zero(pic)
do pass=0, 99
do iter=1, 15000
xrnd = fair_random_gauss(320)
yrnd = fair_random_gauss(240)
! print *, xrnd, yrnd
pic(xrnd,yrnd)%r = pic(xrnd,yrnd)%r + 1
pic(xrnd,yrnd)%g = pic(xrnd,yrnd)%g + 2
pic(xrnd,yrnd)%b = pic(xrnd,yrnd)%b + 3
end do
write (filename, "(a, i5.5, a)") "F/DBG/", pass, ".pnm"
print *, trim(filename)
call rgbpix_spit_as_pnm_8 (pic, trim(filename))
end do
end program

19
GrafAnim/runme.sh Executable file
View File

@ -0,0 +1,19 @@
#!/bin/bash
set -e
SCRATCH="dummy.genplot"
make doubledice
rm -f F/????.tga
for foo in $(seq 1 250)
do
rm -f dummy.genplot
./doubledice $foo
filename=$(printf "F/%04d.tga" $foo)
genplot2 -s 640x480 ${SCRATCH} $filename
done
convert -delay 10 F/????.tga foo.gif

View File

@ -3,26 +3,40 @@ module usegenplot
implicit none implicit none
integer, private :: color = 4 integer, private :: color = 4
integer, private :: iochannel = -1
logical, private :: initialised = .FALSE. logical, private :: initialised = .FALSE.
contains contains
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
subroutine init_genplot(filename) subroutine init_genplot(filename)
character(*), intent(in) :: filename character(*), intent(in) :: filename
integer :: errcode
write(0, *) '--> init genplot "', filename, '"' write(0, *) '--> init genplot "', filename, '"'
open(newunit=iochannel, file=filename, iostat=errcode)
write(0, *) 'iochannel', iochannel, 'errcode', errcode
initialised = .TRUE. initialised = .TRUE.
color = 4 color = 4
! XXX STOP 'ABEND'
end subroutine end subroutine
subroutine end_genplot(message) subroutine end_genplot(message)
character(*), intent(in) :: message character(*), intent(in) :: message
integer :: errcode
write(0, *) '--> end genplot "', message, '"' write(0, *) '--> end genplot "', message, '"'
initialised = .FALSE. initialised = .FALSE.
close(unit=iochannel, iostat=errcode)
write(0, *) 'close errcode', errcode
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
@ -38,7 +52,7 @@ subroutine do_initialise_once(motif)
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
!- getter, setter, wtf ?
subroutine gplt_setcol(col) subroutine gplt_setcol(col)
integer, intent(in) :: col integer, intent(in) :: col
color = col color = col
@ -55,8 +69,7 @@ subroutine gplt_move(x, y)
if (.NOT. initialised) then if (.NOT. initialised) then
call do_initialise_once('in gplt_move') call do_initialise_once('in gplt_move')
endif endif
write(iochannel, '(3I8)') x, y, 0
print *, x, y, 0
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
@ -66,7 +79,7 @@ subroutine gplt_draw(x, y)
if (.NOT. initialised) then if (.NOT. initialised) then
call do_initialise_once('in gplt_draw') call do_initialise_once('in gplt_draw')
endif endif
print *, x, y, color write(iochannel, '(3I8)') x, y, color
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
@ -78,10 +91,23 @@ subroutine gplt_line(x1, y1, x2, y2)
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
!-
! sx, sy
! +-------------------+
! | x2,y2 |
! | |
! | |
! | x1,y1 |
! +-------------------+
! 0,0
subroutine gplt_rect(x1, y1, x2, y2) subroutine gplt_rect(x1, y1, x2, y2)
integer, intent(in) :: x1, y1, x2, y2 integer, intent(in) :: x1, y1, x2, y2
if (.NOT. initialised) then
call do_initialise_once('in gplt_rect')
endif
call gplt_move(x1, y1) call gplt_move(x1, y1)
call gplt_draw(x2, y1) call gplt_draw(x2, y1)
call gplt_draw(x2, y2) call gplt_draw(x2, y2)

41
GrafAnim/utils_ga.f90 Normal file
View File

@ -0,0 +1,41 @@
! -------------------------------------------------------------------
!- fonctions diverses pour faire des images bizarres
! -------------------------------------------------------------------
module utils_ga
use pixrgb
implicit none
contains
! -------------------------------------------------------------------
function fair_random_dice()
integer :: fair_random_dice
fair_random_dice = 1 + int(rand()*6.0)
end function
! -------------------------------------------------------------------
! usage --> see doublegauss.f90
function fair_random_gauss(hilevel)
integer, intent(in) :: hilevel
integer :: fair_random_gauss
integer :: foo, bar
foo = int(rand()*hilevel/2)
bar = int(rand()*hilevel/2)
fair_random_gauss = 1 + foo + bar
end function
! -------------------------------------------------------------------
! usage --> see doublegauss.f90
subroutine increment_pixel(pix, k)
type(t_pixrgb), intent(inout) :: pix
integer :: k
end subroutine
! -------------------------------------------------------------------
end module

12
GrafAnim/vue3axes.f90 Normal file
View File

@ -0,0 +1,12 @@
module vue3axes
use pixrgb
implicit none
!-------------------------------------------------------------
!-------------------------------------------------------------
!-
!- ouf, c'est fini
!-
end module