module gtv_svg
  !---------------------------------------------------------------------
  ! Variables and parameters for SVG support
  !---------------------------------------------------------------------
  !
  integer(kind=4), parameter :: svgmap_size = 65536  ! i.e. the most we
    ! can encode in integers of KIND=BITMAP_DEPTH == 2
  integer(kind=4), parameter :: svgmap_offset = -32768  ! i.e. encode the
    ! 65536 colors from -32768 to 32767 == same as PNG because we save
    ! images as embeded PNG
  !
  integer(kind=4), parameter :: strlen=80
  integer(kind=4) :: strpos
  character(len=strlen) :: strbuf
  !
  integer(kind=4) :: olun
  logical :: firstsvg
  !
  ! Current SVG group description. Group factorizes description of
  ! stroke pen colour and fill mode. Other attributes (e.g. dash pattern)
  ! are not factorized
  logical :: newgrp
  character(len=7) :: svgpen_hexacode
  real(kind=4) :: mysvg_pattern(4),mysvg_weight
  logical :: mysvg_dashed,mysvg_fill
  !
end module gtv_svg
!
subroutine svg_open(output,error,dir)
  use gtv_interfaces, except_this=>svg_open
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display),   intent(inout)        :: output  ! Output instance
  logical,            intent(inout)        :: error   !
  type(gt_directory), intent(in), optional :: dir     ! The directory to display
  !
  if (output%svg%cropped .and. present(dir)) then
    ! Crop the area viewed by the PNG instance
    call gt_hardcopy_crop(output,dir,error)
    if (error)  return
  endif
  !
  call svg_zopen(output%file,output%iunit,  &
    output%px1,output%px2,                  &
    output%py1,output%py2,                  &
    error)
  !
end subroutine svg_open
!
subroutine svg_zopen(fich,iunit,px1,px2,py1,py2,error)
  use gildas_def
  use gbl_message
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>svg_zopen
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: fich   !
  integer(kind=4),  intent(in)    :: iunit  !
  integer(kind=4),  intent(in)    :: px1    ! First pixel in X
  integer(kind=4),  intent(in)    :: px2    ! Last  pixel in X
  integer(kind=4),  intent(in)    :: py1    ! First pixel in Y
  integer(kind=4),  intent(in)    :: py2    ! Last  pixel in Y
  logical,          intent(inout) :: error  !
  ! Local
  integer(kind=4) :: wx,wy
  integer(kind=4) :: ier
  !
  ! Sanity
  if (iunit.ne.6 .and. fich.eq.'') then
    call gtv_message(seve%e,'SVG','Missing file name')
    error = .true.
    return
  endif
  !
  olun = iunit  ! Should work...?
  if (iunit.ne.6) then
    open(unit=olun,file=fich,status='UNKNOWN',iostat=ier)
    if (ier.ne.0) then
      error = .true.
      call putios ('E-SVG,  ',ier)
      return
    endif
  endif
  !
  strpos = -1
  newgrp = .true.
  !
  wx = abs(px2-px1)+1
  if (wx.lt.32) wx = 32
  wy = abs(py2-py1)+1
  if (wy.lt.32) wy = 32
  !
  firstsvg = .true.
  write (olun,'(A,A,A,I0,A,I0,A)')                  &
    '<svg xmlns="http://www.w3.org/2000/svg"',      &
    ' xmlns:xlink="http://www.w3.org/1999/xlink"',  &
    ' width="',wx,'" height="',wy,                  &
    '">'
  ! Add this attribute if you want to avoid line antialiasing
  !    shape-rendering="crispEdges"
  ! Found no solution to avoid bitmap smoothing.
  !
end subroutine svg_zopen
!
subroutine svg_pen_rgb(r,g,b)
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  ! Set the current pen color from the R G B values (0-255)
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: r,g,b
  ! Local
  character(len=7) :: newcode
  !
  write(newcode,'(A1,3(Z2.2))') '#',r,g,b
  if (newcode.ne.svgpen_hexacode) then
    call svg_group_close
    svgpen_hexacode = newcode
  endif
