!-----------------------------------------------------------------------
! ZZZ Attacher du texte aux png
! ZZZ Quid si l'utilisateur a modifie ses pens?
! ZZZ DEVICE PNG BLACK devrait changer cette variable x_back (dans le
!     tdf) (cf combinaison grey+black)
! ZZZ En mode grey, la couleur des segments est mal convertie.
! ZZZ Utilisation en device principal? CLEAR?
! ZZZ Tout documenter
! ZZZ Renommer gi4_bltlis.
! ZZZ Supprimer les globaux en C puis Fortran
!-----------------------------------------------------------------------
!
module gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! Variables and parameters for PNG devices support
  !---------------------------------------------------------------------
  !
  integer(kind=4), parameter :: pngmap_size = 65536  ! i.e. the most we
    ! can encode in integers of KIND=BITMAP_DEPTH == 2
  integer(kind=4), parameter :: pngmap_offset = -32768  ! i.e. encode the
    ! 65536 colors from -32768 to 32767
  !
  ! Some integer*1 typical values
  integer(kind=1) :: i0,i255
  integer(kind=1) :: dummy  ! Used when some of the channels are not used
  !
end module gtv_png
!
subroutine png_open(output,error,dir)
  use gtv_interfaces, except_this=>png_open
  use gtv_png
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Open the PNG output file.
  !---------------------------------------------------------------------
  type(gt_display),   intent(inout)        :: output  ! Output instance
  logical,            intent(inout)        :: error   ! Logical error flag
  type(gt_directory), intent(in), optional :: dir     ! The directory to display, or
#if defined(PNG)
  ! Local
  character(len=*), parameter :: rname='PNG_OPEN'
  integer :: ier,npixx,npixy
  integer(kind=1) :: ibackground,itransparency
  character(len=message_length) :: mess
  !
  if (output%file.eq.' ' .and. output%tofile) then
    call gtv_message(seve%e,rname,'File name is missing')
    error = .true.
    return
  endif
  !
  ! Initialize some shared values
  i0   = si4_to_ui1(0)
  i255 = si4_to_ui1(255)
  !
  ! Black or white device?
  if (output%background.eq.0) then
    ibackground = i0
  else
    ibackground = i255
  endif
  !
  ! Transparent background or not?
  if (output%png%transparency) then
    itransparency = i0
  else
    itransparency = i255
  endif
  !
  ! Set number of channels (planes). Use it also as a unique identifier since
  ! there is no ambiguity between the number of channels and the different
  ! available devices.
  if (output%color) then
    output%png%nchan = 3
  else
    output%png%nchan = 1  ! (grey)
  endif
  if (output%png%transparency)  output%png%nchan = output%png%nchan+1
  !
  if (output%png%cropped .and. present(dir)) then
    ! Crop the area viewed by the PNG instance
    call gt_hardcopy_crop(output,dir,error)
    if (error)  return
  endif
  !
  ! Use the actual number of pixels of the output instance.
  npixx = output%px2
  npixy = output%py2
  !
  ! Buffer allocation
  select case (output%png%nchan)
  case(1)
    allocate(output%png%R(npixx,npixy),stat=ier)
  case(2)
    allocate(output%png%R(npixx,npixy),  &
             output%png%A(npixx,npixy),stat=ier)
  case(3)
    allocate(output%png%R(npixx,npixy),  &
             output%png%G(npixx,npixy),  &
             output%png%B(npixx,npixy),stat=ier)
  case(4)
    allocate(output%png%R(npixx,npixy),  &
             output%png%G(npixx,npixy),  &
             output%png%B(npixx,npixy),  &
             output%png%A(npixx,npixy),stat=ier)
  case default
    call gtv_message(seve%e,rname,"Internal error, unsupported number of channels")
    error = .true.
    return
  end select
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,"Internal error, R/G/B/A allocation failed")
    error = .true.
    return
  endif
  !
  ier = gpng_zopen(output%file,len_trim(output%file),npixx,npixy,output%png%nchan)
  if (ier.ne.0) then
    write(mess,'(A,A,A,3(I0,A))') 'Error creating file ',trim(output%file),  &
      ': ',npixx,' x ',npixy,' pixels x ',output%png%nchan,' channels'
    call gtv_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Initialize the arrays
  output%png%R = ibackground
  if (output%png%nchan.ge.3) then
    output%png%G = ibackground
    output%png%B = ibackground
  endif
  if (output%png%transparency)  output%png%A = itransparency
  !
  ! Initialize the colormap
  ! ZZZ Do something: we may not want to use LUT 0 e.g. in grey mode
  ! call load_lut(output%map,.true.,output%color,0,error)
  ! if (error)  return
  !
