module greg_work
  use gildas_def
  !--------------------------------------------------------------------
  ! Working buffers.
  !--------------------------------------------------------------------
  real(kind=4), allocatable :: xwork(:), ywork(:)  ! Buffers for polyline...
  real(kind=4), allocatable :: xworu(:), yworu(:)  ! Buffers after clipping
end module greg_work
!
subroutine grfill(line,error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>grfill
  use gildas_def
  use sic_types
  use greg_kernel
  use greg_xyz
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  ! GREG Support routine for command FILL X Y
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='CONNECT'
  integer(kind=size_length) :: ixy
  integer(kind=4) :: form,narg,ncolo
  type(sic_descriptor_t) :: xinca,yinca
  integer(kind=address_length) :: ipx,ipy
  !
  save xinca,yinca
  !
  if (sic_present(2,1)) then
    ! ZZZ documenter
    call gtv_pencol_arg2id(rname,line,2,1,ncolo,error)
    if (error)  return
    call setcol(ncolo)
  endif
  !
  narg = sic_narg(0)
  if (narg.eq.0 .or. narg.eq.2) then
    form = 0
    call get_incarnation('FILL',line,form,ixy,xinca,yinca,error)
    if (error) return
    ipx = gag_pointer(xinca%addr,memory)
    ipy = gag_pointer(yinca%addr,memory)
    if (form.eq.fmt_r8) then
      call gr8_ufill(ixy,memory(ipx),memory(ipy))
    else
      call gr4_ufill(ixy,memory(ipx),memory(ipy))
    endif
    call sic_volatile(xinca)
    call sic_volatile(yinca)
  endif
end subroutine grfill
!
subroutine gr4_ufill(nxy,x,y)
  use gildas_def
  use greg_interfaces
  use greg_work
  use gbl_message
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! GREG Library routine
  !  Connect a Filled polyline (No BLANKING...)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: nxy     ! Number of data points
  real(kind=4),              intent(in) :: x(nxy)  ! Array of X coordinates
  real(kind=4),              intent(in) :: y(nxy)  ! Array of Y coordinates
  ! Local
  integer(kind=size_length) :: np
  logical :: error
  !
  if (nxy.lt.2) return
  !
  error = .false.
  call reallocate_poly_buffers(nxy,error)
  if (error)  return
  !
  call us4_to_int(x,y,xwork,ywork,nxy)
  np = nxy+1
  xwork(np) = xwork(1)
  ywork(np) = ywork(1)
  call clip_poly(np,xwork,ywork,xworu,yworu)
  call gr_fillpoly(np,xworu,yworu)
end subroutine gr4_ufill
!
subroutine gr8_ufill(nxy,x,y)
  use gildas_def
  use greg_interfaces
  use greg_work
  use gbl_message
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! GREG Library routine
  !  Connect a Filled polyline (No BLANKING...)
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: nxy     ! Number of data points
  real(kind=8),              intent(in) :: x(nxy)  ! Array of X coordinates
  real(kind=8),              intent(in) :: y(nxy)  ! Array of Y coordinates
  ! Local
  integer(kind=size_length) :: np
  logical :: error
  !
  if (nxy.lt.2) return
  !
  error = .false.
  call reallocate_poly_buffers(nxy,error)
  if (error)  return
  !
  call us8_to_int(x,y,xwork,ywork,nxy)
  np = nxy+1
  xwork(np) = xwork(1)
  ywork(np) = ywork(1)
  call clip_poly(np,xwork,ywork,xworu,yworu)
  call gr_fillpoly(np,xworu,yworu)
end subroutine gr8_ufill
!
subroutine gr_fillpoly(n,x,y)
  use gildas_def
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>gr_fillpoly
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in) :: n     !
  real(kind=4),              intent(in) :: x(*)  !
  real(kind=4),              intent(in) :: y(*)  !
  ! Local
  integer(kind=4) :: n4
  logical :: error
  !
  n4 = int(n,kind=4)
  error = .false.
  call gtv_fillpoly(n4,x,y,.false.,error)
