Fortraneries/GrafAnim/usegenplot.f90

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