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
View File
@@ -1,5 +1,6 @@
essai
doubledice
*.scratch
*.tga
+3
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
View File
@@ -0,0 +1,9 @@
program doubledice
use usegenplot
implicit none
call init_genplot("essai.genplot")
call end_genplot("OK boomer")
end program
+16 -11
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
+1 -1
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
+56 -6
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
View File
@@ -0,0 +1,2 @@
essai
+8
View File
@@ -0,0 +1,8 @@
#
# Fortraneries by tTh - Gravity Field
#
GFOPT = -Wall -Wextra -g -time
essai: essai.f90 Makefile
gfortran $(GFOPT) $< -o $@
+5
View File
@@ -0,0 +1,5 @@
# Gravity Field
Some crude experiments to make fancy picture of a useless gravaity field.
Expect bug party.
+62
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
+3 -2
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