end subroutine svg_pen_rgb
!
subroutine svg_setfill(fill)
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !  Set the polygon filling status
  !---------------------------------------------------------------------
  logical, intent(in) :: fill
  !
  if (fill.neqv.mysvg_fill) then
    call svg_group_close
    mysvg_fill = fill
  endif
  !
end subroutine svg_setfill
!
subroutine svg_dash(out,dashed,pattern)
  use gtv_interfaces, except_this=>svg_dash
  use gtv_svg
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out
  logical,          intent(in) :: dashed
  real(kind=4),     intent(in) :: pattern(4)
  ! Local
  integer(kind=4) :: i
  real(kind=4) :: gsclx,gscly,opattern(4)
  !
  opattern(:) = mysvg_pattern(:)
  !
  if (dashed) then
    call get_scale_awd(out,gsclx,gscly)
    do i=1,4
      mysvg_pattern(i) = pattern(i)*gsclx
    enddo
  endif
  !
  if (mysvg_dashed.neqv.dashed) then  ! Active vs inactive
    call svg_group_close
  elseif (dashed) then  ! Old and new are active. Same pattern?
    if (any(opattern.ne.mysvg_pattern))  call svg_group_close
  endif
  !
  mysvg_dashed = dashed
  !
end subroutine svg_dash
!
subroutine svg_weigh(out,width)
  use gtv_interfaces, except_this=>svg_weigh
  use gtv_svg
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out
  real(kind=4),     intent(in) :: width
  ! Local
  real(kind=4) :: gsclx,gscly,newwei
  !
  call get_scale_awd(out,gsclx,gscly)
  ! Line width is at least 0.7 pixel so that PEN /WEIGHT 1 gives a
  ! nice result on screen. Going below makes the default weight too
  ! light.
  newwei = max(width*gsclx,0.7)
  if (newwei.ne.mysvg_weight) then
    call svg_group_close
    mysvg_weight = newwei
  endif
  !
end subroutine svg_weigh
!
subroutine svg_group_open
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !  Open a new group containing the next graphical elements.
  !---------------------------------------------------------------------
  !
  strpos = 1
  !
  ! Stroking pen
  write(strbuf(strpos:),'(3A)') '<g stroke="',svgpen_hexacode,'"'
  strpos = len_trim(strbuf)
  !
  ! Dash pattern
  if (mysvg_dashed) then
    write(strbuf(strpos+2:),'(A,4(F0.2,A1))') 'stroke-dasharray="',  &
                                              mysvg_pattern(1),',',  &
                                              mysvg_pattern(2),',',  &
                                              mysvg_pattern(3),',',  &
                                              mysvg_pattern(4),'"'
    strpos = len_trim(strbuf)
  endif
  !
  ! Pen weight
  if (strpos.ge.strlen-20) then
    write(olun,'(A)') strbuf(1:strpos)
    strpos = -1
  endif
  ! Always set; when stroke-width is not defined, the resulting width is something
  ! in between PEN /WEIGHT 1 and 3.
  write(strbuf(strpos+2:),'(A,F0.2,A)') 'stroke-width="',mysvg_weight,'"'
  strpos = len_trim(strbuf)
  !
  ! Filling colour
  if (strpos.ge.strlen-15) then
    write(olun,'(A)') strbuf(1:strpos)
    strpos = -1
  endif
  if (mysvg_fill) then
    write(strbuf(strpos+2:),'(3A)') 'fill="',svgpen_hexacode,'"'
  else
    write(strbuf(strpos+2:),'(A)') 'fill="none"'
  endif
  strpos = len_trim(strbuf)
  !
  strpos = strpos+1
  write(strbuf(strpos:strpos),'(A)') '>'
  !
  ! Flush
  write(olun,'(A)') strbuf(1:strpos)
  strpos = 0
  !
  newgrp = .false.  ! No new group needed until something changes
  !
end subroutine svg_group_open
!
subroutine svg_group_close
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !  Close the current group
  !---------------------------------------------------------------------
  !
  if (.not.firstsvg)  call svg_stroke
  if (newgrp)  return
  !
  write(olun,'(A)') '</g>'
  strpos = 0
  !
  newgrp = .true.  ! New group needed next time a new element is drawn
  !