#else
  call gtv_message(seve%e,'HARDCOPY','No PNG support on this system')
  error = .true.
  return
#endif
  !
end subroutine png_open
!
subroutine png_close(output,desc)
  use gtv_interfaces, except_this=>png_close
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Close the current PNG device, i.e. copy the rows to the file
  ! opened by the C routines, and close it.
  !---------------------------------------------------------------------
  type(gt_display),       intent(inout) :: output
  real(kind=4), optional, intent(in)    :: desc(4)
#if defined(PNG)
  ! Local
  integer(kind=4) :: row
  !
  do row=output%py2,1,-1
    select case (output%png%nchan)
    case (1)
      call gpng_copy_data(row,  &
                          output%png%R(1,row),  &
                          dummy,                &
                          dummy,                &
                          dummy)
    case (2)
      call gpng_copy_data(row,  &
                          output%png%R(1,row),  &
                          dummy,                &
                          dummy,                &
                          output%png%A(1,row))
    case (3)
      call gpng_copy_data(row,  &
                          output%png%R(1,row),  &
                          output%png%G(1,row),  &
                          output%png%B(1,row),  &
                          dummy)
    case (4)
      call gpng_copy_data(row,  &
                          output%png%R(1,row),  &
                          output%png%G(1,row),  &
                          output%png%B(1,row),  &
                          output%png%A(1,row))
    end select
  enddo
  !
  call gpng_finish()
  !
  if (.not.output%tofile)  call png_base64(output,desc)
  !
  call gpng_cleanup()
  !
  if (allocated(output%png%R)) deallocate(output%png%R)
  if (allocated(output%png%G)) deallocate(output%png%G)
  if (allocated(output%png%B)) deallocate(output%png%B)
  if (allocated(output%png%A)) deallocate(output%png%A)
  !
#endif
end subroutine png_close
!
subroutine png_base64(output,desc)
  use gildas_def
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>png_base64
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Dump the PNG currently in memory with base 64 encoding. This makes
  ! sense only for memory only PNG, which have no associated file on
  ! disk.
  !  Because the output is not the (binary) PNG but an encoded form,
  ! a header and footer are added.
  !---------------------------------------------------------------------
  type(gt_display),       intent(in) :: output
  real(kind=4), optional, intent(in) :: desc(4)
#if defined(PNG)
  ! Local
  integer(kind=4) :: memory(2),size
  integer(kind=address_length) :: addr,ip
  !
  ! Get the memory buffer address
  call gpng_getbuf(size,addr)  ! ZZZ sanity check
  !
  ! --- Header ---
  !
  if (present(desc)) then
    ! Reference position and image size (in device units), suited for
    ! embedding in SVG
    !
    write(output%iunit,'(5(A,F0.1))')  &
      '<image preserveAspectRatio="none" x="',desc(1),'" y="',desc(2),  &
      '" width="',desc(3),'" height="',desc(4),'" xlink:href="data:image/png;base64,'
    !
  else
    ! More basic header. Relative position does not make sense
    write(output%iunit,'(A,I0,A,I0,A)')  &
      '<image width="',output%px2,'" height="',output%py2,'" xlink:href="data:image/png;base64,'
  endif
  !
  ! --- Data ---
  ! Pass the C buffer and convert it to base-64
  ip = gag_pointer(addr,memory)
  call base64_encode(memory(ip),size,output%iunit)
  !
  ! --- Footer ---
  write(output%iunit,'(A)') '"/>'
  !
