subroutine gr_point(n,is)
  use gildas_def
  use phys_const
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>gr_point
  use greg_kernel
  use greg_pen
  !---------------------------------------------------------------------
  ! @ public
  !  Draw 1 symbol of type N, style IS and current size
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: n   ! Number of summits
  integer(kind=4), intent(in) :: is  ! Style of polygon (0-3)
  ! Local
  real(kind=4) :: cfact  ! Half the size of the symbol in centimeters
  real(kind=4) :: dtheta, theta, stellar
  real(kind=4) :: xa,ya, xb,yb, xc,yc, xmid,ymid, xn
  integer(kind=size_length) :: j,np,nn
  logical :: doclip
  integer(kind=4), parameter :: msum=256  ! Maximum number of summits per marker
  integer(kind=4), parameter :: mpts=2*msum+1  ! Maximum size of polyline to draw the marker
  ! Buffers are SAVE'd to avoid reallocation each time entering this subroutine
  real(kind=4), save :: xwork(mpts),ywork(mpts)  ! Before clipping
  real(kind=4), save :: xworu(mpts),yworu(mpts)  ! After clipping
  !
  cfact = csymb * expand * 0.5
  !
  ! Plot a single dot if CFACT=0 or if less than 2 summits
  if (n.lt.2 .or. cfact.eq.0.) then
    np = 1
    call grdots(np,xp,yp)  ! New list of points (1 point within)
    return
  endif
  nn = min(msum,n)
  !
  ! Check clipping
  xc = xp
  yc = yp
  doclip = .not.noclip
  if (doclip) then
    if (xc+cfact.lt.gx1) then
      return
    elseif (xc-cfact.gt.gx2) then
      return
    elseif (yc+cfact.lt.gy1) then
      return
    elseif (yc-cfact.gt.gy2) then
      return
    else
      !
      ! May intersect
      if (xc-cfact.ge.gx1 .and. xc+cfact.le.gx2 .and.  &
          yc-cfact.ge.gy1 .and. yc+cfact.le.gy2) then
        doclip = .false.
      endif
    endif
  endif
  !
  dtheta = 2. * pi / nn
  theta = (3*pi + dtheta)/2 + sangle*pi/180
  !
  ! Style 0 Empty polygon
  if (is.eq.0 .or. nn.eq.2) then
    xwork(1) = cfact*cos(theta) + xc
    ywork(1) = cfact*sin(theta) + yc
    np = nn+1
    do j = 2,np
      theta = theta + dtheta
      xwork(j) = cfact*cos(theta) + xc
      ywork(j) = cfact*sin(theta) + yc
    enddo
    !
    ! Style 1 Vertex connected polygon
  elseif (is.eq.1) then
    np = 2*nn+1
    xwork(1) = xc
    ywork(1) = yc
    do j=2,np,2
      xwork(j) = cfact*cos(theta) + xc
      ywork(j) = cfact*sin(theta) + yc
      xwork(j+1) = xc
      ywork(j+1) = yc
      theta = theta + dtheta
    enddo
    !
    ! Style 2 Starred polygon, 4 Filled Star
  elseif (is.eq.2 .or. is.eq.4) then
    xa = cfact*cos(theta) + xc
    ya = cfact*sin(theta) + yc
    xwork(1) = xa
    ywork(1) = ya
    stellar = .25
    np = 2*nn+1
    do j = 2,np,2
      theta = theta + dtheta
      xb = cfact*cos(theta) + xc
      yb = cfact*sin(theta) + yc
      xmid = stellar*(xa + xb - 2*xc) + xc
      ymid = stellar*(ya + yb - 2*yc) + yc
      xwork(j) = xmid
      ywork(j) = ymid
      xwork(j+1) = xb
      ywork(j+1) = yb
      xa = xb
      ya = yb
    enddo
    !
    ! Style 3 Filled polygon
  elseif (is.eq.3) then
    !
    ! For cosmetic purposes, start plotting from a point below.
    xn = (-pi/2-theta)/dtheta
    if (xn.ge.0) then
      j = int(xn)
    else
      j = -int(-xn)-1
    endif
    theta = theta + j * dtheta
    xwork(1) = cfact*cos(theta) + xc
    ywork(1) = cfact*sin(theta) + yc
    np = nn+1
    do j = 2,np
      theta = theta + dtheta
      xwork(j) = cfact*cos(theta) + xc
      ywork(j) = cfact*sin(theta) + yc
    enddo
  endif
  !
  ! 3 and 4 are filled
  if (is.ge.3) then
    np = np+1
    xwork(np) = xwork(1)
    ywork(np) = ywork(1)
    if (doclip) then
      call clip_poly(np,xwork,ywork,xworu,yworu)
      call gr_fillpoly(np,xworu,yworu)
    else
      call gr_fillpoly(np,xwork,ywork)
    endif
  else
    if (doclip) then
      call grpoly(np,xwork,ywork)
    else
      call gtreloc(xwork(1),ywork(1))
      do j=2,np
        call gtdraw(xwork(j),ywork(j))
      enddo
      gxp = xwork(np)  ! Set the pen location after the last 'gtdraw'
      gyp = ywork(np)  !
    endif
  endif
  !
  ! Reset pen location
  call grelocate(xc,yc)
