Compare commits

..

5 Commits

Author SHA1 Message Date
tTh
d0ac316652 use size option of gneplot2, and more 2022-11-26 13:01:37 +01:00
tTh
1cb5dc13bb forst try 2022-11-24 00:52:13 +01:00
tTh
8535ba09d9 OK boomer 2022-11-22 08:58:56 +01:00
tTh
ecfcef2303 OK boomer 2022-11-22 08:57:05 +01:00
tTh
a8acf23b73 add a new section 2022-11-17 10:56:00 +01:00
11 changed files with 166 additions and 20 deletions

1
GrafAnim/.gitignore vendored
View File

@ -1,5 +1,6 @@
essai essai
doubledice
*.scratch *.scratch
*.tga *.tga

View File

@ -7,6 +7,9 @@ GFOPT = -Wall -Wextra -g -time
essai: essai.f90 usegenplot.o Makefile essai: essai.f90 usegenplot.o Makefile
gfortran $(GFOPT) $< usegenplot.o -o $@ gfortran $(GFOPT) $< usegenplot.o -o $@
doubledice: doubledice.f90 usegenplot.o Makefile
gfortran $(GFOPT) $< usegenplot.o -o $@
usegenplot.o: usegenplot.f90 Makefile usegenplot.o: usegenplot.f90 Makefile
gfortran $(GFOPT) -c $< gfortran $(GFOPT) -c $<

9
GrafAnim/doubledice.f90 Normal file
View File

@ -0,0 +1,9 @@
program doubledice
use usegenplot
implicit none
call init_genplot("essai.genplot")
call end_genplot("OK boomer")
end program

View File

@ -4,38 +4,43 @@ program essai
integer :: foo, bar integer :: foo, bar
integer :: nbarg integer :: nbarg
integer :: numframe = 1 integer :: numframe = 0
character(len=32) :: arg character(len=256) :: arg
! write(0, *) "------------ essai graf anim ---------------" ! write(0, *) "------------ essai graf anim ---------------"
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, *) numframe
endif endif
write(0, '(A40, I5)') "frame number =", numframe write(0, '(A20, I5)') "frame number =", numframe
call init_genplot("essai.genplot") call init_genplot("essai.genplot")
! call do_frame(7) call do_frame(7)
bar = (numframe * 20) - 160 call gplt_setcol(2)
do foo=20, 620, 40
bar = (numframe * 20) - 120
do foo=20, 620, 50
call gplt_line(foo, 20, bar, 460) call gplt_line(foo, 20, bar, 460)
call gplt_line(bar, 20, foo, 460) call gplt_line(bar, 20, foo, 460)
enddo enddo
call end_genplot("done for today")
contains !------------------------------------------ contains !------------------------------------------
subroutine do_frame(color) subroutine do_frame(color)
integer, intent(in) :: color integer, intent(in) :: color
integer :: savecol
call gplt_line( 0, 0, 640, 0) savecol = gplt_getcol()
call gplt_line( 0, 480, 640, 480) call gplt_setcol(color)
call gplt_line( 0, 0, 0, 480) call gplt_rect(0, 0, 640, 480)
call gplt_line(640, 0, 640, 480) call gplt_setcol(savecol)
end subroutine end subroutine

View File

@ -9,7 +9,7 @@ do
./essai $foo > a.scratch ./essai $foo > a.scratch
fname=$(printf "F/%04d.tga" $foo) fname=$(printf "F/%04d.tga" $foo)
echo $fname echo $fname
genplot2 a.scratch $fname genplot2 -s 640x480 a.scratch $fname
done done

View File

