!-----------------------------------------------------------------------
! Generic routines to handle images before displaying them in the
! appropriate device. No device-specific code here!
!-----------------------------------------------------------------------
subroutine gti_image(output,image)
  use gtv_interfaces, except_this=>gti_image
  use gtv_types
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ private
  ! Affichage d'une image a partir du descripteur lu dans le metacode
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: output  ! Input gt_display
  type(gt_image),   intent(in)    :: image   ! Image instance
  ! Local
  logical :: error
  !
  select case (output%dev%protocol)
  case(p_x)
    call gti_ximage(output,image)
  case(p_postscript)
    call gti_psimage(output,image)
  case(p_svg)
    error = .false.
    call gti_svgimage(output,image,error)
  case(p_png)
    call gti_pngimage(output,image)
  end select
  !
end subroutine gti_image
!
subroutine clip_image(output,nx,ny,conv,box,user,resample,resfact,  &
  visible,clip,window,trans)
  use gtv_interfaces, except_this=>clip_image
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   Compute clipping box of an image
  !---------------------------------------------------------------------
  type(gt_display)                        :: output     ! Output instance
  integer(kind=index_length), intent(in)  :: nx,ny      ! Image size
  real(kind=4),               intent(in)  :: conv(6)    ! Image pixel to User coordinates
  real(kind=4),               intent(in)  :: box(4)     ! Paper coordinates of bounding box
  real(kind=4),               intent(in)  :: user(4)    ! User coordinates of bounding box
  logical,                    intent(in)  :: resample   ! Is resample desired?
  real(kind=4),               intent(in)  :: resfact    ! Resampling factor (see below)
  logical,                    intent(out) :: visible    ! Is the image visible?
  real(kind=4),               intent(out) :: clip(4)    ! Clipping box in Paper coordinates
  integer(kind=4),            intent(out) :: window(4)  ! Clipping box in Window coordinates
  real(kind=4),               intent(out) :: trans(4)   ! Image to Window conversion
  ! Local
  character(len=*), parameter :: rname='CLIP_IMAGE'
  real(kind=4) :: bux,ux1,bx1,bx2
  real(kind=4) :: buy,uy1,by1,by2
  real(kind=4) :: xref,xval,xinc,yref,yval,yinc
  real(kind=4) :: user_x1,user_x2,user_y1,user_y2
  real(kind=4) :: page_x1,page_x2,page_y1,page_y2
  real(kind=4) :: pagex1,pagex2,pagey1,pagey2
  real(kind=4) :: clip_x1,clip_x2,clip_y1,clip_y2