end subroutine svg_group_close
!
subroutine svg_moveto(out,x,y,fill)
  use gtv_interfaces, except_this=>svg_moveto
  use gtv_svg
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out
  real(kind=4),     intent(in) :: x,y
  logical,          intent(in) :: fill  ! Start a filled polygon?
  !
  if (.not.firstsvg)  call svg_stroke
  call svg_setfill(fill)
  if (newgrp)  call svg_group_open
  !
  ! Open line
  strpos = 1
  ! write(strbuf(strpos:),'(3A)') '<polyline stroke="',svgpen_hexacode,'"'
  write(strbuf(strpos:),'(A)') '<polyline'
  strpos = len_trim(strbuf)
  !
  ! Now the list of points
  write(strbuf(strpos+2:),'(A)') 'points='
  strpos = len_trim(strbuf)
  if (strpos.ge.strlen-16) then
    ! No room for first pair of "xxx,yyy": split line
    write(olun,'(A)') strbuf(1:strpos)
    strpos = 0
  endif
  write(strbuf(strpos+1:strpos+1),'(A)') '"'
  ! Do not increment strpos: see svg_lineto
  !
  call svg_lineto(out,x,y)
  firstsvg=.false.
  !
end subroutine svg_moveto
!
subroutine svg_lineto(out,x,y)
  use gtv_interfaces, except_this=>svg_lineto
  use gtv_svg
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out
  real(kind=4),     intent(in) :: x,y
  ! Local
  real(kind=4) :: xend,yend
  !
  if (strpos.ge.strlen-16) then
    write(olun,'(A)') strbuf(1:strpos)
    strpos = -1
  endif
  !
  call world_to_pixel(out,x,y,xend,yend)
  !
  ! ---------------------
  !  BOUNDARY conditions
  !
  ! The way the scale is defined (see details in subroutine get_scale_awd) for
  ! cropped SVG, there must be one (poly)line summit which starts exactly at the
  ! left of the device, i.e. left of first pixel, i.e. coordinate 0.0 (SVG pixels
  ! run e.g. in the range ]0:1] for pixel #1). We want (for N+1 pixels, numbered
  ! from 0 to N):
  !  Left  boundary =    0.0 -> pixel #0
  !  Right boundary =  N+1.0 -> pixel #N
  !
  if (xend.le.out%px1)    xend = out%px1 + 0.01  ! .le. because boundary is excluded, need epsilon above
  if (xend.gt.out%px2+1)  xend = out%px2 + 1.0
  if (yend.le.out%py2)    yend = out%py2 + 0.01  ! Same. Note also py2<py1 with SVG
  if (yend.gt.out%py1+1)  yend = out%py1 + 1.0
  ! ---------------------
  !
  write(strbuf(strpos+2:),'(F0.2,A,F0.2)')  xend,',',yend
  strpos = len_trim(strbuf)
  !
end subroutine svg_lineto
!
subroutine svg_close
  use gtv_interfaces, except_this=>svg_close
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  !
  ! Close current line
  if (.not.firstsvg)  call svg_stroke
  if (.not.newgrp)  call svg_group_close
  !
  write(olun,'(A)') '</svg>'
  !
  if (olun.ne.6)  close(olun)
  !
end subroutine svg_close
!
subroutine svg_stroke
  use gtv_interfaces, except_this=>svg_stroke
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  !
  if (strpos.ge.1) then
    write(olun,'(2A)') strbuf(1:strpos),'"/>'
    strpos = -1
  endif
  !
  firstsvg = .true.
  !
end subroutine svg_stroke
!
subroutine svg_fill(out,n,x,y)
  use gtv_interfaces, except_this=>svg_fill
  use gtv_svg
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out
  integer(kind=4),  intent(in) :: n
  real(kind=4),     intent(in) :: x(n)
  real(kind=4),     intent(in) :: y(n)
  ! Local
  integer(kind=4) :: i
  !
  call svg_moveto(out,x(1),y(1),.true.)
  do i=2,n
    call svg_lineto(out,x(i),y(i))
  enddo
  !