end subroutine gr_fillpoly
!
subroutine parse_polygon_drawing(rname,line,optfill,opthatch,drawing,error)
  use phys_const
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>parse_polygon_drawing
  use greg_types
  use greg_pen
  !---------------------------------------------------------------------
  ! @ private
  ! Parse the following options in the command line:
  !   /FILL [Icolor]
  !   /HATCH [Ipen] [Angle] [Separ] [Phase]
  ! Defaults for the arguments are defined here.
  !---------------------------------------------------------------------
  character(len=*),        intent(in)    :: rname     !
  character(len=*),        intent(in)    :: line      !
  integer(kind=4),         intent(in)    :: optfill   ! Number of option /FILL
  integer(kind=4),         intent(in)    :: opthatch  ! Number of option /HATCH
  type(polygon_drawing_t), intent(out)   :: drawing   !
  logical,                 intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=message_length) :: mess
  !
  ! Contour (not parsed here)
  drawing%contoured = .false.
  call inqpen(drawing%cpen)  ! Default, even if not used
  !
  ! /FILL
  drawing%filled = sic_present(optfill,0)
  if (drawing%filled) then
    if (sic_present(optfill,1)) then
      call gtv_pencol_arg2id(rname,line,optfill,1,drawing%fcolor,error)
      if (error) return
    else
      call inqcol(drawing%fcolor)
    endif
  endif
  !
  ! /HATCH
  drawing%hatched = sic_present(opthatch,0)
  if (drawing%hatched) then
    call inqpen(drawing%hpen)
    call sic_i4(line,opthatch,1,drawing%hpen,.false.,error)
    if (error) return
    if (drawing%hpen.lt.0 .or. drawing%hpen.gt.maxpen) then
      write(mess,'(A,I0,A,I0)')  'Pen number ',drawing%hpen,' out of range 0-',maxpen
      call greg_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    drawing%hangle = 45.  ! Degrees
    call sic_r4(line,opthatch,2,drawing%hangle,.false.,error)
    if (error) return
    drawing%hangle = drawing%hangle*rad_per_deg  ! Radians
    !
    drawing%hsepar = .25  ! Physical units (cm)
    call sic_r4(line,opthatch,3,drawing%hsepar,.false.,error)
    if (error) return
    !
    drawing%hphase = .0  ! 0. to 1.
    call sic_r4(line,opthatch,4,drawing%hphase,.false.,error)
    if (error) return
    drawing%hphase = modulo(drawing%hphase,1.)  ! Between 0. to 1.
  endif
  !
end subroutine parse_polygon_drawing
!
subroutine reallocate_poly_buffers(npts,error)
  use gildas_def
  use greg_dependencies_interfaces
  use greg_work
  !---------------------------------------------------------------------
  ! @ private
  ! 'npts' is the number of points of the input polygon
  ! This subroutine will allocate:
  ! - npts+1 values (so that the caller can close the polygon) for the
  !   unclipped buffer.
  ! - clipping buffer: npts*3/2+1, because clipping may add more
  !   summits, and this is the worst case.
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(in)    :: npts
  logical,                   intent(inout) :: error
  ! Local
  logical :: alloc
  integer(kind=4) :: ier
  !
  alloc = .not.allocated(xwork)  ! Allocate if not yet allocated
  if (.not.alloc) then
    alloc = npts.gt.size(xwork)  ! Allocate of not large enough
    if (alloc)  deallocate(xwork,ywork,xworu,yworu)
  endif
  if (.not.alloc)  return  ! Nothing to do if large enough
  !
  allocate(xwork(npts+1),    ywork(npts+1),  &
           xworu(npts*3/2+1),yworu(npts*3/2+1),stat=ier)
  if (failed_allocate('POLY','buffers',ier,error))  return
  !
end subroutine reallocate_poly_buffers