!   real(kind=4) :: window_x1,window_x2,window_y1,window_y2
!   integer(kind=4) :: window_x0,window_nx,window_y0,window_ny
  integer(kind=4) :: window_x0,window_x1,window_x2,window_nx
  integer(kind=4) :: window_y0,window_y1,window_y2,window_ny
  real(kind=4) :: wi_x,wi_x0,wi_y,wi_y0
  real(kind=4), parameter :: releps=1e-5
  real(kind=4) :: eps,myxfact,myyfact,mysclx,myscly
  real(kind=4) :: gsclx,gscly,pox,poy,gox,goy,p1,p2
  logical :: do_resample
  !
  ! Scaling transformations
  ! From paper (PX) to Window (WX)
  !      IWX = NINT((PX-GOX)*GSCLX + POX)
  !
  ! From Image IX to User UX (Ref, Val, Inc)
  !      UX (IX) = (IX-Xref)*Xinc + Xval
  !
  xref = conv(1)
  xval = conv(2)
  xinc = conv(3)
  yref = conv(4)
  yval = conv(5)
  yinc = conv(6)
  !
  ! From User to Paper:
  !     BX = (UX-UX1)*BUX + BX1
  !
  bx1 = box(1)
  bx2 = box(2)
  ux1 = user(1)
  bux = (box(2)-box(1))/(user(2)-user(1))
  by1 = box(3)
  by2 = box(4)
  uy1 = user(3)
  buy = (box(4)-box(3))/(user(4)-user(3))
  !
  ! Compute the boundaries of the image in Page Coordinates
  user_x1 = (0.5-xref)*xinc + xval
  user_x2 = (nx+0.5-xref)*xinc + xval
  user_y1 = (0.5-yref)*yinc + yval
  user_y2 = (ny+0.5-yref)*yinc + yval
  page_x1 = (user_x1-ux1)*bux + bx1
  page_x2 = (user_x2-ux1)*bux + bx1
  page_y1 = (user_y1-uy1)*buy + by1
  page_y2 = (user_y2-uy1)*buy + by1
  !
  ! Compute the effective clipping box in the window
  ! First with "BOX"
  clip_x1 = max(bx1,min(page_x1,page_x2))
  clip_x2 = min(bx2,max(page_x1,page_x2))
  clip_y1 = max(by1,min(page_y1,page_y2))
  clip_y2 = min(by2,max(page_y1,page_y2))
  ! Then with clipping window
  clip_x1 = max(clip_x1,min(output%gx1,output%gx2))
  clip_x2 = min(clip_x2,max(output%gx1,output%gx2))
  clip_y1 = max(clip_y1,min(output%gy1,output%gy2))
  clip_y2 = min(clip_y2,max(output%gy1,output%gy2))
  clip(1) = clip_x1
  clip(2) = clip_x2
  clip(3) = clip_y1
  clip(4) = clip_y2
  !
  ! Check visibility
  visible = clip_x2.gt.clip_x1 .and. clip_y2.gt.clip_y1
  if (.not.visible) return
  !
  pagex1 = min(page_x1,page_x2)
  pagex2 = max(page_x1,page_x2)
  pagey1 = min(page_y1,page_y2)
  pagey2 = max(page_y1,page_y2)
  eps = releps*max(pagex2-pagex1,pagey2-pagey1)
  !
  if (resample) then
    ! Always resample to output device pixels
    do_resample = .true.
    !
  else
    ! Do not resample, IF POSSIBLE
    !
    ! If clipped, must resample:
    do_resample = abs(clip_x1-pagex1).gt.eps .or.  &
                  abs(clip_x2-pagex2).gt.eps .or.  &
                  abs(clip_y1-pagey1).gt.eps .or.  &
                  abs(clip_y2-pagey2).gt.eps
  endif
  !
  ! Compute the bitmap limits in Window pixels
  !
  call get_scale_awd(output,gsclx,gscly)
  if (do_resample) then
    ! 1) Clipped image
    if (.false.) then
      ! Clipping + no resampling
      ! ZZZ have to find the correct criterium for this!
      ! call gtv_message(seve%d,rname,'Clipping image, no resampling...')
      myxfact = 1./(abs(gsclx)*bux*xinc)
      myyfact = 1./(abs(gscly)*buy*yinc)
    else
      ! Clipping + resampling
      ! call gtv_message(seve%d,rname,'Clipping and resampling image...')
      ! We can use an additional scale factor. Non-sense for pixel-based
      ! devices (i.e. X window and PNG should use 1), it can be useful to
      ! improve the resolution for "pseudo-pixel-based" device like PS
      ! where we have set an artificial dots-per-inch value. However, take
      ! care of the quality vs file weight in this case.
      myxfact = resfact
      myyfact = resfact
    endif
    ! Get and use the pixel-to-world factor to resample the image.
    mysclx = gsclx*myxfact
    myscly = gscly*myyfact
    !
    ! Duplicate of 'world_to_pixel', but with mysclx
    call get_central_pixel_awd(output,pox,poy)
    call get_central_clipping_awd(output,gox,goy)
    p1 = (clip_x1-gox)*mysclx
    p2 = (clip_x2-gox)*mysclx
    if (p1.lt.p2) then
      ! Most likely clip_x1 is not perfectly aligned on the left of the first
      ! output pixel. Truncate to avoid overflowing before the first pixel.
      ! Same in all other cases.
      window_x1 = ceiling(p1 + pox)
      window_x2 = floor(p2 + pox)
    else
      window_x1 = floor(p1 + pox)
      window_x2 = ceiling(p2 + pox)
    endif
    p1 = (clip_y1-goy)*myscly
    p2 = (clip_y2-goy)*myscly
    if (p1.lt.p2) then
      window_y1 = ceiling(p1 + poy)
      window_y2 = floor(p2 + poy)
    else
      window_y1 = floor(p1 + poy)
      window_y2 = ceiling(p2 + poy)
    endif
    window_x0 = min(window_x1,window_x2)
    window_y0 = min(window_y1,window_y2)
    !
    ! This is correct, to the required precision...
    window_nx = abs(window_x2-window_x1)+1
    window_ny = abs(window_y2-window_y1)+1
    window(1) = window_nx
    window(2) = window_ny
    window(3) = window_x0
    window(4) = window_y0
    !
    ! Compute the Window pixels to Image pixels coordinate formula:
    !     Image = int (Window*WI_X + WI_X0)
    !
    wi_x = 1.0 / (mysclx * bux * xinc)
    wi_y = 1.0 / (myscly * buy * yinc)
    !
    ! OK, here we are
    if (window_x0.eq.window_x1) then
      ! 1) Image to User conversion:
      !      Xuser = (Ximag-xref)*xinc + xval
      ! 2) Box to User conversion:
      !      Xuser = (Xbox - bx1)/bux + ux1
      ! 3) Bitmap to Image conversion:
      !      Ximag = wi_x0 + wi_x*Xbitmap
      ! We want to align clip_x1 on the left of the first pixel, i.e.
      !      Xbox    = clip_x1
      !      Xbitmap = 0.5      (left of 1st pixel)
      ! Solving (1) == (2) gives:
      wi_x0 = ( ( clip_x1-bx1 ) / bux + ux1 - xval ) / xinc + xref - wi_x*0.5
    else
      wi_x0 = ( ( clip_x2-bx1 ) / bux + ux1 - xval ) / xinc + xref - wi_x*0.5
    endif
    if (window_y0.eq.window_y1) then
      wi_y0 = ( ( clip_y1-by1 ) / buy + uy1 - yval ) / yinc + yref - wi_y*0.5
    else
      wi_y0 = ( ( clip_y2-by1 ) / buy + uy1 - yval ) / yinc + yref - wi_y*0.5
    endif
    !
  else
    ! 2) Full image: no expansion/compression required
    ! call gtv_message(seve%d,rname,'Writing full image, no resampling...')
    window_nx = nx
    window_ny = ny
    !
    if (gsclx*bux*xinc.gt.0.0) then
      wi_x = 1.0
      wi_x0 = 0.0
    else
      wi_x = -1.0
      wi_x0 = nx+1
    endif
    if (gscly*buy*yinc.gt.0.0) then
      wi_y = 1.0
      wi_y0 = 0.0
    else
      wi_y = -1.0
      wi_y0 = ny+1
    endif
    window(1) = window_nx
    window(2) = window_ny
    window(3) = 1
    window(4) = 1
    !
  endif
  !
  trans(1) = wi_x
  trans(2) = wi_x0
  trans(3) = wi_y
  trans(4) = wi_y0