end subroutine gr_point
!
subroutine clip_poly(n,x,y,xc,yc)
  use gildas_def
  use gbl_message
  use greg_interfaces, except_this=>clip_poly
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=size_length), intent(inout) :: n      ! Number of summits (updated, may be 0 on return, may be more)
  real(kind=4),              intent(in)    :: x(:)   !
  real(kind=4),              intent(in)    :: y(:)   !
  real(kind=4),              intent(out)   :: xc(:)  !
  real(kind=4),              intent(out)   :: yc(:)  !
  ! Local
  real(kind=4) :: x0,y0,x1,y1
  integer(kind=size_length) :: i,j,m
  logical :: ok
  !
  ! The last line has a special meaning, because it must be close properly ?
  m = size(xc)
  j = 0
  ok = .false.
  i = 1
  do while (i.lt.n .and. .not.ok)
    x0 = x(i)
    y0 = y(i)
    x1 = x(i+1)
    y1 = y(i+1)
    call clip_one (x0,y0,x1,y1,ok)
    if (ok) then
      xc(1) = x0
      yc(1) = y0
      xc(2) = x1
      yc(2) = y1
      j = 2
    endif
    i = i+1
  enddo
  !
  do while (i.lt.n)
    x0 = x(i)
    y0 = y(i)
    x1 = x(i+1)
    y1 = y(i+1)
    call clip_one (x0,y0,x1,y1,ok)
    if (ok) then
      if (x0.eq.xc(j).and.y0.eq.yc(j)) then
        if (j.eq.m)  goto 10
        j = j+1
        xc(j) = x1
        yc(j) = y1
      elseif (x0.eq.xc(j) .or. y0.eq.yc(j)) then
        if (j.eq.m)  goto 10
        j = j+1
        xc(j) = x0
        yc(j) = y0
        if (j.eq.m)  goto 10
        j = j+1
        xc(j) = x1
        yc(j) = y1
      else
        ! Complex case
        if (xc(j).eq.gx1 .or. xc(j).eq.gx2) then
          if (j.eq.m)  goto 10
          j = j+1
          xc(j) = xc(j-1)
          yc(j) = y0
        else
          if (j.eq.m)  goto 10
          j = j+1
          xc(j) = x0
          yc(j) = yc(j-1)
        endif
        if (j.eq.m)  goto 10
        j = j+1
        xc(j) = x0
        yc(j) = y0
        if (j.eq.m)  goto 10
        j = j+1
        xc(j) = x1
        yc(j) = y1
      endif
    endif
    i = i+1
  enddo
  !
  if (j.ne.0) then
    ! Try to close properly
    if (xc(1).ne.xc(j) .or. yc(1).ne.yc(j)) then
      if (xc(j).eq.gx1 .or. xc(j).eq.gx2) then
        if (j.eq.m)  goto 10
        j = j+1
        xc(j) = xc(j-1)
        yc(j) = yc(1)
      else
        if (j.eq.m)  goto 10
        j = j+1
        xc(j) = xc(1)
        yc(j) = yc(j-1)
      endif
      if (j.eq.m)  goto 10
      j = j+1
      xc(j) = xc(1)
      yc(j) = yc(1)
    endif
  endif
  !
  n = j  ! Update the number of points to the remaining ones.
  return
  !
10 continue
  call greg_message(seve%w,'CLIP','Clipping buffer exhausted')
  n = j  ! Update the number of points to the remaining ones.
  !
end subroutine clip_poly
!
subroutine clip_one (x0,y0,x1,y1,ok)
  use greg_interfaces, except_this=>clip_one
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  real :: x0                        !
  real :: y0                        !
  real :: x1                        !
  real :: y1                        !
  logical :: ok                     !
  ! Local
  real :: x,y
  integer :: c,c0,c1
  !
  ! Change the end-points of the line (X0,Y0) - (X1,Y1)
  ! to clip the line at the window boundary.
  ! The algorithm is that of Cohen and Sutherland (ref: Newman & Sproull)
  !
  ok = .false.
  call grclip(x0,y0,c0)
  call grclip(x1,y1,c1)
  !
  do while (c0.ne.0 .or. c1.ne.0)
    if (iand(c0,c1).ne.0) then ! line is invisible
      return
    endif
    c = c0
    if (c.eq.0) c = c1
    if (iand(c,1).ne.0) then   ! crosses GX1
      y = y0 + (y1-y0)*(gx1-x0)/(x1-x0)
      x = gx1
    elseif (iand(c,2).ne.0) then   ! crosses GX2
      y = y0 + (y1-y0)*(gx2-x0)/(x1-x0)
      x = gx2
    elseif (iand(c,4).ne.0) then   ! crosses GY1
      x = x0 + (x1-x0)*(gy1-y0)/(y1-y0)
      y = gy1
    elseif (iand(c,8).ne.0) then   ! crosses GY2
      x = x0 + (x1-x0)*(gy2-y0)/(y1-y0)
      y = gy2
    endif
    if (c.eq.c0) then
      x0 = x
      y0 = y
      call grclip(x,y,c0)
    else
      x1 = x
      y1 = y
      call grclip(x,y,c1)
    endif
  enddo
  ok = .true.
end subroutine clip_one
