124 lines
3.0 KiB
Fortran
124 lines
3.0 KiB
Fortran
module usegenplot
|
|
|
|
implicit none
|
|
|
|
integer, private :: color = 4
|
|
integer, private :: iochannel = -1
|
|
logical, private :: initialised = .FALSE.
|
|
|
|
contains
|
|
|
|
! -------------------------------------------------------------------
|
|
|
|
subroutine init_genplot(filename)
|
|
character(*), intent(in) :: filename
|
|
|
|
integer :: errcode
|
|
|
|
write(0, *) '--> init genplot "', filename, '"'
|
|
open(newunit=iochannel, file=filename, iostat=errcode)
|
|
write(0, *) 'iochannel', iochannel, 'errcode', errcode
|
|
|
|
initialised = .TRUE.
|
|
color = 4
|
|
|
|
! XXX STOP 'ABEND'
|
|
|
|
end subroutine
|
|
|
|
subroutine end_genplot(message)
|
|
character(*), intent(in) :: message
|
|
|
|
integer :: errcode
|
|
|
|
write(0, *) '--> end genplot "', message, '"'
|
|
initialised = .FALSE.
|
|
|
|
close(unit=iochannel, iostat=errcode)
|
|
write(0, *) 'close errcode', errcode
|
|
|
|
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
|
|
|
|
! -------------------------------------------------------------------
|
|
!- getter, setter, wtf ?
|
|
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
|
|
|
|
if (.NOT. initialised) then
|
|
call do_initialise_once('in gplt_move')
|
|
endif
|
|
write(iochannel, '(3I8)') x, y, 0
|
|
end subroutine
|
|
|
|
! -------------------------------------------------------------------
|
|
|
|
subroutine gplt_draw(x, y)
|
|
integer, intent(in) :: x, y
|
|
if (.NOT. initialised) then
|
|
call do_initialise_once('in gplt_draw')
|
|
endif
|
|
write(iochannel, '(3I8)') x, y, color
|
|
end subroutine
|
|
|
|
! -------------------------------------------------------------------
|
|
|
|
subroutine gplt_line(x1, y1, x2, y2)
|
|
integer, intent(in) :: x1, y1, x2, y2
|
|
call gplt_move(x1, y1)
|
|
call gplt_draw(x2, y2)
|
|
end subroutine
|
|
|
|
! -------------------------------------------------------------------
|
|
!-
|
|
! sx, sy
|
|
! +-------------------+
|
|
! | x2,y2 |
|
|
! | |
|
|
! | |
|
|
! | x1,y1 |
|
|
! +-------------------+
|
|
! 0,0
|
|
|
|
subroutine gplt_rect(x1, y1, x2, y2)
|
|
integer, intent(in) :: x1, y1, x2, y2
|
|
|
|
if (.NOT. initialised) then
|
|
call do_initialise_once('in gplt_rect')
|
|
endif
|
|
|
|
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
|
|
|