end subroutine clip_image
!
subroutine gti_bitmap(image,output,bitmap)
  use gtv_interfaces, except_this=>gti_bitmap
  use gtv_bitmap
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  type(gt_image),   intent(in)    :: image   ! The image to be displayed
  type(gt_display), intent(in)    :: output  ! gt_display instance
  type(gt_bitmap),  intent(inout) :: bitmap  !
  ! 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
  !
  if (ncol.le.2) then
    call gtv_message(seve%w,'PLOT','Trying dithering')
    ncol = 127
    offset = 0
  else
    offset = output%dev%map_offset
  endif
  !
  call compute_bitmap(image,bitmap,ncol,offset)
  !
end subroutine gti_bitmap
!
subroutine compute_bitmap(image,bitmap,ncol,offset)
  use gtv_interfaces, except_this=>compute_bitmap
  use gtv_bitmap
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !   Generic entry point which computes the bitmap(s) for indexed or
  ! RGB images, standard or Lupton scaling
  !---------------------------------------------------------------------
  type(gt_image),  intent(in)    :: image   ! The image to be displayed
  type(gt_bitmap), intent(inout) :: bitmap  !
  integer(kind=4), intent(in)    :: ncol    ! Number of color or intensities per plane
  integer(kind=4), intent(in)    :: offset  ! Device offset for these intensities
  !
  if (image%isrgb) then
    if (image%scaling.eq.scale_lup) then
      ! Non-independant planes
      call compute_bitmap_lupton(image%r,image%g,image%b,image%scaling_lup_b,  &
        bitmap,bitmap%irvalues,ncol,offset)
      call compute_bitmap_lupton(image%g,image%r,image%b,image%scaling_lup_b,  &
        bitmap,bitmap%igvalues,ncol,offset)
      call compute_bitmap_lupton(image%b,image%r,image%g,image%scaling_lup_b,  &
        bitmap,bitmap%ibvalues,ncol,offset)
    else
      call compute_bitmap_direct(image%r,image%scaling,bitmap,bitmap%irvalues,  &
        ncol,offset)
      call compute_bitmap_direct(image%g,image%scaling,bitmap,bitmap%igvalues,  &
        ncol,offset)
      call compute_bitmap_direct(image%b,image%scaling,bitmap,bitmap%ibvalues,  &
        ncol,offset)
    endif
  else
    call compute_bitmap_direct(image%r,image%scaling,bitmap,bitmap%irvalues,  &
      ncol,offset)
  endif
  !