#endif
end subroutine png_base64
!
subroutine png_hard(out)
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out  !
  !
  ! Dash
  if (out%idashe.ne.1) then
    out%dev%hardw_line_dash = .false.
  else
    out%dev%hardw_line_dash = .true.
  endif
  !
  ! Weight. Always use hardware thickness generator. Take care
  ! that simulating thickness with gtx_chopper draws several lines
  ! on each side of the original line, which can lead to negative
  ! positions in cropped PNG => error!
  out%dev%hardw_line_weig = .true.
  !
end subroutine png_hard
!
subroutine png_pen_negative(out)
  use gtv_interfaces, except_this=>png_pen_negative
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Set the current pen as negative, i.e. invert pixels below
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out  ! The PNG instance
#if defined(PNG)
  !
  out%png%negative = .true.
  ! Put some grey just safety. Normally unused.
  out%png%rpen = si4_to_ui1(128)
  out%png%gpen = si4_to_ui1(128)
  out%png%bpen = si4_to_ui1(128)
  !
#endif
end subroutine png_pen_negative
!
subroutine png_pen_rgb(out,r,g,b)
  use gtv_interfaces, except_this=>png_pen_rgb
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Set the current pen from the input R G B values (0-255)
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out    ! The PNG instance
  integer(kind=4),  intent(in)    :: r,g,b  !
#if defined(PNG)
  !
  out%png%negative = .false.
  out%png%rpen = si4_to_ui1(r)
  out%png%gpen = si4_to_ui1(g)
  out%png%bpen = si4_to_ui1(b)
  !
#endif
end subroutine png_pen_rgb
!
subroutine png_weigh(out,width)
  use gtv_interfaces, except_this=>png_weigh
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Set the current pen width. Note that we may get a 0 width, which
  ! means "hairline" (smallest possible on the device)
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out    ! The PNG instance
  integer(kind=4),  intent(in)    :: width  ! New pen width (pixels)
  !
  out%png%width = max(width,1)
end subroutine png_weigh
!
subroutine png_moveto(out,x,y)
  use gtv_interfaces, except_this=>png_moveto
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Move the pen to the input location
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out  ! Input gt_display
  real(kind=4),     intent(in)    :: x,y  ! New pen coordinates, in world coordinates
  !
  call world_to_pixel(out,x,y,out%png%xpos,out%png%ypos)
  !
end subroutine png_moveto
!
subroutine png_lineto(out,x,y)
  use gtv_interfaces, except_this=>png_lineto
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Draw a line from current pen position to input location, simulating
  ! its thickness if needed.
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out  ! Input gt_display
  real(kind=4),     intent(in)    :: x,y  ! Draw line down to this location, in world coordinates
  ! Local
  real(kind=4) :: xend,yend
  !
  call world_to_pixel(out,x,y,xend,yend)
  !
  call png_wline(out,out%png%xpos,out%png%ypos,xend,yend)
  !
  out%png%xpos = xend
  out%png%ypos = yend
  !
end subroutine png_lineto
!
subroutine png_wline(out,xr1,yr1,xr2,yr2)
  use gtv_interfaces, except_this=>png_wline
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Draw a line from (x1,y1) to (x2,y2), simulating its width by
  ! drawing several 1-pixel lines
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out      ! Input gt_display
  real(kind=4),     intent(in) :: xr1,yr1  !
  real(kind=4),     intent(in) :: xr2,yr2  !
  ! Local
  real(kind=4) :: dx,dy
  integer(kind=4) :: iw,x1,x2,y1,y2,start
  !
  if ((xr2-xr1).gt.(yr2-yr1)) then
    ! Line is rather horizontal
    dx = 0.
    dy = 1.
  else
    ! Line is rather vertical
    dx = 1.
    dy = 0.
  endif
  !
  if (out%png%width.eq.1) then
    start = 0
  else
    start = -out%png%width/2
  endif
  do iw=start,start+out%png%width-1
    !
    x1 = nint(xr1+iw*dx)
    y1 = nint(yr1+iw*dy)
    x2 = nint(xr2+iw*dx)
    y2 = nint(yr2+iw*dy)
    !
    ! ---------------------
    !  BOUNDARY conditions
    !
    ! The way the scale is defined (see details in subroutine get_scale_awd) for
    ! cropped PNG, 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.5. Same for
    ! right limit. Because of nint() rounding, this means that these coordinates
    ! may overflow beyond the device range. No better way than bringing them back
    ! into the range. Again, this is for the boundary conditions where we want:
    !  Left  boundary =   0.5 -> pixel 1
    !  Right boundary = N+0.5 -> pixel N
    ! nint() does not satisfy this rule... Apart from this boundary problem, nint()
    ! is correct. If a line summit is exactly at position i+0.5, we can ambiguously
    ! make it start in pixel i or i+1. We let nint() decide arbitrarily.
    if (x1.lt.out%px1)  x1 = out%px1
    if (x1.gt.out%px2)  x1 = out%px2
    if (x2.lt.out%px1)  x2 = out%px1
    if (x2.gt.out%px2)  x2 = out%px2
    if (y1.lt.out%py1)  y1 = out%py1
    if (y1.gt.out%py2)  y1 = out%py2
    if (y2.lt.out%py1)  y2 = out%py1
    if (y2.gt.out%py2)  y2 = out%py2
    ! ---------------------
    !
    call png_line(out,x1,y1,x2,y2)
    !
  enddo
  !
