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
doubledice
*.scratch
*.tga

View File

@ -7,6 +7,9 @@ GFOPT = -Wall -Wextra -g -time
essai: essai.f90 usegenplot.o Makefile
gfortran $(GFOPT) $< usegenplot.o -o $@
doubledice: doubledice.f90 usegenplot.o Makefile
gfortran $(GFOPT) $< usegenplot.o -o $@
usegenplot.o: usegenplot.f90 Makefile
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 :: nbarg
integer :: numframe = 1
character(len=32) :: arg
integer :: numframe = 0
character(len=256) :: arg
! write(0, *) "------------ essai graf anim ---------------"
nbarg = IARGC()
if (nbarg .GT. 0) then
call GETARG(1, arg)
write (0, '(A40, A5)') "argument = ", arg
! write (0, '(A40, A5)') "argument = ", arg
read (arg, *) numframe
endif
write(0, '(A40, I5)') "frame number =", numframe
write(0, '(A20, I5)') "frame number =", numframe
call init_genplot("essai.genplot")
! call do_frame(7)
call do_frame(7)
bar = (numframe * 20) - 160
do foo=20, 620, 40
call gplt_setcol(2)
bar = (numframe * 20) - 120
do foo=20, 620, 50
call gplt_line(foo, 20, bar, 460)
call gplt_line(bar, 20, foo, 460)
enddo
call end_genplot("done for today")
contains !------------------------------------------
subroutine do_frame(color)
integer, intent(in) :: color
integer :: savecol
call gplt_line( 0, 0, 640, 0)
call gplt_line( 0, 480, 640, 480)
call gplt_line( 0, 0, 0, 480)
call gplt_line(640, 0, 640, 480)
savecol = gplt_getcol()
call gplt_setcol(color)
call gplt_rect(0, 0, 640, 480)
call gplt_setcol(savecol)
end subroutine

View File

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

View File

@ -1,6 +1,9 @@
module usegenplot
implicit none
integer, private :: color = 4
logical, private :: initialised = .FALSE.
contains
! -------------------------------------------------------------------
@ -8,23 +11,62 @@ module usegenplot
subroutine init_genplot(filename)
character(*), intent(in) :: 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
! -------------------------------------------------------------------
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)
integer, intent(in) :: x, y
print *, x, y, 0
integer, intent(in) :: x, y
if (.NOT. initialised) then
call do_initialise_once('in gplt_move')
endif
print *, x, y, 0
end subroutine
! -------------------------------------------------------------------
subroutine gplt_draw(x, y)
integer, intent(in) :: x, y
print *, x, y, 2
integer, intent(in) :: x, y
if (.NOT. initialised) then
call do_initialise_once('in gplt_draw')
endif
print *, x, y, color
end subroutine
! -------------------------------------------------------------------
@ -36,11 +78,19 @@ subroutine gplt_line(x1, y1, x2, y2)
end subroutine
! -------------------------------------------------------------------
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 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
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
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
- [BloubWorld](BloubWorld/) : la vie des particules
- [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