end subroutine compute_bitmap
!
subroutine compute_bitmap_direct(data,scaling,bitmap,ivalues,ncol,offset)
  use gtv_interfaces, except_this=>compute_bitmap_direct
  use gildas_def
  use gbl_message
  use gtv_bitmap
  !---------------------------------------------------------------------
  ! @ private
  !  Rescales the R*4 array IMAGE into the bitmap array DISPLAY with
  ! care of BLANKING values (put at 0) and LIN or LOG treatment
  ! (SCALING_MODE)
  !
  !  The image is scaled between the values 1 and NCOL. The colormap
  ! offset, if any, is handled by the device driver itself (cf
  ! x_affiche_image() in xsub.c)
  !---------------------------------------------------------------------
  type(gt_image_data),        intent(in)    :: data          ! The instance describing the image
  integer(kind=4),            intent(in)    :: scaling       ! Scaling mode
  type(gt_bitmap),            intent(inout) :: bitmap        ! The instance describing the bitmap
  integer(kind=bitmap_depth), intent(out)   :: ivalues(:,:)  ! The integer values
  integer,                    intent(in)    :: ncol          ! Number of colours
  integer,                    intent(in)    :: offset        ! Number of colours
  ! Local
  character(len=*), parameter :: rname='COMPUTE_BITMAP'
  integer(kind=2*bitmap_depth) :: entier
  real :: factor,logmax,logmin,lrmin,lrmax
  integer(kind=index_length) :: ii,jj
  integer :: i,j
  !
  ! Device dependent version for "bitmap-depth"-bytes bitmap
  integer(kind=bitmap_depth) :: bitval
#if defined(VAX) || defined(IEEE)
  equivalence (entier,bitval)
#endif
#if defined(EEEI)
  integer(kind=bitmap_depth) bitarr(2)
  equivalence (entier,bitarr(1)),(bitarr(2),bitval)
