Compare commits
5 Commits
17e5de3ecb
...
d0ac316652
Author | SHA1 | Date | |
---|---|---|---|
|
d0ac316652 | ||
|
1cb5dc13bb | ||
|
8535ba09d9 | ||
|
ecfcef2303 | ||
|
a8acf23b73 |
1
GrafAnim/.gitignore
vendored
1
GrafAnim/.gitignore
vendored
@ -1,5 +1,6 @@
|
|||||||
|
|
||||||
essai
|
essai
|
||||||
|
doubledice
|
||||||
|
|
||||||
*.scratch
|
*.scratch
|
||||||
*.tga
|
*.tga
|
||||||
|
@ -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
9
GrafAnim/doubledice.f90
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
program doubledice
|
||||||
|
use usegenplot
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call init_genplot("essai.genplot")
|
||||||
|
|
||||||
|
call end_genplot("OK boomer")
|
||||||
|
|
||||||
|
end program
|
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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
2
GravityField/.gitignore
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
|
||||||
|
essai
|
8
GravityField/Makefile
Normal file
8
GravityField/Makefile
Normal 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
5
GravityField/README.md
Normal 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
62
GravityField/essai.f90
Normal 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
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user