end subroutine svg_fill
!
subroutine svg_points(out,n,xr,yr)
  use gtv_interfaces, except_this=>svg_points
  use gtv_types
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out
  integer(kind=4),  intent(in) :: n
  real(kind=4),     intent(in) :: xr(n)
  real(kind=4),     intent(in) :: yr(n)
  ! Local
  integer(kind=4) :: i
  real(kind=4) :: xp,yp
  !
  if (n.le.0) return
  !
  ! Close the group used for polylines, we will create a new one after
  call svg_group_close()
  !
  if (n.eq.1) then
    call world_to_pixel(out,xr(1),yr(1),xp,yp)
    write(olun,'(2(A,F0.2),3A)')  &
      '<circle cx="',xp,'" cy="',yp,'" r=".4" stroke="',svgpen_hexacode,'"/>'
    !
  else
    ! More than 1 point: create a group, factorizing the stroke attribute
    write(olun,'(3A)')  '<g stroke="',svgpen_hexacode,'">'
    !
    do i=1,n
      call world_to_pixel(out,xr(i),yr(i),xp,yp)
      write(olun,'(2(A,F0.2),3A)')  &
        '<circle cx="',xp,'" cy="',yp,'" r=".4"/>'
    enddo
    !
    ! End of group
    write(olun,'(A)') '</g>'
  endif
  !
end subroutine svg_points
!
subroutine svg_image_inquire(map_size,map_offset,map_color,map_static)
  use gtv_interfaces, except_this=>svg_image_inquire
  use gtv_svg
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=4), intent(out) :: map_size    !
  integer(kind=4), intent(out) :: map_offset  !
  logical,         intent(out) :: map_color   !
  logical,         intent(out) :: map_static  !
  !
  map_size = svgmap_size
  map_offset = svgmap_offset
  map_color = .true.
  map_static = .false.  ! SVG filler is not able to provide one LUT per
                        ! image of the plot.
  !