#endif
  !
  ! Switch the min/max cuts if required
  if (data%cuts(1).le.data%cuts(2)) then
    lrmin=data%cuts(1)
    lrmax=data%cuts(2)
  else
    lrmin=data%cuts(2)
    lrmax=data%cuts(1)
  endif
  !
  if (scaling.eq.scale_lin) then
    ! nous avons [1--NCOL] couleurs pour des pixels qui existent, et le pixel
    ! NCOL+1 pour le blanking (puisque NCOL=MAP_SIZE-1). Je prends:
    ! * 1 pour les value <= LRMIN
    ! * 1 to NCOL for LRMIN < value < LRMAX
    ! * NCOL pour les value >= LRMAX
    ! * NCOL+1 pour les NANQ et autres blanquettes.
    ! Linear scaling
    if (lrmax.ne.lrmin) then
      factor = (ncol-1)/(lrmax-lrmin)
    else
      factor = 0.0
    endif
    if (data%blank(2).lt.0.e0) then
      do j = 1,bitmap%size(2)
        ! nint() because e.g. float coordinates 0.5 to 1.5 fall into pixel 1
        jj = nint(bitmap%trans(4) + bitmap%trans(3)*j)
        jj = max(1,min(jj,data%taille(2)))
        do i =1,bitmap%size(1)
          ii = nint(bitmap%trans(2) + bitmap%trans(1)*i)
          ii = max(1,min(ii,data%taille(1)))
          ! Support for NANQ images
          if (data%values(ii,jj).le.lrmin) then
            entier = 1
          elseif (data%values(ii,jj).lt.lrmax) then
            entier = 1 + nint(factor*(data%values(ii,jj)-lrmin))  ! Vary from 1 to Ncol
          elseif (data%values(ii,jj).eq.data%values(ii,jj)) then  ! .ge.LRMAX, not NaN
            entier = ncol
          else                                        ! NaN
            entier = ncol+1
          endif
          entier = entier + offset - 1  ! -1 for C indices which start at 0
          ivalues(i,j) = bitval
        enddo
      enddo
    else
      do j = 1,bitmap%size(2)
        jj = nint(bitmap%trans(4)+bitmap%trans(3)*j)
        jj = max(1,min(jj,data%taille(2)))
        do i =1,bitmap%size(1)
          ii = nint(bitmap%trans(2)+bitmap%trans(1)*i)
          ii = max(1,min(ii,data%taille(1)))
          if (abs(data%values(ii,jj)-data%blank(1)).le.data%blank(2)) then  ! Blank
            entier = ncol+1
          elseif (data%values(ii,jj).le.lrmin) then
            entier = 1
          elseif (data%values(ii,jj).lt.lrmax) then
            entier = 1 + nint(factor*(data%values(ii,jj)-lrmin))  ! Vary from 1 to Ncol
          elseif (data%values(ii,jj).eq.data%values(ii,jj)) then  ! .ge.LRMAX, not NaN
            entier = ncol
          else                                        ! NaN
            entier = ncol+1
          endif
          entier = entier + offset - 1  ! -1 for C indices which start at 0
          ivalues(i,j) = bitval
        enddo
      enddo
    endif
    !
  elseif (scaling.eq.scale_log) then
    ! Logarithmic
    logmin = log(lrmin)
    logmax = log(lrmax)
    factor = (ncol-1)/(logmax-logmin)
    if (data%blank(2).lt.0.e0) then
      do j = 1,bitmap%size(2)
        jj = nint(bitmap%trans(4) + bitmap%trans(3)*j)
        jj = max(1,min(jj,data%taille(2)))
        do i =1,bitmap%size(1)
          ii = nint(bitmap%trans(2) + bitmap%trans(1)*i)
          ii = max(1,min(ii,data%taille(1)))
          if (data%values(ii,jj).le.lrmin) then
            entier = 1
          elseif (data%values(ii,jj).lt.lrmax) then
            entier = 1 + nint(factor*(log(data%values(ii,jj))-logmin))  ! Vary from 1 to Ncol
          elseif (data%values(ii,jj).eq.data%values(ii,jj)) then  ! .ge.LRMAX, not NaN
            entier = ncol
          else                                        ! NaN
            entier = ncol+1
          endif
          entier = entier + offset - 1  ! -1 for C indices which start at 0
          ivalues(i,j) = bitval
        enddo
      enddo
    else
      ! With blanking
      do j = 1,bitmap%size(2)
        jj = nint(bitmap%trans(4) + bitmap%trans(3)*j)
        jj = max(1,min(jj,data%taille(2)))
        do i =1,bitmap%size(1)
          ii = nint(bitmap%trans(2) + bitmap%trans(1)*i)
          ii = max(1,min(ii,data%taille(1)))
          if (abs(data%values(ii,jj)-data%blank(1)).le.data%blank(2)) then  ! Blank
            entier = ncol+1
          elseif (data%values(ii,jj).le.lrmin) then
            entier = 1
          elseif (data%values(ii,jj).lt.lrmax) then
            entier = 1 + nint(factor*(log(data%values(ii,jj))-logmin))  ! Vary from 1 to Ncol
          elseif (data%values(ii,jj).eq.data%values(ii,jj)) then  ! .ge.LRMAX, not NaN
            entier = ncol
          else                                        ! NaN
            entier = ncol+1
          endif
          entier = entier + offset - 1  ! -1 for C indices which start at 0
          ivalues(i,j) = bitval
        enddo
      enddo
    endif
    !
  elseif (scaling.eq.scale_equ) then
    ! Equalisation mode
    if (.not.allocated(data%eqvalues)) then
      call gtv_message(seve%e,rname,  &
        'Internal error: image has not been equalized!')
      return
    endif
    !
    do j = 1,bitmap%size(2)
      jj = nint(bitmap%trans(4) + bitmap%trans(3)*j)
      jj = max(1,min(jj,data%taille(2)))
      do i =1,bitmap%size(1)
        ii = nint(bitmap%trans(2) + bitmap%trans(1)*i)
        ii = max(1,min(ii,data%taille(1)))
        entier = data%eqvalues(ii,jj) + offset - 1  ! -1 for C indices which start at 0
        ivalues(i,j) = bitval
      enddo
    enddo
  endif
  !
