253 lines
7.5 KiB
Fortran
253 lines
7.5 KiB
Fortran
! THE GENPLOTTING MODULE
|
|
!
|
|
! new Thu Apr 23 01:13.37 PM UTC 2026
|
|
!
|
|
module genplotting
|
|
implicit none
|
|
|
|
real :: xmin, xmax, ymin, ymax
|
|
private :: xmin, xmax, ymin, ymax
|
|
|
|
real :: xoffset, yoffset, xscale, yscale
|
|
private :: xoffset, yoffset, xscale, yscale
|
|
|
|
real :: rotation, rotmatrix(3,3)
|
|
private :: rotation, rotmatrix, compute_rot_matrix
|
|
private :: print_rot_matrix
|
|
|
|
integer :: outunit = 6
|
|
private :: outunit
|
|
|
|
contains
|
|
! ---------------------------------------------------------
|
|
! the first parameter _must_ be 0.
|
|
! the second can be
|
|
! - the name of a file for recording plot instructions
|
|
! or
|
|
! - an empty string for send plot command to stdout
|
|
!
|
|
subroutine genp_init (foo, fname)
|
|
integer, intent(in) :: foo
|
|
character (len=*), intent(in) :: fname
|
|
|
|
IF (FOO .NE. 0) THEN
|
|
WRITE(0, '("FOO .NE. 0")')
|
|
CALL EXIT(1)
|
|
END IF
|
|
|
|
outunit = 6 ! stdout
|
|
if (len(fname) .gt. 0) then
|
|
write (0, '("genplot init opening : ", A)') fname
|
|
open(newunit=outunit,file=fname)
|
|
endif
|
|
|
|
xmin = 9e9 ; xmax = -9e9
|
|
ymin = 9e9 ; ymax = -9e9
|
|
xoffset = 0.0 ; yoffset = 0.0
|
|
xscale = 1.0 ; yscale = 1.0
|
|
|
|
rotation = 0.0
|
|
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_set_offset(ox, oy)
|
|
real, intent(in) :: ox, oy
|
|
xoffset = ox ; yoffset = oy
|
|
end subroutine
|
|
subroutine genp_get_offset(ox, oy)
|
|
real, intent(out) :: ox, oy
|
|
ox = xoffset ; oy = yoffset
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
! new Tue May 12 06:51:57 PM UTC 2026
|
|
subroutine genp_set_scale(sx, sy)
|
|
real, intent(in) :: sx, sy
|
|
xscale = sx ; yscale = sy
|
|
end subroutine
|
|
subroutine genp_get_scale(sx, sy)
|
|
real, intent(out) :: sx, sy
|
|
sx = xscale ; sy = yscale
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
! this is a private procedure, don't call it from your prog
|
|
subroutine compute_rot_matrix(angle)
|
|
real, intent(in) :: angle
|
|
write (0, '("compute rot matrix for", F8.5, " radians")') &
|
|
angle
|
|
rotmatrix (1, 1) = cos(angle)
|
|
rotmatrix (1, 2) = sin(angle)
|
|
rotmatrix (1, 3) = 0.0
|
|
|
|
rotmatrix (2, 1) = -sin(angle)
|
|
rotmatrix (2, 2) = cos(angle)
|
|
rotmatrix (2, 3) = 0.0
|
|
|
|
rotmatrix (3, 1) = 0.0
|
|
rotmatrix (3, 2) = 0.0
|
|
rotmatrix (3, 3) = 1.0
|
|
|
|
end subroutine
|
|
! -----------------
|
|
! we have computed some fancy numbers
|
|
! and we want to see them !
|
|
subroutine print_rot_matrix(fd)
|
|
integer, intent(in) :: fd
|
|
|
|
integer :: i, j
|
|
do i=1, 3
|
|
do j=1, 3
|
|
write (fd, '(" ", F8.5)', advance='no') rotmatrix(i,j)
|
|
end do
|
|
write(fd, *)
|
|
end do
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_set_rotation(angle)
|
|
real, intent(in) :: angle
|
|
rotation = angle
|
|
! compute the matrix here !
|
|
call compute_rot_matrix(angle)
|
|
! call print_rot_matrix(0)
|
|
end subroutine
|
|
|
|
real function genp_get_rotation()
|
|
genp_get_rotation = rotation
|
|
end function
|
|
|
|
subroutine genp_get_rot_matrix (dst)
|
|
real, intent(out) :: dst(3, 3)
|
|
dst = rotmatrix
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_move (px, py)
|
|
real, intent(in) :: px, py
|
|
real :: lx, ly
|
|
lx = (px*xscale) + xoffset
|
|
ly = (py*yscale) + yoffset
|
|
write (outunit, '(2F12.5, I5)') lx, ly, -1
|
|
if (lx .lt. xmin) xmin = lx
|
|
if (lx .gt. xmax) xmax = lx
|
|
if (ly .lt. ymin) ymin = ly
|
|
if (ly .gt. ymax) ymax = ly
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_draw (px, py, color)
|
|
real, intent(in) :: px, py
|
|
integer, intent(in) :: color
|
|
real :: lx, ly
|
|
lx = (px*xscale) + xoffset
|
|
ly = (py*yscale) + yoffset
|
|
write (outunit, '(2F12.5, I5)') lx, ly, color
|
|
if (lx .lt. xmin) xmin = lx
|
|
if (lx .gt. xmax) xmax = lx
|
|
if (ly .lt. ymin) ymin = ly
|
|
if (ly .gt. ymax) ymax = ly
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_line(xa, ya, xb, yb, color)
|
|
real, intent(in) :: xa, ya, xb, yb
|
|
integer, intent(in) :: color
|
|
call genp_move(xa, ya)
|
|
call genp_draw(xb, yb, color)
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_plot_axes(amp)
|
|
real, intent(in) :: amp
|
|
call genp_move(0.0, -amp)
|
|
call genp_draw(0.0, amp, 7)
|
|
call genp_move(-amp, 0.0)
|
|
call genp_draw( amp, 0.0, 7)
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_circle(radius, steps, color)
|
|
real, intent(in) :: radius
|
|
integer, intent(in) :: steps, color
|
|
|
|
integer :: idx
|
|
real :: fk, ang, x, y
|
|
logical :: firstdot
|
|
|
|
if (steps .LT.3 ) then
|
|
write(0, '("circle: steps ", I3, " bad value")') steps
|
|
return
|
|
endif
|
|
|
|
firstdot = .TRUE.
|
|
do idx=0, steps
|
|
fk = real(idx) / real(steps)
|
|
ang = 6.283185307 * fk
|
|
! write(0, '(I5, " -> ", 2F10.5)') idx, fk, ang
|
|
x = radius * cos(ang) ; y = radius * sin(ang)
|
|
if (firstdot) then
|
|
call genp_move(x, y) ; firstdot = .FALSE.
|
|
else
|
|
call genp_draw(x, y, color)
|
|
endif
|
|
enddo
|
|
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
subroutine genp_end (foo)
|
|
integer, intent(in) :: foo
|
|
|
|
write (0, '("------------- genp_end -------------")')
|
|
write (0, '("minmax X ", 2F18.5)') xmin, xmax
|
|
write (0, '("minmax Y ", 2F18.5)') ymin, ymax
|
|
|
|
write (outunit, '(2F18.5, I6)') xmin*1.05, ymin*1.05, -1
|
|
write (outunit, '(2F18.5, I6)') xmin*1.05, ymax*1.05, 0
|
|
write (outunit, '(2F18.5, I6)') xmax*1.05, ymax*1.05, 0
|
|
write (outunit, '(2F18.5, I6)') xmax*1.05, ymin*1.05, 0
|
|
write (outunit, '(2F18.5, I6)') xmin*1.05, ymin*1.05, 0
|
|
close (outunit)
|
|
|
|
if (6 .ne. outunit) then
|
|
write (0, '("genp_end on ", I6, " is ", I6)') outunit, foo
|
|
endif
|
|
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
! /!\ warning /!\
|
|
! this procedure is highly experimental, don't use it
|
|
! for any real (or critical) work, but it was fine for
|
|
! playing around with the #UselessGraphic concept.
|
|
|
|
subroutine genp_do_render(srcfile, tgafile, xsize, ysize)
|
|
character (len=*), intent(in) :: srcfile, tgafile
|
|
integer, intent(in) :: xsize, ysize
|
|
|
|
character (len=1664) :: cmdline
|
|
character (len=20) :: dima, dimb
|
|
integer :: i, j, errcode
|
|
|
|
if (6 .EQ. outunit) then
|
|
write(0, '(" Sorry, I can not do that, Dave !")')
|
|
stop " >>> FATAL ERROR"
|
|
endif
|
|
|
|
write(0, '("--- genp do_render ---")')
|
|
write(0, '(" srcfile: ", A)') srcfile
|
|
write(0, '(" tgafile: ", A)') tgafile
|
|
write(0, '(" picsize: ", 2I5)') xsize, ysize
|
|
|
|
write(dima, '(I5, "x", I5)') xsize, ysize
|
|
! write(0, '("dima [",A, "]")') dima
|
|
dimb = "" ; j = 1
|
|
do i=1, len(dima)
|
|
if (dima(i:i) .NE. ' ') then
|
|
dimb(j:j) = dima(i:i)
|
|
j = j +1
|
|
endif
|
|
enddo
|
|
! write(0, '("[",A, "]")') trim(dimb)
|
|
write(cmdline, '("genplot2 -s ", A, " ", A, " ", A)') &
|
|
trim(dimb), srcfile, tgafile
|
|
write(0, '(A)') trim(cmdline)
|
|
call execute_command_line(cmdline, exitstat=errcode)
|
|
write(0, '("errcode was :", I6)') errcode
|
|
|
|
end subroutine
|
|
! ---------------------------------------------------------
|
|
|
|
end module genplotting
|