end subroutine svg_image_inquire
!
subroutine gti_svgimage(svgoutput,image,error)
  use gildas_def
  use gbl_message
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gti_svgimage
  use gtv_bitmap
  use gtv_buffers
  use gtv_svg
  use gtv_tree
  use gtv_plot
  !---------------------------------------------------------------------
  ! @ private
  ! Specifique au protocole SVG
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: svgoutput  ! The whole SVG output description
  type(gt_image),   intent(in)    :: image      ! Image instance
  logical,          intent(inout) :: error      ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SVG'
  real(kind=4) :: clip(4),trans(4),desc(4),resfact
  integer(kind=4) :: window(4),ier
  type(gt_lut), pointer :: lut
  type(gt_bitmap) :: bitmap
  logical :: visible
  type(gt_display) :: pngoutput
  !
  ! Set up a dedicated PNG output instance
  pngoutput%tofile = .false.  ! i.e. do not write to a file but to a memory buffer
  pngoutput%file = ''
  pngoutput%iunit = svgoutput%iunit
  pngoutput%dev => svgoutput%dev  ! ZZZ incorrect
  pngoutput%gx1 = image%position(1)
  pngoutput%gx2 = image%position(2)
  pngoutput%gy1 = image%position(3)
  pngoutput%gy2 = image%position(4)
  ! The native image size is reused at clipping time; this allows for 1-to-1
  ! pixel hardcopy if possible.
  pngoutput%px1 = 1
  pngoutput%px2 = image%r%taille(1)
  pngoutput%py1 = 1
  pngoutput%py2 = image%r%taille(2)
  pngoutput%color            = svgoutput%color
  pngoutput%background       = 1  ! White
  pngoutput%png%transparency = .false.
  pngoutput%png%cropped      = .false.  ! Computed by hand below
  pngoutput%png%noblank      = .false.
  !
  ! Check the clipping box
  ! Resampling is needed if the image has to be cut (in particular if we clip
  ! in the middle of a pixel). Since PNG can not represent fractional pixels,
  ! we have to oversample the output image is smaller pixels, hoping that they
  ! will be small enough to align near the clipping line. On the other hand,
  ! we do not want to oversample too much because the file weight will explode.
  ! Note that the same happens on screen with a huge number of tiny pixels.
  ! Knowing this, the resampling factor is set as a function of native pixels.
  ! Typically:
  !  100 resampling pixels per native pixel if 1 native pixel,
  !   10 resampling pixels per native pixel if 10 native pixels,
  !    1 resampling pixel  per native pixel if 100 native pixels or more
  resfact = maxval( (/ 100./image%r%taille(1),  &
                       100./image%r%taille(2),  &
                       1.  /) )
  ! To be improved:
  !  1) there should be no resampling if the image is clipped at any pixel
  !     boundary (just extraction of the proper subset)
  !  2) resampling should be a function of the clipped image, not the total
  !     native image.
  !
  call clip_image(pngoutput, &
    image%r%taille(1),       &
    image%r%taille(2),       &
    image%conv,              &
    image%position,          &
    image%limits,            &
    .false.,                 &  ! Do not resample if possible
    resfact,                 &  ! No extra resampling factor if resampling
    visible,clip,window,trans)
  if (.not.visible)  return
  !
  ! Trick post-clipping: whatever the size of the SVG device, the PNG is a
  ! subset of this device (which is not aware of its host) and must match
  ! the clipped dimensions, from 1 to N in each dimension. In PNG full
  ! hardcopies, the image fills only a subset of the PNG output. In this case
  ! its not.
  pngoutput%px1 = 1
  pngoutput%px2 = window(1)
  pngoutput%py1 = 1
  pngoutput%py2 = window(2)
  window(3) = 1  ! Consistently
  window(4) = 1
  !
  call png_open(pngoutput,error)
  if (error)  return
  !
  if (.not.image%isrgb) then
    ! Image is indexed: which LUT use?
    if (associated(image%lut)) then
      lut => image%lut  ! Custom LUT
      ! ZZZ
      call gti_lut(svgoutput,lut)  ! Load this LUT, in case it is not yet
    else
      lut => gbl_colormap  ! Global LUT
    endif
  endif
  !
  ! Allocate the new resampled image
  bitmap%size(1) = window(1)
  bitmap%size(2) = window(2)
  bitmap%position(1) = window(3)
  bitmap%position(2) = window(4)
  bitmap%trans = trans
  if (image%isrgb) then
    allocate(bitmap%irvalues(window(1),window(2)),  &
             bitmap%igvalues(window(1),window(2)),  &
             bitmap%ibvalues(window(1),window(2)),stat=ier)
  else
    allocate(bitmap%irvalues(window(1),window(2)),stat=ier)
    bitmap%igvalues => null()
    bitmap%ibvalues => null()
  endif
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,'Memory allocation failure')
    return
  endif
  !
  call svg_image_open(svgoutput,image%position,desc)
  call gti_pngmap(image,pngoutput,bitmap,lut)
  call png_close(pngoutput,desc)
  !
  if (associated(bitmap%irvalues))  deallocate(bitmap%irvalues)
  if (associated(bitmap%igvalues))  deallocate(bitmap%igvalues)
  if (associated(bitmap%ibvalues))  deallocate(bitmap%ibvalues)
  !
end subroutine gti_svgimage
!
subroutine svg_image_open(svgout,svgpos,desc)
  use gtv_interfaces, except_this=>svg_image_open
  use gtv_svg
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(in)  :: svgout
  real(kind=4),     intent(in)  :: svgpos(4)  ! Image position in the SVG device
  real(kind=4),     intent(out) :: desc(4)    ! Image description (reference position, size)
  ! Local
  real(kind=4) :: wx,wy
  !
  if (.not.firstsvg)  call svg_stroke
  !
  ! Position (in device units). Beware that the reference position
  ! is given from the top-left corner in SVG
  call world_to_pixel(svgout,svgpos(1),svgpos(4),desc(1),desc(2))
  !
  ! Size (in device units)
  wx = svgpos(2)-svgpos(1)
  wy = svgpos(4)-svgpos(3)
  call world_to_pixel_size(svgout,wx,wy,desc(3),desc(4))
  !
end subroutine svg_image_open