end subroutine compute_bitmap_direct
!
subroutine compute_bitmap_lupton(data1,data2,data3,beta,bitmap,ivalues,ncol,offset)
  use gtv_interfaces, except_this=>compute_bitmap_lupton
  use gildas_def
  use gbl_message
  use gtv_bitmap
  !---------------------------------------------------------------------
  ! @ private
  !  Rescales the R*4 array IMAGE into the bitmap array DISPLAY with
  ! care of BLANKING values (put at 0) and LIN or LOG treatment
  ! (SCALING_MODE)
  !
  !  The image is scaled between the values 1 and NCOL. The colormap
  ! offset, if any, is handled by the device driver itself (cf
  ! x_affiche_image() in xsub.c)
  !---------------------------------------------------------------------
  type(gt_image_data),        intent(in)    :: data1         ! The instance describing the image
  type(gt_image_data),        intent(in)    :: data2         ! One of the complementary color
  type(gt_image_data),        intent(in)    :: data3         ! The second complementary color
  real(kind=4),               intent(in)    :: beta          ! Beta parameter
  type(gt_bitmap),            intent(inout) :: bitmap        ! The instance describing the bitmap
  integer(kind=bitmap_depth), intent(out)   :: ivalues(:,:)  ! The integer values
  integer,                    intent(in)    :: ncol          ! Number of colours
  integer,                    intent(in)    :: offset        ! Number of colours
  ! Local
  character(len=*), parameter :: rname='COMPUTE_BITMAP'
  integer(kind=2*bitmap_depth) :: entier
  real(kind=4) :: val1,val2,val3
  real(kind=4) :: radius,val
  integer(kind=index_length) :: ii,jj
  integer(kind=4) :: ibit,jbit
  !
  ! Device dependent version for "bitmap-depth"-bytes bitmap
  integer(kind=bitmap_depth) :: bitval
#if defined(VAX) || defined(IEEE)
  equivalence (entier,bitval)
#endif
#if defined(EEEI)
  integer(kind=bitmap_depth) bitarr(2)
  equivalence (entier,bitarr(1)),(bitarr(2),bitval)