@ -1,6 +1,9 @@
module usegenplot module usegenplot
implicit none implicit none
integer, private :: color = 4
logical, private :: initialised = .FALSE.
contains contains
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
@ -8,23 +11,62 @@ module usegenplot
subroutine init_genplot(filename) subroutine init_genplot(filename)
character(*), intent(in) :: filename character(*), intent(in) :: filename
write(0, *) '--> init genplot "', filename, '"' write(0, *) '--> init genplot "', filename, '"'
initialised = .TRUE.
color = 4
end subroutine
subroutine end_genplot(message)
character(*), intent(in) :: message
write(0, *) '--> end genplot "', message, '"'
initialised = .FALSE.
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
subroutine do_initialise_once(motif)
character(*), intent(in) :: motif
write(0, *) '--> do initialise once "', motif, '", flag is ', initialised
call init_genplot('a.scratch')
end subroutine
! -------------------------------------------------------------------
subroutine gplt_setcol(col)
integer, intent(in) :: col
color = col
end subroutine
function gplt_getcol()
integer gplt_getcol
gplt_getcol = color
end function
! -------------------------------------------------------------------
subroutine gplt_move(x, y) subroutine gplt_move(x, y)
integer, intent(in) :: x, y integer, intent(in) :: x, y
print *, x, y, 0
if (.NOT. initialised) then
call do_initialise_once('in gplt_move')
endif
print *, x, y, 0
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
subroutine gplt_draw(x, y) subroutine gplt_draw(x, y)
integer, intent(in) :: x, y integer, intent(in) :: x, y
print *, x, y, 2 if (.NOT. initialised) then
call do_initialise_once('in gplt_draw')
endif
print *, x, y, color
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
@ -36,11 +78,19 @@ subroutine gplt_line(x1, y1, x2, y2)
end subroutine end subroutine
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
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
call gplt_move(x1, y1)
call gplt_draw(x2, y1)
call gplt_draw(x2, y2)
call gplt_draw(x1, y2)
call gplt_draw(x1, y1)
end subroutine end subroutine
! -------------------------------------------------------------------
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
end module end module

2
GravityField/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
essai

8
GravityField/Makefile Normal file
View File

@ -0,0 +1,8 @@
#
# Fortraneries by tTh - Gravity Field
#
GFOPT = -Wall -Wextra -g -time
essai: essai.f90 Makefile
gfortran $(GFOPT) $< -o $@

5
GravityField/README.md Normal file
View File

@ -0,0 +1,5 @@
# Gravity Field
Some crude experiments to make fancy picture of a useless gravaity field.
Expect bug party.

62
GravityField/essai.f90 Normal file
View File

@ -0,0 +1,62 @@
program essai
implicit none
integer :: ix, iy
real :: fx, fy
real :: foo, bar, maxi, mini
maxi = 0.0
mini = 9e9
do ix=1, 2000
fx = real(ix)
do iy=1, 2000
fy = real(iy)
foo = rdist(fx, fy, 222.22, 765.432)
bar = gravity(foo, 1337.0)
maxi = max(maxi, bar)
mini = min(mini, bar)
enddo
enddo
print *, "dist : ", mini, maxi
contains !------------------------------------------
function gravity(distance, masse)
real, intent(in) :: distance, masse
real :: gravity
real :: computed
if (distance .LT. 0.010) then
computed = 0.0
else
computed = masse / (distance ** 2)
endif
gravity = computed
end function
!------------------------------------------
function rdist(ax, ay, bx, by)
real, intent(in) :: ax, ay, bx, by
real :: rdist
real :: rx, ry
rx = real(ax-bx)
ry = real(ay-by)
rdist = sqrt( (rx*rx) + (ry*ry) )
end function
!------------------------------------------
!------------------------------------------
end program

View File

@ -1,7 +1,7 @@
# Fortraneries # Fortraneries
Le Fortran moderne, c'est quand même assez cool, alors autant diffuser Le Fortran moderne, c'est quand même assez cool, alors autant diffuser
mes gruikeries. mes gruikeries. Pour l'édification des masses...
J'ai découvert le Fortran moderne lors de mon reclufinement J'ai découvert le Fortran moderne lors de mon reclufinement
de Janvier 2022, et j'ai bien aimé. Bon, contrairement à la de Janvier 2022, et j'ai bien aimé. Bon, contrairement à la
@ -13,7 +13,8 @@ l'existence des _pointeurs_ compense largement.
- [SoundBrotching](SoundBrotching/) : faire gémir vos tympans - [SoundBrotching](SoundBrotching/) : faire gémir vos tympans
- [BloubWorld](BloubWorld/) : la vie des particules - [BloubWorld](BloubWorld/) : la vie des particules
- [Fraktalism](Fraktalism/) : du chaos dans les pixels - [Fraktalism](Fraktalism/) : du chaos dans les pixels
- [RandomStuff](RandomStuff) : on a tous droit à notre jardin secret - [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret
- [GrafAnim](GrafAnim/) : Ah, enfin de la gif89a en vue !
## hotline ## hotline