end subroutine png_wline
!
subroutine png_line(out,x1,y1,x2,y2)
  use gtv_interfaces, except_this=>png_line
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Draw a 1 pixel-wide line from (x1,y1) to (x2,y2), using Bresenham
  ! algorithm. See e.g.
  !  http://tech-algorithm.com/articles/drawing-line-using-bresenham-algorithm/
  !---------------------------------------------------------------------
  type(gt_display), intent(in) :: out    ! Input gt_display
  integer(kind=4),  intent(in) :: x1,y1  !
  integer(kind=4),  intent(in) :: x2,y2  !
  ! Local
  integer(kind=4) :: x,y,dx1,dy1,dx2,dy2
  integer(kind=4) :: w,h,longest,shortest,numerator,i
  !
  dx1 = 0
  dy1 = 0
  dx2 = 0
  dy2 = 0
  !
  w = x2-x1
  h = y2-y1
  !
  if (w.lt.0) then
    dx1 = -1
  elseif (w.gt.0) then
    dx1 = +1
  endif
  if (h.lt.0) then
    dy1 = -1
  elseif (h.gt.0) then
    dy1 = +1
  endif
  if (w.lt.0) then
    dx2 = -1
  elseif (w.gt.0) then
    dx2 = +1
  endif
  !
  longest = abs(w)
  shortest = abs(h)
  if (longest.le.shortest) then
    longest = abs(h)
    shortest = abs(w)
    if (h.lt.0) then
      dy2 = -1
    elseif (h.gt.0) then
      dy2 = +1
    endif
    dx2 = 0
  endif
  !
  numerator = longest/2
  x = x1
  y = y1
  do i=0,longest
    call png_point(out,x,y)
    numerator = numerator+shortest
    if (numerator.ge.longest) then
      numerator = numerator-longest
      x = x+dx1
      y = y+dy1
    else
      x = x+dx2
      y = y+dy2
    endif
  enddo
  !
end subroutine png_line
!
subroutine png_fill(out,n,xr,yr)
  use gtv_interfaces, except_this=>png_fill
  use gtv_types
  use gtv_png
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ private
  ! Fill the input polygon
  !---------------------------------------------------------------------
  ! ZZZ Nettoyer cette routine (noms, etc)
  type(gt_display), intent(inout) :: out    ! Input gt_display
  integer,          intent(in)    :: n      ! Number of summits
  real*4,           intent(in)    :: xr(n)  ! X coordinates, in world units
  real*4,           intent(in)    :: yr(n)  ! Y coordinates, in world units
  ! Local
  integer(kind=4) :: i,iy,lnx,nr(2),j, miny, maxy
  integer(kind=4) :: x(n),y(n),ixl(n),ixu(n)  ! Automatic arrays
  !
  ! Calculation of pixel coordinates
  miny = min(out%py1,out%py2)  ! ZZZ Check this
  maxy = max(out%py1,out%py2)
  do i = 1, n
    call world_to_pixel(out,xr(i),yr(i),x(i),y(i))
    miny = min(miny, y(i))
    maxy = max(maxy, y(i))
  enddo
  !
  nr(1) = n
  do iy = miny,maxy
    ! Calculate all x inside the polygons for row #iy
    call gi4_bltlis(1,1,1,nr,x,y,iy,lnx,ixl,ixu)
    do j = 1, lnx
      call png_line(out,ixl(j),iy,ixu(j),iy)
    enddo
  enddo
  !