#endif
  !
  if (data1%blank(2).ge.0.e0 .or. data2%blank(2).ge.0.e0 .or. data3%blank(2).ge.0.e0) then
    ! With blanking
    do jbit = 1,bitmap%size(2)
      jj = nint(bitmap%trans(4) + bitmap%trans(3)*jbit)
      jj = max(1,min(jj,data1%taille(2)))
      do ibit =1,bitmap%size(1)
        ii = nint(bitmap%trans(2) + bitmap%trans(1)*ibit)
        ii = max(1,min(ii,data1%taille(1)))
        !
        if (abs(data1%values(ii,jj)-data1%blank(1)).le.data1%blank(2) .or.  &
            abs(data2%values(ii,jj)-data2%blank(1)).le.data2%blank(2) .or.  &
            abs(data3%values(ii,jj)-data3%blank(1)).le.data3%blank(2)) then
          ! Blanked value
          entier = ncol+1
          !
        else
          if (data1%values(ii,jj).lt.0.) then
            val1 = 0.
          else
            val1 = data1%values(ii,jj)
          endif
          if (data2%values(ii,jj).lt.0.) then
            val2 = 0.
          else
            val2 = data2%values(ii,jj)
          endif
          if (data3%values(ii,jj).lt.0.) then
            val3 = 0.
          else
            val3 = data3%values(ii,jj)
          endif
          radius = beta*(val1+val2+val3)
          !
          if (radius.ne.radius) then
            ! One of the R/G/B value is NaN
            entier = 1
          elseif (val1.le.0. .or. radius.eq.0.) then
            ! Truncate negative values
            entier = 1
          else
            ! Valid value
            val = val1*asinh(radius)/radius
            if (val.gt.1.0)  val = 1.0
            entier = 1+nint((ncol-1)*val)
          endif
        endif
        !
        entier = entier + offset - 1  ! -1 for C indices which start at 0
        ivalues(ibit,jbit) = bitval
      enddo
    enddo
    !
  else
    ! Without blanking
    do jbit = 1,bitmap%size(2)
      jj = nint(bitmap%trans(4) + bitmap%trans(3)*jbit)
      jj = max(1,min(jj,data1%taille(2)))
      do ibit =1,bitmap%size(1)
        ii = nint(bitmap%trans(2) + bitmap%trans(1)*ibit)
        ii = max(1,min(ii,data1%taille(1)))
        !
        if (data1%values(ii,jj).lt.0.) then
          val1 = 0.
        else
          val1 = data1%values(ii,jj)
        endif
        if (data2%values(ii,jj).lt.0.) then
          val2 = 0.
        else
          val2 = data2%values(ii,jj)
        endif
        if (data3%values(ii,jj).lt.0.) then
          val3 = 0.
        else
          val3 = data3%values(ii,jj)
        endif
        radius = beta*(val1+val2+val3)
        !
        if (radius.ne.radius) then
          ! One of the R/G/B value is NaN
          entier = 1
        elseif (val1.le.0. .or. radius.eq.0.) then
          ! Truncate negative values
          entier = 1
        else
          ! Valid value
          val = val1*asinh(radius)/radius
          if (val.gt.1.0)  val = 1.0
          entier = 1+nint((ncol-1)*val)
        endif
        !
        entier = entier + offset - 1  ! -1 for C indices which start at 0
        ivalues(ibit,jbit) = bitval
      enddo
    enddo
    !
  endif
  !
end subroutine compute_bitmap_lupton
!
subroutine protocol_image_inquire(dev)
  use gtv_interfaces, except_this=>protocol_image_inquire
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Inquire about device size and color map.
  ! Should be merged in the gtvdef definitions, since it is a property
  ! of the device.
  !---------------------------------------------------------------------
  type(gt_device), intent(inout) :: dev  ! Device to update
  ! Local
  integer :: ndisplay_x,ndisplay_y
  !
  if (dev%protocol.eq.p_x) then
    call ximage_inquire(dev%map_size,dev%map_offset,ndisplay_x,ndisplay_y,  &
      dev%map_color,dev%map_static)
    !
  elseif (dev%protocol.eq.p_postscript) then
    call ps_image_inquire(dev%map_size,dev%map_offset,dev%map_color,  &
      dev%map_static)
    !
  elseif (dev%protocol.eq.p_svg) then
    call svg_image_inquire(dev%map_size,dev%map_offset,dev%map_color,  &
      dev%map_static)
    !
  elseif (dev%protocol.eq.p_png) then
    call png_image_inquire(dev%map_size,dev%map_offset,dev%map_color,  &
      dev%map_static)
  endif
  !
end subroutine protocol_image_inquire
