tTh/TetaTricks
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

pimp my plotting

Browse Source
This commit is contained in:
tTh 2024-08-19 15:40:56 +02:00
parent 0707c0192c
commit 1e175bc6ef
2 changed files with 45 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
code/fortran/Makefile
View File

@ -11,4 +11,5 @@ dessiner: dessiner.f90 Makefile
plot89a.gif: dessiner Makefile plot89a.gif: dessiner Makefile
rm -f WS/A????.png rm -f WS/A????.png
./dessiner ./dessiner
convert -delay 10 -colors 42 WS/A????.png $@ convert -delay 10 -colors 42 WS/A????.png $@
wc -c plot89a.gif

66
code/fortran/dessiner.f90
View File

@ -8,8 +8,8 @@ program dessiner
call plgver(version) call plgver(version)
write (*,'(" ",a,a)') 'plPlot version: ', trim(version) write (*,'(" ",a,a)') 'plPlot version: ', trim(version)
call dessin_X11 (0.12, 1.51, 11) !! call dessin_X11 (0.12, 1.51, 11)
!! call dessin_dans_un_fichier () call dessin_dans_un_fichier ()
contains ! ----------------------------- contains ! -----------------------------
!------------------------------------------------------ !------------------------------------------------------
@ -33,7 +33,7 @@ subroutine dessin_X11 (sha, shb, color)
call plsdev('xwin') call plsdev('xwin')
call plinit () call plinit ()
call plenv (-2.5, 2.5, -2.5, 2.5, 1, 2) call plenv (-2.5, 2.5, -2.5, 2.5, 1, 1)
amp = 2.06 amp = 2.06
do i = 1, lg do i = 1, lg
@ -52,47 +52,67 @@ subroutine dessin_X11 (sha, shb, color)
end subroutine end subroutine
!------------------------------------------------------ !------------------------------------------------------
!- _ __ ___ ___ ___ !- _ __ ___ ___
!- __ _ (_) / _| ( _ ) / _ \ __ _ |__ \ !- __ _ (_) / _| ( _ ) / _ \ __ _
!- / _` | | | | |_ / _ \ | (_) | / _` | / / !- / _` | | | | |_ / _ \ | (_) | / _` |
!- | (_| | | | | _| | (_) | \__, | | (_| | |_| !- | (_| | | | | _| | (_) | \__, | | (_| |
!- \__, | |_| |_| \___/ /_/ \__,_| (_) !- \__, | |_| |_| \___/ /_/ \__,_|
!- |___/ !- |___/
!-
subroutine dessin_dans_un_fichier () subroutine dessin_dans_un_fichier ()
integer, parameter :: nbpts = 20 integer, parameter :: nbpts = 179
real, parameter :: usz = 15.0 ! univers size integer, parameter :: nbframes = 99
real, parameter :: usz = 17.0 ! univers size
real :: xa(nbpts), ya(nbpts)
real :: xb(nbpts), yb(nbpts)
real :: x(nbpts), y(nbpts) real :: x(nbpts), y(nbpts)
integer :: frame, i integer :: frame, i
real :: coef
character(len=89) :: filename character(len=89) :: filename
character(len=89) :: buffer character(len=89) :: buffer
character(len=3) :: str character(len=3) :: str
print *, 'Dessin dans un fichier' print *, 'Dessin dans un fichier'
! build the startup conditions
do i=1, nbpts do i=1, nbpts
x(i) = usz * (rand() - 0.5000) coef = real(i) * 0.051
y(i) = usz * (rand() - 0.5000) * 0.50 xa(i) = usz * 0.80 * sin(coef*2.0)
ya(i) = usz * 0.70 * (-0.27 + cos(coef*3.0))
xb(i) = usz * 0.11 * (rand() - 0.54)
yb(i) = usz * 0.11 * (rand() - 0.97)
enddo enddo
do frame= 0, 119 ! iterate over frames.
do frame= 0, nbframes
coef = real(frame) / real(nbframes)
coef = cos(coef*3.141592654)
write (filename, "(a, i4.4, a)") "WS/A", frame, ".png" write (filename, "(a, i4.4, a)") "WS/A", frame, ".png"
print *, frame, ' => ', trim(filename) ! print *, frame, "!", coef, ' => ', trim(filename)
call plsdev ('pngcairo') call plsdev ('pngcairo')
call plsfnam (trim(filename)) call plsfnam (trim(filename))
call plinit () call plinit ()
call plenv (-10., 10., -10., 10., 0, 1) call plenv (-usz, usz, -usz, usz, 0, 1)
call plcol0 (3) call plcol0 (3)
! compute the real picture...
do i=1, nbpts do i=1, nbpts
x(i) = x(i) + 1.2 * (rand() - 0.5000) x(i) = xa(i)*coef - xb(i)*(1.0-coef)
y(i) = y(i) + 1.2 * (rand() - 0.5000) y(i) = ya(i)*coef - yb(i)*(1.0-coef)
call plline (x, y) enddo
enddo
write(buffer, "(i3.3)") frame ! ... and plot it *now*
str = trim(buffer) call plline (x, y)
call plcol0 (15)
call plstring (x, y, buffer) call plcol0 (15) ! 15 is pure white
call pllab("Apéro level", "Choupitude", "-- Philosophie de comptoir --")
call plend () call plend ()
enddo enddo