end subroutine png_fill
!
subroutine png_points(out,n,xr,yr)
  use gtv_interfaces, except_this=>png_points
  use gtv_types
  use gtv_png
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ private
  !   Draw dot-points at input coordinates (world units)
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out    ! Input gt_display
  integer(kind=4),  intent(in)    :: n      ! Number of summits
  real(kind=4),     intent(in)    :: xr(n)  ! X coordinates, in world units
  real(kind=4),     intent(in)    :: yr(n)  ! Y coordinates, in world units
  ! Local
  integer(kind=4) :: i
  integer(kind=4) :: xp,yp
  !
  do i=1,n
    call world_to_pixel(out,xr(i),yr(i),xp,yp)
    call png_point(out,xp,yp)
  enddo
  !
end subroutine png_points
!
subroutine gti_pngimage(out,image)
  use gtv_interfaces, except_this=>gti_pngimage
  use gildas_def
  use gtv_bitmap
  use gtv_buffers
  use gtv_plot
  use gtv_types
  use gtv_tree
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Load the image to be drawn in the PNG device
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out    ! Input gt_display
  type(gt_image),   intent(in)    :: image  ! Image instance
  ! Local
  character(len=*), parameter :: rname='PNGIMAGE'
  real(kind=4) :: clip(4),trans(4)
  integer(kind=4) :: window(4),ier
  type(gt_lut), pointer :: lut
  type(gt_bitmap) :: bitmap
  logical :: visible
  character(len=message_length) :: mess
  !
  ! Check the clipping box
  call clip_image(out,  &
    image%r%taille(1),  &
    image%r%taille(2),  &
    image%conv,         &
    image%position,     &
    image%limits,       &
    .true.,             &  ! Always resample to device pixels
    1.0,                &  ! Resampling factor (1 = no extra factor)
    visible,clip,window,trans)
  if (.not.visible)  return
  !
  ! Some debuging feedback
  write(mess,'(5(A,I0))')  'Image size is ',window(1),'x',window(2),  &
    ', corner at position (',window(3),',',window(4),') in the PNG'
  call gtv_message(seve%d,rname,mess)
  write(mess,'(A,F0.7,A,F0.7,A)')  'Ximag(Xpng) = ',trans(2),' + ',trans(1),'*Xpng'
  call gtv_message(seve%d,rname,mess)
  write(mess,'(A,F0.7,A,F0.7,A)')  'Yimag(Xpng) = ',trans(4),' + ',trans(3),'*Ypng'
  call gtv_message(seve%d,rname,mess)
  !
  if (.not.image%isrgb) then
    ! Image is indexed: which LUT use?
    if (associated(image%lut)) then
      lut => image%lut  ! Custom LUT
      call gti_lut(out,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
  !
  ! Get it from memory...
  call gti_pngmap(image,out,bitmap,lut)
  !
  if (associated(bitmap%irvalues))  deallocate(bitmap%irvalues)
  if (associated(bitmap%igvalues))  deallocate(bitmap%igvalues)
  if (associated(bitmap%ibvalues))  deallocate(bitmap%ibvalues)
  !
end subroutine gti_pngimage
!
subroutine gti_pngmap(image,output,bitmap,lut)
  use gtv_interfaces, except_this=>gti_pngmap
  use gildas_def
  use gtv_png
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Draw the image in the PNG device.
  !---------------------------------------------------------------------
  type(gt_image),   intent(in)    :: image   ! The image to be displayed
  type(gt_display), intent(inout) :: output  ! gt_display instance
  type(gt_bitmap),  intent(inout) :: bitmap  !
  type(gt_lut),     intent(in)    :: lut     ! Colormap to use
  ! Local
  integer :: ncol,offset
  !
  ! Use colour MAP_SIZE for blanking, so there are MAP_SIZE-1 colour
  ! available, from 1 to MAP_SIZE-1...
  ncol = output%dev%map_size-1
  offset = output%dev%map_offset
  !
  call compute_bitmap(image,bitmap,ncol,offset)
  !
  if (output%color) then
    if (image%isrgb) then
      call png_image_rgb_color(output,bitmap)
    else
      call png_image_ind_color(output,bitmap,lut)
    endif
  else
    if (image%isrgb) then
      call png_image_rgb_grey(output,bitmap)
    else
      call png_image_ind_grey(output,bitmap,lut)
    endif
  endif
  !
end subroutine gti_pngmap
!
subroutine png_image_rgb_color(output,bitmap)
  use gtv_interfaces, except_this=>png_image_rgb_color
  use gtv_plot
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Draw the image in the PNG device, in color scale. The input RGB
  ! intensities are rescaled from 0 to 255.
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: output  ! gt_display instance
  type(gt_bitmap),  intent(in)    :: bitmap  !
#if defined(PNG)
  ! Local
  integer :: i,j,x0,y0,x,y
  integer(kind=4) :: i4
  !
  x0 = bitmap%position(1)
  y0 = bitmap%position(2)
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      x = x0+i-1
      y = y0+j-1
      !
      i4 = nint(real(bitmap%irvalues(i,j)-pngmap_offset+1,kind=4)/pngmap_size*255.)
      output%png%r(x,y) = si4_to_ui1(i4)
      !
      i4 = nint(real(bitmap%igvalues(i,j)-pngmap_offset+1,kind=4)/pngmap_size*255.)
      output%png%g(x,y) = si4_to_ui1(i4)
      !
      i4 = nint(real(bitmap%ibvalues(i,j)-pngmap_offset+1,kind=4)/pngmap_size*255.)
      output%png%b(x,y) = si4_to_ui1(i4)
      !
      if (output%png%transparency)  output%png%a(x,y) = i255  ! i.e. not transparent
    enddo
  enddo
  !
#endif
end subroutine png_image_rgb_color
!
subroutine png_image_rgb_grey(output,bitmap)
  use gtv_interfaces, except_this=>png_image_rgb_grey
  use gtv_plot
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Draw the image in the PNG device, in color scale. The input RGB
  ! intensities are rescaled from 0 to 255.
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: output  ! gt_display instance
  type(gt_bitmap),  intent(in)    :: bitmap  !
#if defined(PNG)
  ! Local
  integer :: i,j,x0,y0,x,y
  integer(kind=4) :: i4
  real(kind=4) :: lumi
  !
  x0 = bitmap%position(1)
  y0 = bitmap%position(2)
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      x = x0+i-1
      y = y0+j-1
      !
      lumi = rgb_to_grey((bitmap%irvalues(i,j)-pngmap_offset+1)*255./pngmap_size,  &
                         (bitmap%igvalues(i,j)-pngmap_offset+1)*255./pngmap_size,  &
                         (bitmap%ibvalues(i,j)-pngmap_offset+1)*255./pngmap_size)
      i4 = nint(lumi)
      output%png%r(x,y) = si4_to_ui1(i4)
      !
      if (output%png%transparency)  output%png%a(x,y) = i255  ! i.e. not transparent
    enddo
  enddo
  !
#endif
end subroutine png_image_rgb_grey
!
subroutine png_image_ind_color(output,bitmap,lut)
  use gtv_interfaces, except_this=>png_image_ind_color
  use gtv_plot
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Draw the image in the PNG device, in color scale. The single-scale
  ! intensities are split in 3 RGB intensities from 0 to 255.
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: output  ! gt_display instance
  type(gt_bitmap),  intent(in)    :: bitmap  !
  type(gt_lut),     intent(in)    :: lut     ! Colormap to use
#if defined(PNG)
  ! Local
  integer(kind=1) :: br(lut%size)
  integer(kind=1) :: bg(lut%size)
  integer(kind=1) :: bb(lut%size)
  integer :: intensity,i,j,x0,y0,x,y
  integer*4 :: i4
  !
  ! Prepare Byte values for R, G and B
  do intensity=1,lut%size
    i4 = nint(lut%r(intensity)*255.)
    br(intensity) = si4_to_ui1(i4)
    i4 = nint(lut%g(intensity)*255.)
    bg(intensity) = si4_to_ui1(i4)
    i4 = nint(lut%b(intensity)*255.)
    bb(intensity) = si4_to_ui1(i4)
  enddo
  !
  x0 = bitmap%position(1)
  y0 = bitmap%position(2)
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      intensity = bitmap%irvalues(i,j)  &
                  - pngmap_offset + 1 ! +1 because the values were
                                      ! shifted by 1 for C indices
      x = x0+i-1
      y = y0+j-1
      !
      if (intensity.eq.lut%size .and. output%png%noblank) then
        ! Last level was used in compute_bitmap for blanking. If
        ! NOBLANK mode, do nothing! We will see the preset background or,
        ! even better, other plots already drawn!
        continue
        !
      else
        output%png%r(x,y) = br(intensity)
        output%png%g(x,y) = bg(intensity)
        output%png%b(x,y) = bb(intensity)
        if (output%png%transparency)  output%png%a(x,y) = i255  ! i.e. not transparent
      endif
    enddo
  enddo
  !
#endif
end subroutine png_image_ind_color
!
subroutine png_image_ind_grey(output,bitmap,lut)
  use gtv_interfaces, except_this=>png_image_ind_grey
  use gtv_plot
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Draw the image in the PNG device, in grey scale
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: output  ! gt_display instance
  type(gt_bitmap),  intent(in)    :: bitmap  !
  type(gt_lut),     intent(in)    :: lut     ! Colormap to use
#if defined(PNG)
  ! Local
  integer(kind=1) :: bg(lut%size)
  integer :: intensity,i,j,x0,y0,x,y
  integer*4 :: i4
  !
  ! Prepare Byte values for Grey colorscale
  do intensity=1,lut%size
    i4 = nint(rgb_to_grey(lut%r(intensity),lut%g(intensity),lut%b(intensity))*255.)
    bg(intensity) = si4_to_ui1(i4)
  enddo
  !
  x0 = bitmap%position(1)
  y0 = bitmap%position(2)
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      intensity = bitmap%irvalues(i,j)  &
                  - pngmap_offset + 1 ! +1 because the values were
                                      ! shifted by 1 for C indices
      x = x0+i-1
      y = y0+j-1
      !
      if (intensity.eq.lut%size .and. output%png%noblank) then
        ! Last level was used in compute_bitmap for blanking. If
        ! NOBLANK mode, do nothing! We will see the preset background or,
        ! even better, other plots already drawn!
        continue
        !
      else
        output%png%r(x,y) = bg(intensity)
        if (output%png%transparency)  output%png%a(x,y) = i255  ! i.e. not transparent
      endif
    enddo
  enddo
  !
#endif
end subroutine png_image_ind_grey
!
subroutine png_image_inquire(map_size,map_offset,map_color,map_static)
  use gtv_interfaces, except_this=>png_image_inquire
  use gtv_png
  !---------------------------------------------------------------------
  ! @ private
  ! ZZZ Not sure all these really have to be returned...
  !---------------------------------------------------------------------
  integer, intent(out) :: map_size    ! Desired scale dynamics
  integer, intent(out) :: map_offset  !
  logical, intent(out) :: map_color   ! Is a color or grey map?
  logical, intent(out) :: map_static  !
  !
  map_size = pngmap_size
  map_offset = pngmap_offset
  map_color = .true.   ! What about a Grey PNG?
  map_static = .true.  ! PNG filler is able to render one LUT per image
                       ! of the plot (if LUT STATIC mode)
  !
end subroutine png_image_inquire
!
subroutine png_point(out,x,y)
  use gtv_interfaces, except_this=>png_point
  use gtv_png
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Draw the pixel at input coordinates (pixel units)
  !---------------------------------------------------------------------
  type(gt_display)             :: out  ! Output instance
  integer(kind=4),  intent(in) :: x,y  ! Pixel coordinates, in pixel units
  !
  if (out%png%negative) then
    ! Only revert the color at pixel position
    out%png%R(x,y) = ieor(out%png%R(x,y),i255)  ! Exclusive OR: revert all the bits
    if (out%png%nchan.ge.3) then
      out%png%G(x,y) = ieor(out%png%G(x,y),i255)
      out%png%B(x,y) = ieor(out%png%B(x,y),i255)
    endif
    if (out%png%transparency)  out%png%A(x,y) = i255  ! i.e. not transparent
  else
    out%png%R(x,y) = out%png%rpen
    if (out%png%nchan.ge.3) then
      out%png%G(x,y) = out%png%gpen
      out%png%B(x,y) = out%png%bpen
    endif
    if (out%png%transparency)  out%png%A(x,y) = i255  ! i.e. not transparent
  endif
  !
end subroutine png_point
!
subroutine base64_encode(c,nc,olun)
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch
  !  Encode a (binary) buffer as a base-64 string
  !
  !  Example:
  !
  ! Text content   |      M        |      a        |        n      |
  ! ASCII          |   77 (0x4d)   |   97 (0x61)   |    110 (0x6e) |
  ! Bit pattern    |0 1 0 0 1 1 0 1|0 1 1 0 0 0 0 1|0 1 1 0 1 1 1 0|
  ! Index          |     19    |    22     |     5     |     46    |
  ! Base64-encoded |     T     |    W      |     F     |     u     |
  !
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: nc     ! Number of Bytes
  integer(kind=1), intent(in) :: c(nc)  ! Input buffer
  integer(kind=4), intent(in) :: olun   ! Output logical unit
  ! Local
  integer(kind=4) :: ib,ic
  integer(kind=1) :: j(4)
  integer(kind=1), parameter :: zero=0
  character(len=76) :: buf
  ! Equivalence
  integer(kind=4) :: b32  ! We need only 24 bits but we can not have an integer(kind=3)
  integer(kind=1) :: b8(4)
  equivalence (b32,b8)
  ! Table
  character(len=1), parameter :: b64table(0:63) = (/    &
  "A","B","C","D","E","F","G","H","I","J","K","L","M",  &
  "N","O","P","Q","R","S","T","U","V","W","X","Y","Z",  &
  "a","b","c","d","e","f","g","h","i","j","k","l","m",  &
  "n","o","p","q","r","s","t","u","v","w","x","y","z",  &
  "0","1","2","3","4","5","6","7","8","9","+","/"       /)
  !
  ib = 0
  ic = 1
  b8(4) = zero  ! Never used, put zeroes for safety
  do
    b8(1) = c(ic+2)
    b8(2) = c(ic+1)
    b8(3) = c(ic)
    !
    j(4) = ibits(b32, 0,6)
    j(3) = ibits(b32, 6,6)
    j(2) = ibits(b32,12,6)
    j(1) = ibits(b32,18,6)
    !
    buf(ib+1:ib+1) = b64table(j(1))
    buf(ib+2:ib+2) = b64table(j(2))
    buf(ib+3:ib+3) = b64table(j(3))
    buf(ib+4:ib+4) = b64table(j(4))
    !
    ib = ib+4
    if (ib.ge.len(buf)) then
      write(olun,'(A)') buf
      ib = 0
    endif
    !
    ic = ic+3
    if (ic.gt.nc-2)  exit
  enddo
  !
  ! Last 1 or 2 bytes, need specific padding
  if (ic.eq.nc-1) then
    b8(1) = zero
    b8(2) = c(ic+1)
    b8(3) = c(ic)
    j(3) = ibits(b32, 6,6)
    j(2) = ibits(b32,12,6)
    j(1) = ibits(b32,18,6)
    buf(ib+1:ib+1) = b64table(j(1))
    buf(ib+2:ib+2) = b64table(j(2))
    buf(ib+3:ib+3) = b64table(j(3))
    buf(ib+4:ib+4) = '='
    ib = ib+4
  elseif (ic.eq.nc) then
    b8(1) = zero
    b8(2) = zero
    b8(3) = c(ic)
    j(2) = ibits(b32,12,6)
    j(1) = ibits(b32,18,6)
    buf(ib+1:ib+1) = b64table(j(1))
    buf(ib+2:ib+2) = b64table(j(2))
    buf(ib+3:ib+3) = '='
    buf(ib+4:ib+4) = '='
    ib = ib+4
  endif
  !
  if (ib.gt.0)  write(olun,'(A)') buf(1:ib)
  !
end subroutine base64_encode
