module gtv_ps
  use gtv_types
  !---------------------------------------------------------------------
  ! Support for Postscript laser printers
  !---------------------------------------------------------------------
  !
  integer(kind=4), parameter :: psmap_size = 65536  ! i.e. the most we
    ! can encode in integers of KIND=BITMAP_DEPTH == 2
  integer(kind=4), parameter :: psmap_offset = -32768  ! i.e. encode
    ! the 65536 colors from -32768 to 32767
  !
  ! Variables for PostScript plotter
  real(kind=4) :: margin_xl_cm,margin_xr_cm,margin_yb_cm,margin_yt_cm
  real(kind=4) :: margin_xl_pt,margin_xr_pt,margin_yb_pt,margin_yt_pt
  real(kind=4) :: page_xw_pt,page_yw_pt
  real(kind=4) :: plot_xmin_cm,plot_xmax_cm
  real(kind=4) :: plot_ymin_cm,plot_ymax_cm
  real(kind=8) :: scale_x_plot2pt,scale_y_plot2pt  ! Scaling factor from GTV plot to point units
  real(kind=4) :: x_first_pt,y_first_pt  ! Coordinates of first usable pixel
  ! Conversion factors: 1 pt is 1/72 inch. 1 inch is 2.54 cm. 1 vec unit is 50
  ! microns. Our PostScripts are filled in vec units (instead of pts by default),
  ! using the appropriate scaling factor in the PostScript prolog.
  real(kind=8), parameter :: cm2pt=72.d0/2.54d0
  real(kind=4), parameter :: cm2vec=200. ! 1cm = 200 * 50microns
  !
  integer :: nnchar,olun,counter,pen_old
  logical :: ps_rotate,ps_color
  integer, parameter :: maxbuf=80
  integer(kind=1) :: bbuf(maxbuf)
  !
  ! Definitions
  integer(kind=1), parameter :: l=ichar('l')
  integer(kind=1), parameter :: m=ichar('m')
  integer(kind=1), parameter :: s=ichar('s')
  integer(kind=1), parameter :: blanc=ichar(' ')
  integer(kind=4), parameter :: zero=ichar('0')
  integer(kind=1), parameter :: bigs=ichar('S')
  !
end module gtv_ps
!
subroutine ps_open(output,dir,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>ps_open
  use gildas_def
  use gtv_types
  use gtv_ps
  use gtv_protocol
  use gtv_tree
  use gtv_buffers
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display)                  :: output  ! Output instance
  type(gt_directory), intent(in)    :: dir     ! The directory to print
  logical,            intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='PS'
  character(len=64) :: version
  integer :: ier
  character(len=message_length) :: mess
  !
  if (output%ps%exact) then
    write(mess,'(3(A,1X,L1,1X))')  &
      'Encapsulated:',output%ps%encapsulated,  &
      ', Autorotate:',output%autorotate,     &
      ', Exact:', output%ps%exact
  else
    write(mess,'(3(A,1X,L1,1X))')  &
      'Encapsulated:',output%ps%encapsulated,  &
      ', Autorotate:',output%autorotate,     &
      ', Autoscale:', output%autoscale
  endif
  call gtv_message(seve%d,rname,mess)
  !
  ps_color = output%color
  !
  output%background = 1  ! White background
  output%dev%rxy = 1.0
  olun = output%iunit
  nnchar = 0
  !
  if (output%iunit.ne.6) then
    open (unit=olun,file=output%file,status='NEW',iostat=ier )
    if (ier.ne.0) then
      error = .true.
      call putios ('E-PS,  ',ier)
      return
    endif
  endif
  !
  ! Write Prolog
  write (olun,'(A)') '%!PS-Adobe-3.0 EPSF-3.0'
  version = ''
  ier = sic_getlog('GAG_VERSION',version)
  if (version(1:4).eq."dev ") then
    write (olun,'(A)')  &
      '%%Creator: GTVIRT 1.3 GILDAS dev GILDAS_GROUP 15-Dec-2010'
  else
    write (olun,'(A,A,A)')  &
      '%%Creator: GTVIRT 1.3 GILDAS ',version(1:5),' GILDAS_GROUP 15-Dec-2010'
  endif
  write (olun,'(A)') '%%Title: Hardcopy GTVIRT metacode on PostScript driver'
  call sic_date(version)
  write (olun,'(A)') '%%CreationDate: '//trim(version)
  write (olun,'(A)') '%%Pages: 1'
  write (olun,'(A)') '%%DocumentsFonts: none'
  !
  margin_xl_cm = output%dev%px1/100.
  margin_xr_cm = output%dev%py2/100.  ! Inverted, unknown reason
  margin_yb_cm = output%dev%py1/100.
  margin_yt_cm = output%dev%px2/100.  ! Inverted, unknown reason
  margin_xl_pt = margin_xl_cm * cm2pt
  margin_xr_pt = margin_xr_cm * cm2pt
  margin_yb_pt = margin_yb_cm * cm2pt
  margin_yt_pt = margin_yt_cm * cm2pt
  page_xw_pt = margin_xr_pt-margin_xl_pt
  page_yw_pt = margin_yt_pt-margin_yb_pt
  ! Debug
  write(mess,'(A,4(F6.2))') 'Paper limits (cm): ',  &
    margin_xl_cm,margin_yb_cm,margin_xr_cm,margin_yt_cm
  call gtv_message(seve%d,rname,mess)
  !
  if (output%ps%encapsulated) then
    call ps_prolog_eps(output,dir)
  else
    call ps_prolog_ps(output,dir)
  endif
  !
  write (olun,'(A)') '%%EndComments'
  !
  ! This comment lines is a patch for a bug in DVIALW.
  ! This is old stuff but does not harm... They were needed
  ! for correct insertion of plots within a TEX page.
  write (olun,'(A)') '%begin(plot)'
  write (olun,'(A)') '% Will remember original state'
  write (olun,'(A)') 'save'
  write (olun,'(A)') '% Use a temporary dictionary'
  write (olun,'(A)') '50 dict begin'
  !
  call ps_prolog_gagheader(error)
  if (error)  return
  !
  ! The Prolog must be finished before the scaling factors
  write (olun,'(A)') '%%EndProlog'
  !
  ! Start the new (unique in EPS) page:
  write (olun,'(A)') '%%Page: 1 1'
  !
  ! Scaling Factors must be before the "gsave"
  ! Empirical tests on screen displays and printer drivers show that
  ! 'translate' and 'scale' operators must be in each local page setup
  ! (%%BeginPageSetup). They are (often) ignored if they are in the global
  ! setup (%%BeginSetup).
  write (olun,'(A)') '%%BeginPageSetup'
  write (olun,'(1X,F9.3,1X,F9.3,A)') x_first_pt,y_first_pt,' translate'
  !
  ! Scale along X axis (points/.VEC unit). The internal unit of .VEC files is
  ! 50 microns. Postscript uses the point (1/72 inch) as internal unit.
  scale_x_plot2pt = scale_x_plot2pt/cm2vec
  scale_y_plot2pt = scale_x_plot2pt*output%dev%rxy
  write (olun,'(2(F15.12,1X),A)') scale_x_plot2pt,scale_y_plot2pt ,'scale'
  write (olun,'(A)') '%%EndPageSetup'
  !
  write (olun,'(A)') 'gsave'
  !
end subroutine ps_open
!
subroutine ps_prolog_ps(output,dir)
  use gtv_interfaces, except_this=>ps_prolog_ps
  use gbl_message
  use gtv_ps
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display)               :: output  ! Output instance
  type(gt_directory), intent(in) :: dir     ! The directory to print
  ! Local
  character(len=*), parameter :: rname='PS'
  ! Device dependent parameters. They are defined to an accuracy of about 1%,
  ! set by the engine rather than by the electronics. Be conservative, if you
  ! don't want to occasionnaly clip a plot.
  real(kind=4) :: page_xref_pt,page_yref_pt
  real(kind=4) :: plot_xref_cm,plot_yref_cm
  real(kind=4) :: plot_xrange_cm,plot_yrange_cm
  ! Ratio of scales along X and Y. This is not exactly 1, since Y scale is
  ! defined by paper motion. There is a weak dependence on paper quality...
  ! But probably a STRONG dependence on machine, so this is taken
  ! from the GAG_TERMINAL file
  integer(kind=4) :: bbox(4)
  character(len=message_length) :: mess
  !
  ! Check PORTRAIT / LANDSCAPE mode
  if (output%autorotate) then
    ps_rotate = dir%phys_size(1).gt.dir%phys_size(2)
  else
    ps_rotate = .false.
  endif
  !
  if (ps_rotate) then
    plot_xmin_cm = 0.
    plot_xmax_cm = dir%phys_size(2)
    plot_ymin_cm = 0.
    plot_ymax_cm = dir%phys_size(1)
  else
    plot_xmin_cm = 0.
    plot_xmax_cm = dir%phys_size(1)
    plot_ymin_cm = 0.
    plot_ymax_cm = dir%phys_size(2)
  endif
  plot_xrange_cm = plot_xmax_cm-plot_xmin_cm
  plot_yrange_cm = plot_ymax_cm-plot_ymin_cm
  !
  ! Check if size is determined by X or Y size.
  if (.not.output%autoscale .or. output%ps%exact) then
    scale_x_plot2pt = cm2pt
  else
    if ((plot_xrange_cm/plot_yrange_cm) .le. (page_xw_pt/page_yw_pt)) then
      scale_x_plot2pt = page_yw_pt/plot_yrange_cm
    else
      scale_x_plot2pt = page_xw_pt/plot_xrange_cm
    endif
  endif
  !
  ! Debug
  write(mess,'(A,1X,L,A,F8.3)')  &
    'Rotation:',ps_rotate,', Scaling factor: ',scale_x_plot2pt/cm2pt
  call gtv_message(seve%d,rname,mess)
  !
  ! Portrait or Landscape?
  if (ps_rotate) then
    ! Empirical tests show that these line are recognized by PostScript
    ! viewers, but not by Latex, MS/Open/Libre-Office or eps2jpg. They
    ! must also be ignored by printers, else automatic rotation has no
    ! more meaning.
    if (plot_xrange_cm.gt.plot_yrange_cm) then
      write (olun,'(A)')  '%%Orientation: Portrait'
    else
      write (olun,'(A)')  '%%Orientation: Landscape'
    endif
  endif
  !
  ! Normally the following Bounding Box should be Absolutely OK
  ! as long as the GTVIRT keeps track of its own bounding Box !
  ! PS: reference point: the lower left corner of the paper will
  !     match the lower left corner of the (rotated) GTV plot.
  if (output%autoscale .and. .not.output%ps%exact) then
    ! Lower left corner of the usable part of the paper
    page_xref_pt = margin_xl_pt
    page_yref_pt = margin_yb_pt
  else
    ! Lower left corner of the paper
    page_xref_pt = 0.
    page_yref_pt = 0.
  endif
  if (.not.ps_rotate) then
    plot_xref_cm = plot_xmin_cm  ! Lower left corner
    plot_yref_cm = plot_ymin_cm  ! of the GTV plot
    x_first_pt = page_xref_pt - plot_xref_cm*scale_x_plot2pt
    y_first_pt = page_yref_pt - plot_yref_cm*scale_x_plot2pt
    !
    write (olun,'(A,4(1x,I10))')  '%GregBounding: ',  &
      int(plot_xmin_cm * scale_x_plot2pt + x_first_pt),    &
      int(plot_ymin_cm * scale_x_plot2pt + y_first_pt),    &
      int(plot_xmax_cm * scale_x_plot2pt + x_first_pt)+1,  &
      int(plot_ymax_cm * scale_x_plot2pt + y_first_pt)+1
  else
    plot_xref_cm = plot_xmax_cm-plot_xmax_cm  ! Lower left corner
    plot_yref_cm = plot_ymin_cm               ! of the GTV plot
    x_first_pt = page_xref_pt - plot_xref_cm*scale_x_plot2pt
    y_first_pt = page_yref_pt - plot_yref_cm*scale_x_plot2pt
    !
    write (olun,'(A,4(1x,I10))')  '%GregBounding: ',  &
      int((plot_xmax_cm-plot_xmax_cm)*scale_x_plot2pt + x_first_pt),    &
      int( plot_ymin_cm              *scale_x_plot2pt + y_first_pt),    &
      int((plot_xmax_cm-plot_xmin_cm)*scale_x_plot2pt + x_first_pt)+1,  &
      int( plot_ymax_cm              *scale_x_plot2pt + y_first_pt)+1
  endif
  !
  bbox(1) = int(x_first_pt)
  bbox(2) = int(y_first_pt)
  bbox(3) = int(plot_xrange_cm*scale_x_plot2pt + x_first_pt)+1
  bbox(4) = int(plot_yrange_cm*scale_x_plot2pt + y_first_pt)+1
  write (olun,'(A,4(1x,I10))')  '%%BoundingBox: ',bbox
  !
  ! Debug
  write(mess,'(A,4(1X,F8.3))') 'BoundingBox (cm):',  &
    bbox(1)/cm2pt,bbox(2)/cm2pt,bbox(3)/cm2pt,bbox(4)/cm2pt
  call gtv_message(seve%d,rname,mess)
  !
end subroutine ps_prolog_ps
!
subroutine ps_prolog_eps(output,dir)
  use gtv_interfaces, except_this=>ps_prolog_eps
  use gbl_message
  use gtv_ps
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display)               :: output  ! Output instance
  type(gt_directory), intent(in) :: dir     ! The directory to print
  ! Local
  character(len=*), parameter :: rname='EPS'
  ! Device dependent parameters. They are defined to an accuracy of about 1%,
  ! set by the engine rather than by the electronics. Be conservative, if you
  ! don't want to occasionnaly clip a plot.
  real(kind=4) :: page_xref_pt,page_yref_pt
  real(kind=4) :: plot_xref_cm,plot_yref_cm
  real(kind=4) :: plot_xrange_cm,plot_yrange_cm
  ! Ratio of scales along X and Y. This is not exactly 1, since Y scale is
  ! defined by paper motion. There is a weak dependence on paper quality...
  ! But probably a STRONG dependence on machine, so this is taken
  ! from the GAG_TERMINAL file
  integer(kind=4) :: bbox(4)
  character(len=message_length) :: mess
  !
  ! Check PORTRAIT / LANDSCAPE mode
  if (output%autorotate) then
    ps_rotate = (dir%gen%minmax(2)-dir%gen%minmax(1)).gt.  &
                (dir%gen%minmax(4)-dir%gen%minmax(3))
  else
    ps_rotate = .false.
  endif
  !
  if (ps_rotate) then
    ! This will clip the Bounding Box to the plot page:
    plot_xmin_cm = max(dir%gen%minmax(3),0.)
    plot_xmax_cm = min(dir%gen%minmax(4),dir%phys_size(2))
    plot_ymin_cm = max(dir%gen%minmax(1),0.)
    plot_ymax_cm = min(dir%gen%minmax(2),dir%phys_size(1))
  else
    ! This will clip the Bounding Box to the plot page:
    plot_xmin_cm = max(dir%gen%minmax(1),0.)
    plot_xmax_cm = min(dir%gen%minmax(2),dir%phys_size(1))
    plot_ymin_cm = max(dir%gen%minmax(3),0.)
    plot_ymax_cm = min(dir%gen%minmax(4),dir%phys_size(2))
  endif
  plot_xrange_cm = plot_xmax_cm-plot_xmin_cm
  plot_yrange_cm = plot_ymax_cm-plot_ymin_cm
  !
  ! Check if size is determined by X or Y size.
  if (.not.output%autoscale .or. output%ps%exact) then
    scale_x_plot2pt = cm2pt
  else
    if ((plot_xrange_cm/plot_yrange_cm) .le. (page_xw_pt/page_yw_pt)) then
      scale_x_plot2pt = page_yw_pt/plot_yrange_cm
    else
      scale_x_plot2pt = page_xw_pt/plot_xrange_cm
    endif
  endif
  !
  ! Debug
  write(mess,'(A,1X,L,A,F8.3)')  &
    'Rotation:',ps_rotate,', Scaling factor: ',scale_x_plot2pt/cm2pt
  call gtv_message(seve%d,rname,mess)
  !
  ! Portrait or Landscape?
  if (ps_rotate) then
    ! Empirical tests show that these line are recognized by PostScript
    ! viewers, but not by Latex, MS/Open/Libre-Office or eps2jpg. They
    ! must also be ignored by printers, else automatic rotation has no
    ! more meaning.
    if (plot_xrange_cm.gt.plot_yrange_cm) then
      write (olun,'(A)')  '%%Orientation: Portrait'
    else
      write (olun,'(A)')  '%%Orientation: Landscape'
    endif
  endif
  !
  ! Normally the following Bounding Box should be Absolutely OK
  ! as long as the GTVIRT keeps track of its own bounding Box !
  if (output%ps%exact) then
    ! Lower left corner of the paper
    page_xref_pt = 0.
    page_yref_pt = 0.
  else
    ! EPS: reference point: the center of the usable part of the paper
    !      will match the center of the GTV plot.
    page_xref_pt = margin_xl_pt + page_xw_pt/2.  ! Center of the usable
    page_yref_pt = margin_yb_pt + page_yw_pt/2.  ! part of the paper
  endif
  if (.not.ps_rotate) then
    if (output%ps%exact) then
      plot_xref_cm = 0.
      plot_yref_cm = 0.
    else
      plot_xref_cm = plot_xmin_cm + (plot_xmax_cm-plot_xmin_cm)/2.  ! Center of the
      plot_yref_cm = plot_ymin_cm + (plot_ymax_cm-plot_ymin_cm)/2.  ! GTV plot
    endif
    x_first_pt = page_xref_pt - plot_xref_cm*scale_x_plot2pt
    y_first_pt = page_yref_pt - plot_yref_cm*scale_x_plot2pt
    !
    ! The following can happen if autoscaling is disabled: aligning the
    ! center of the plot with the center of the page can lead to negative
    ! Bounding Box. If so, shift.
    if ((plot_xmin_cm*scale_x_plot2pt + x_first_pt).le.0.)  &  ! bbox(1)
      x_first_pt = 1. - plot_xmin_cm*scale_x_plot2pt
    if ((plot_ymin_cm*scale_x_plot2pt + y_first_pt).le.0.)  &  ! bbox(3)
      y_first_pt = 1. - plot_ymin_cm*scale_x_plot2pt
    !
    bbox(1) = int(plot_xmin_cm * scale_x_plot2pt + x_first_pt)
    bbox(2) = int(plot_ymin_cm * scale_x_plot2pt + y_first_pt)
    bbox(3) = int(plot_xmax_cm * scale_x_plot2pt + x_first_pt)+1
    bbox(4) = int(plot_ymax_cm * scale_x_plot2pt + y_first_pt)+1
  else
    if (output%ps%exact) then
      plot_xref_cm = 0.
      plot_yref_cm = 0.
    else
      plot_xref_cm =                (plot_xmax_cm-plot_xmin_cm)/2.  ! Center of the
      plot_yref_cm = plot_ymin_cm + (plot_ymax_cm-plot_ymin_cm)/2.  ! GTV plot
    endif
    x_first_pt = page_xref_pt - plot_xref_cm*scale_x_plot2pt
    y_first_pt = page_yref_pt - plot_yref_cm*scale_x_plot2pt
    !
    ! The following can happen if autoscaling is disabled: aligning the
    ! center of the plot with the center of the page can lead to negative
    ! Bounding Box. If so, shift.
    if (((plot_xmax_cm-plot_xmax_cm)*scale_x_plot2pt + x_first_pt).le.0.)  &  ! bbox(1)
      x_first_pt = 1. - (plot_xmax_cm-plot_xmax_cm)*scale_x_plot2pt
    if ((plot_ymin_cm*scale_x_plot2pt + y_first_pt).le.0.)  &  ! bbox(3)
      y_first_pt = 1. - plot_ymin_cm*scale_x_plot2pt
    !
    bbox(1) = int((plot_xmax_cm-plot_xmax_cm)*scale_x_plot2pt + x_first_pt)
    bbox(2) = int( plot_ymin_cm              *scale_x_plot2pt + y_first_pt)
    bbox(3) = int((plot_xmax_cm-plot_xmin_cm)*scale_x_plot2pt + x_first_pt)+1
    bbox(4) = int( plot_ymax_cm              *scale_x_plot2pt + y_first_pt)+1
  endif
  write(olun,'(A,4(1x,I8))')  '%%BoundingBox: ',bbox
  !
  ! Debug
  write(mess,'(A,4(1X,F8.3))') 'BoundingBox (cm):',  &
    bbox(1)/cm2pt,bbox(2)/cm2pt,bbox(3)/cm2pt,bbox(4)/cm2pt
  call gtv_message(seve%d,rname,mess)
  !
  write (olun,'(A,4(1x,F15.3))')  '%%GregPage: ',  &
    x_first_pt,                                 &
    y_first_pt,                                 &
    plot_xmax_cm*scale_x_plot2pt + x_first_pt,  &
    plot_ymax_cm*scale_x_plot2pt + y_first_pt
  !
end subroutine ps_prolog_eps
!
subroutine ps_prolog_gagheader(error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>ps_prolog_gagheader
  use gildas_def
  use gtv_ps
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='PS'
  character(len=filename_length) :: file
  integer :: ier,alun
  character(len=256) :: line
  !
  ! Here are local definitions of the "GAG Style"
  ier = sic_getlun(alun)
  if (.not.sic_query_file('gag_ps_header','data#dir:','',file)) then
    call gtv_message(seve%e,rname,'gag_ps_header not found')
    error = .true.
    return
  endif
  ier = sic_open(alun,file,'OLD',.true.)
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,'Cannot open '//file)
    call putios('E-PS,  ',ier)
    call sic_frelun (alun)
    error = .true.
    return
  endif
  do while (.true.)
    read(alun,'(A)',end=10) line
    write(olun,'(A)') trim(line)
  enddo
10 close (unit=alun)
  call sic_frelun(alun)
  !
end subroutine ps_prolog_gagheader
!
subroutine ps_pen_rgb(r,g,b)
  use gtv_interfaces, except_this=>ps_pen_rgb
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  ! Set the current pen from the input R G B values (0-255)
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: r,g,b
  !
  write(olun,'(3(F5.3,1X),A)') r/255.,g/255.,b/255.,'setrgbcolor'
  !
end subroutine ps_pen_rgb
!
subroutine ps_dash (dashed,pattern)
  use gtv_interfaces, except_this=>ps_dash
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical :: dashed                 !
  real :: pattern(4)                !
  ! Local
  integer :: i
  real :: a(4)
  !
  call ps_out(s)
  !
  if (dashed) then
    do i=1,4
      a(i) = pattern(i)*cm2vec
    enddo
    write(olun,100) (a(i),i=1,4)
100 format('[ ',4f7.2,' ] DS ')
  else
    write(olun,'(A)') '[] DS '
  endif
  !
end subroutine ps_dash
!
subroutine ps_weigh(width)
  use gtv_interfaces, except_this=>ps_weigh
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  real(kind=4), intent(in) :: width  ! Line width, in centimeter
  !
  call ps_out(s)
  !
  write(olun,'(F5.2,A)') cm2vec*width,' WS'
end subroutine ps_weigh
!
subroutine ps_moveto(x,y)
  use gtv_interfaces, except_this=>ps_moveto
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  ! Elemental 'moveto'
  !---------------------------------------------------------------------
  real, intent(in) :: x  ! X value
  real, intent(in) :: y  ! Y value
  ! Local
  integer :: ix,iy
  integer :: i1,xx
  logical :: found
  !
  ! Damned NaN
  if (x.ne.x) return
  if (y.ne.y) return
  !
  if (.not.ps_rotate) then
    ix = int(x*cm2vec)
    iy = int(y*cm2vec)
  else
    ix = int((plot_xmax_cm-y)*cm2vec)
    iy = int(x*cm2vec)
  endif
  counter = 0
  !
  ! optimisation ecriture plume haute
  ! write (olun, '(a,i5,1x,i5,a)') 's ', ix, iy, ' m'
  if (nnchar .gt. (maxbuf-17)) call ps_out(blanc)
  !
  ! First IX
  xx = ix
  found = .false.
  i1 = xx/10000
  if (i1.ne.0.or.found) then
    xx = xx-10000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/1000
  if (i1.ne.0.or.found) then
    xx = xx-1000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/100
  if (i1.ne.0.or.found) then
    xx = xx-100*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/10
  if (i1.ne.0.or.found) then
    xx = xx-10*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  nnchar = nnchar+1
  bbuf(nnchar) = ior(xx,zero)
  !
  ! Space
  nnchar = nnchar+1
  bbuf(nnchar) = blanc
  !
  ! Now IY
  xx = iy
  found = .false.
  i1 = xx/10000
  if (i1.ne.0.or.found) then
    xx = xx-10000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/1000
  if (i1.ne.0.or.found) then
    xx = xx-1000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/100
  if (i1.ne.0.or.found) then
    xx = xx-100*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/10
  if (i1.ne.0.or.found) then
    xx = xx-10*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  nnchar = nnchar+1
  bbuf(nnchar) = ior(xx,zero)
  nnchar = nnchar+1
  !
  ! Moveto
  bbuf(nnchar) = blanc
  nnchar = nnchar+1
  bbuf(nnchar) = m
  nnchar = nnchar+1
  bbuf(nnchar) = blanc
  !
end subroutine ps_moveto
!
subroutine ps_lineto(x,y)
  use gtv_interfaces, except_this=>ps_lineto
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  ! Elemental 'lineto'
  !---------------------------------------------------------------------
  real, intent(in) :: x  ! X value
  real, intent(in) :: y  ! Y value
  ! Local
  integer :: ix,iy
  integer :: i1,xx
  logical :: found
  !
  ! Damned NaN
  if (x.ne.x) return
  if (y.ne.y) return
  !
  if (.not.ps_rotate) then
    ix = int(x*cm2vec)
    iy = int(y*cm2vec)
  else
    ix = int((plot_xmax_cm-y)*cm2vec)
    iy = int(x*cm2vec)
  endif
  counter = counter+1
  !
  ! write (olun, '(i5,1x,i5,a)') ix, iy, ' l '
  if (nnchar .gt. (maxbuf-15)) call ps_out(blanc)
  xx = ix
  !
  found = .false.
  i1 = xx/10000
  if (i1.ne.0.or.found) then
    xx = xx-10000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/1000
  if (i1.ne.0.or.found) then
    xx = xx-1000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/100
  if (i1.ne.0.or.found) then
    xx = xx-100*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/10
  if (i1.ne.0.or.found) then
    xx = xx-10*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  nnchar = nnchar+1
  bbuf(nnchar) = ior(xx,zero)
  !
  nnchar = nnchar+1
  bbuf(nnchar) = blanc
  !
  xx = iy
  found = .false.
  i1 = xx/10000
  if (i1.ne.0.or.found) then
    xx = xx-10000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/1000
  if (i1.ne.0.or.found) then
    xx = xx-1000*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/100
  if (i1.ne.0.or.found) then
    xx = xx-100*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  i1 = xx/10
  if (i1.ne.0.or.found) then
    xx = xx-10*i1
    nnchar = nnchar+1
    bbuf(nnchar) = ior(i1,zero)
    found = .true.
  endif
  nnchar = nnchar+1
  bbuf(nnchar) = ior(xx,zero)
  !
  nnchar = nnchar+1
  bbuf(nnchar) = blanc
  nnchar = nnchar+1
  bbuf(nnchar) = l
  nnchar = nnchar+1
  bbuf(nnchar) = blanc
  !
end subroutine ps_lineto
!
subroutine ps_close
  use gtv_interfaces, except_this=>ps_close
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  !
  call ps_out(blanc)
  write (olun,'(A)') 'stroke grestore'
  write (olun,'(A)') '%end(plot)'
  write (olun,'(A)') 'showpage'
  write (olun,'(A)') '%%Trailer'
  write (olun,'(A)') '% End of temporary dictionary'
  write (olun,'(A)') 'end'
  write (olun,'(A)') '% restore original state'
  write (olun,'(A)') 'restore'
  write (olun,'(A)') '%%EOF'
  !
  if (olun.ne.6)  close (olun)
  !
end subroutine ps_close
!
subroutine ps_trace(trace)
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: trace
  !
  call ps_out(blanc)
  write (olun,'(A,A)') '% ',trim(trace)
end subroutine ps_trace
!
subroutine ps_stroke
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  !
  if (counter.gt.0) then
    write(olun,'(A)') 's '
    counter = 0
  endif
end subroutine ps_stroke
!
subroutine ps_out(what)
  use gtv_interfaces, except_this=>ps_out
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=1) :: what           !
  !
  if(what.ne.blanc)then
    if (counter.gt.0) then
      nnchar = nnchar+1
      bbuf(nnchar) = blanc
      nnchar = nnchar+1
      bbuf(nnchar) = what
      nnchar = nnchar+1
      bbuf(nnchar) = blanc
      counter=0
    endif
  endif
  if (nnchar.gt.0) then
    call ps_write(bbuf,nnchar,olun)
    nnchar = 0
  endif
end subroutine ps_out
!
subroutine ps_write(buf,n,olun)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer :: n                      !
  integer(kind=1) :: buf(n)         !
  integer :: olun                   !
  ! Local
  integer :: i
  write (olun,'(512A1)') (char(buf(i)), i=1, n)
end subroutine ps_write
!
subroutine ps_image_inquire(map_size,map_offset,map_color,map_static)
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer, intent(out) :: map_size    !
  integer, intent(out) :: map_offset  !
  logical, intent(out) :: map_color   !
  logical, intent(out) :: map_static  !
  !
  map_size = psmap_size
  map_offset = psmap_offset
  map_color = ps_color
  map_static = .false.  ! PS filler is not able to provide one LUT per
                        ! image of the plot.
  !
end subroutine ps_image_inquire
!
subroutine ps_fill(n,x,y)
  use gtv_interfaces, except_this=>ps_fill
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  ! Draw a filled polygon in the PostScript
  !---------------------------------------------------------------------
  integer, intent(in) :: n          ! Number of summits
  real,    intent(in) :: x(n)       ! X array
  real,    intent(in) :: y(n)       ! Y array
  ! Local
  character(len=*), parameter :: rname='PS_FILL'
  integer :: i
  !
  ! Close current line
  call ps_out(s)
  !
  write(olun,'(A)') 'NP '
  call ps_moveto(x(1),y(1))
  do i=2,n
    call ps_lineto(x(i),y(i))
  enddo
  call ps_out(blanc)
  ! the fill operation is a stroke. Thus nothing else is left to
  ! be stroked after a fill==> COUNTER=0 .
  counter = 0
  write(olun,'(A)') 'CPF '
  !
end subroutine ps_fill
!
subroutine ps_points(n,x,y)
  use gbl_message
  use gtv_interfaces, except_this=>ps_points
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !  Draw a list of dot-points in the PostScript
  !---------------------------------------------------------------------
  integer(kind=4), intent(in) :: n     ! Number of summits
  real(kind=4),    intent(in) :: x(n)  ! X array
  real(kind=4),    intent(in) :: y(n)  ! Y array
  ! Local
  integer(kind=4) :: i
  !
  do i=1,n
    ! This is probably unefficient i.e. it duplicates the number of
    ! coordinates in the PostScript. Can't we draw a dot instead?
    call ps_moveto(x(i),y(i))
    call ps_lineto(x(i),y(i))
  enddo
  !
end subroutine ps_points
!
subroutine gti_psimage(out,image)
  use gtv_interfaces, except_this=>gti_psimage
  use gildas_def
  use gtv_bitmap
  use gtv_buffers
  use gtv_plot
  use gtv_types
  use gtv_tree
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Specifique au protole PostScript
  !---------------------------------------------------------------------
  type(gt_display)           :: out    ! Output instance
  type(gt_image), intent(in) :: image  ! Image instance
  ! Local
  character(len=*), parameter :: rname='PSIMAGE'
  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,       &
    .false.,            &  ! Do not resample if possible
    2.0,                &  ! Extra resampling factor if resampling (=> 2x72 dpi)
    visible,clip,window,trans)
  if (.not.visible)  return
  !
  write(mess,'(5(A,I0))')  'Image size is ',window(1),'x',window(2),  &
    ', corner at position (',window(3),',',window(4),') "pseudo-pixel" in the PS'
  call gtv_message(seve%d,rname,mess)
  write(mess,'(A,F0.7,A,F0.7,A)')  'Ximag(Xps) = ',trans(2),' + ',trans(1),'*Xps'
  call gtv_message(seve%d,rname,mess)
  write(mess,'(A,F0.7,A,F0.7,A)')  'Yimag(Xps) = ',trans(4),' + ',trans(3),'*Yps'
  call gtv_message(seve%d,rname,mess)
  !
  ! 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
  !
  call ps_box(clip)
  !
  ! 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_psmap(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_psimage
!
subroutine ps_box(box)
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  real :: box(4)                    !
  ! Local
  integer :: ix,iy,offx,offy
  !
  ix=nint( cm2vec*(box(2)-box(1)) )
  iy=nint( cm2vec*(box(4)-box(3)) )
  write (olun,100) 'save '
  if (.not.ps_rotate) then
    offx=cm2vec*box(1)
    offy=cm2vec*box(3)
    write (olun,'(I8,1X,I8,'' translate'')') offx,offy
  else
    offx=(plot_xmax_cm-box(3))*cm2vec
    offy=box(1)*cm2vec
    write (olun,'(I8,1X,I8,'' translate'')') offx,offy
    write (olun,'('' 90 rotate '')')
  endif
  write (olun,'(I8,1X,I8,'' scale'')') ix,iy
100 format(a)
end subroutine ps_box
!
subroutine gti_psmap(image,output,bitmap,lut)
  use gtv_interfaces, except_this=>gti_psmap
  use gildas_def
  use gtv_ps
  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  !
  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
  !
  if (ncol.le.2) then
    ncol = 127
    offset = 0
  else
    offset = output%dev%map_offset
  endif
  !
  ! Scaling mode
  call compute_bitmap(image,bitmap,ncol,offset)
  !
  if (ps_color) then
    if (image%isrgb) then
      call ps_image_rgb_color(bitmap)
    else
      call ps_image_ind_color(bitmap,lut)
    endif
  else
    if (image%isrgb) then
      call ps_image_rgb_grey(bitmap)
    else
      call ps_image_ind_grey(bitmap,lut)
    endif
  endif
  !
end subroutine gti_psmap
!
subroutine ps_image_rgb_color(bitmap)
  use gtv_interfaces, except_this=>ps_image_rgb_color
  use gtv_plot
  use gtv_ps
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_bitmap), intent(in) :: bitmap  !
  ! Local
  integer, parameter :: padlen=96   ! Ne pas oublier de changer le format
  integer(kind=1) :: pad(padlen)
  integer(kind=1) :: br(psmap_size),bg(psmap_size),bb(psmap_size)
  integer(kind=4) :: index
  ! Device dependent
  ! Version for 8-bit  Bitmap
  integer(kind=2) :: entier
  integer(kind=1) :: bitval
#if defined(VAX) || defined(IEEE)
  equivalence (entier,bitval)
#endif
#if defined(EEEI)
  integer(kind=1) bitarr(2)
  equivalence (entier,bitarr(1)),(bitarr(2),bitval)
#endif
  integer :: i,j,k
  !
  ! Prepare Byte values for R, G and B
  do i=1,psmap_size
    entier = nint(real(i-1)*255.0/real(psmap_size-1),kind=1)
    br(i) = bitval
    bg(i) = bitval
    bb(i) = bitval
  enddo
  !
  write (olun,100) '%%BeginObject: True Color Image'
  write (olun,100) '/pix 96 string def'
  write (olun,'(I8,1X,I8,'' 8 % NX, NY'')') bitmap%size(1),bitmap%size(2)
  write (olun,'(''[ '',I8,'' 0 0 '',I8,'' 0 '',I8,'' ]'')') bitmap%size(1),-bitmap%size(2),bitmap%size(2)
  write (olun,100) '{currentfile pix readhexstring pop}'
  write (olun,100) 'false 3 colorimage'  ! 3 color planes
  !
  ! write truecolor RGB array in Z format,
  ! cut in 96 bytes, with padding at end.
  k=0
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      index = bitmap%irvalues(i,j)+1-psmap_offset  ! +1 because the values were
                                                   ! shifted by 1 for C indices
      k=k+1
      pad(k)=br(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
      !
      index = bitmap%igvalues(i,j)+1-psmap_offset  ! +1 because the values were
                                                   ! shifted by 1 for C indices
      k=k+1
      pad(k)=bg(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
      !
      index = bitmap%ibvalues(i,j)+1-psmap_offset  ! +1 because the values were
                                                   ! shifted by 1 for C indices
      k=k+1
      pad(k)=bb(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
    enddo
  enddo
  if(k.gt.0)then
    write (olun,'(96Z2.2)') pad
    k=0
  endif
  ! Finish padding image
  write (olun,100) 'restore '
  write (olun,100) '%%EndObject: False Color Image '
  !
100 format(a)
end subroutine ps_image_rgb_color
!
subroutine ps_image_rgb_grey(bitmap)
  use gtv_interfaces, except_this=>ps_image_rgb_grey
  use gtv_plot
  use gtv_ps
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_bitmap), intent(in) :: bitmap  !
  ! Local
  integer, parameter :: padlen=96   ! Ne pas oublier de changer le format
  integer(kind=1) :: pad(padlen)
  integer(kind=1) :: bg(psmap_size)
  real(kind=4) :: lumi
  integer(kind=4) :: index
  ! Device dependent
  ! Version for 8-bit  Bitmap
  integer(kind=2) :: entier
  integer(kind=1) :: bitval
#if defined(VAX) || defined(IEEE)
  equivalence (entier,bitval)
#endif
#if defined(EEEI)
  integer(kind=1) bitarr(2)
  equivalence (entier,bitarr(1)),(bitarr(2),bitval)
#endif
  integer :: i,j,k
  !
  ! Prepare Byte values for grey plane
  do i=1,psmap_size
    entier = nint(real(i-1)*255.0/real(psmap_size-1),kind=1)
    bg(i) = bitval
  enddo
  !
  write (olun,100) '%%BeginObject: True Color Image'
  write (olun,100) '/pix 96 string def'
  write (olun,'(I8,1X,I8,'' 8 % NX, NY'')') bitmap%size(1),bitmap%size(2)
  write (olun,'(''[ '',I8,'' 0 0 '',I8,'' 0 '',I8,'' ]'')') bitmap%size(1),-bitmap%size(2),bitmap%size(2)
  write (olun,100) '{currentfile pix readhexstring pop}'
  write (olun,100) 'false 1 colorimage'  ! 1 color plane
  !
  ! write truecolor grey array in Z format,
  ! cut in 96 bytes, with padding at end.
  k=0
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      lumi = rgb_to_grey(real(bitmap%irvalues(i,j)-psmap_offset+1,kind=4),  &
                         real(bitmap%igvalues(i,j)-psmap_offset+1,kind=4),  &
                         real(bitmap%ibvalues(i,j)-psmap_offset+1,kind=4))
      index = nint(lumi)
      k=k+1
      pad(k)=bg(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
      !
    enddo
  enddo
  if(k.gt.0)then
    write (olun,'(96Z2.2)') pad
    k=0
  endif
  ! Finish padding image
  write (olun,100) 'restore '
  write (olun,100) '%%EndObject: False Color Image '
  !
100 format(a)
end subroutine ps_image_rgb_grey
!
subroutine ps_image_ind_color(bitmap,lut)
  use gtv_interfaces, except_this=>ps_image_ind_color
  use gtv_ps
  use gtv_plot
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_bitmap), intent(in) :: bitmap  !
  type(gt_lut),    intent(in) :: lut     ! Colormap to use
  ! Local
  integer, parameter :: padlen=96    ! Ne pas oublier de changer le format
  integer(kind=1) :: pad(padlen)
  integer(kind=1) :: br(lut%size),bg(lut%size),bb(lut%size)
  integer :: index
  ! Device dependent
  ! Version for 8-bit  Bitmap
  integer(kind=2) :: entier
  integer(kind=1) :: bitval
#if defined(VAX) || defined(IEEE)
  equivalence (entier,bitval)
#endif
#if defined(EEEI)
  integer(kind=1) bitarr(2)
  equivalence (entier,bitarr(1)),(bitarr(2),bitval)
#endif
  integer :: i,j,k
  !
  ! Prepare Byte values for R, G and B
  do i=1,lut%size
    entier=int(lut%r(i)*255.0)
    br(i)=bitval
    entier=int(lut%g(i)*255.0)
    bg(i)=bitval
    entier=int(lut%b(i)*255.0)
    bb(i)=bitval
  enddo
  !
  write (olun,100) '%%BeginObject: False Color Image'
  write (olun,100) '/pix 96 string def'
  write (olun,'(I8,1X,I8,'' 8 % NX, NY'')') bitmap%size(1),bitmap%size(2)
  write (olun,'(''[ '',I8,'' 0 0 '',I8,'' 0 '',I8,'' ]'')') bitmap%size(1),-bitmap%size(2),bitmap%size(2)
  write (olun,100) '{currentfile pix readhexstring pop}'
  write (olun,100) 'false 3 colorimage'
  !
  ! write tricolor RGB array in Z format,
  ! cut in 96 bytes, with padding at end.
  k=0
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      index = bitmap%irvalues(i,j)+1-psmap_offset  ! +1 because the values were
                                                   ! shifted by 1 for C indices
      k=k+1
      pad(k)=br(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
      k=k+1
      pad(k)=bg(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
      k=k+1
      pad(k)=bb(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
    enddo
  enddo
  if (k.gt.0)then
    write (olun,'(96Z2.2)') pad
    k=0
  endif
  ! Finish padding image
  write (olun,100) 'restore '
  write (olun,100) '%%EndObject: False Color Image '
  !
100 format(a)
end subroutine ps_image_ind_color
!
subroutine ps_image_ind_grey(bitmap,lut)
  use gtv_interfaces, except_this=>ps_image_ind_grey
  use gtv_plot
  use gtv_ps
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_bitmap), intent(in) :: bitmap  !
  type(gt_lut),    intent(in) :: lut     ! Colormap to use
  ! Local
  integer, parameter :: padlen=96    ! Ne pas oublier de changer le format
  integer(kind=1) :: pad(padlen)
  integer(kind=1) :: bg(lut%size)
  integer :: index
  ! Device dependent
  ! Version for 8-bit  Bitmap
  integer(kind=2) :: entier
  integer(kind=1) :: bitval
#if defined(VAX) || defined(IEEE)
  equivalence (entier,bitval)
#endif
#if defined(EEEI)
  integer(kind=1) bitarr(2)
  equivalence (entier,bitarr(1)),(bitarr(2),bitval)
#endif
  integer :: i,j,k
  !
  ! Prepare Byte values for grey plane
  do i=1,lut%size
    entier = nint(rgb_to_grey(lut%r(i),lut%g(i),lut%b(i))*255.)
    bg(i) = bitval
  enddo
  !
  write (olun,100) '%%BeginObject: Grey Scale Image'
  write (olun,100) '/pix 96 string def'
  write (olun,'(I8,1X,I8,'' 8 % NX, NY'')') bitmap%size(1),bitmap%size(2)
  write (olun,'(''[ '',I8,'' 0 0 '',I8,'' 0 '',I8,'' ]'')') bitmap%size(1),-bitmap%size(2),bitmap%size(2)
  write (olun,100) '{currentfile pix readhexstring pop}'
  write (olun,100) 'image'
  !
  ! write monochrom array in Z format,
  ! cut in 96 bytes, with padding at end.
  k=0
  do j=1,bitmap%size(2)
    do i=1,bitmap%size(1)
      index = bitmap%irvalues(i,j)+1-psmap_offset  ! +1 because the values were
                                                   ! shifted by 1 for C indices
      k=k+1
      pad(k)=bg(index)
      if(k.ge.padlen)then
        write (olun,'(96Z2.2)') pad
        k=0
      endif
    enddo
  enddo
  if (k.gt.0)then
    write (olun,'(96Z2.2)') pad
    k=0
  endif
  ! Finish padding image
  write (olun,100) 'restore '
  write (olun,100) '%%EndObject: Grey Scale Image '
  !
100 format(a)
end subroutine ps_image_ind_grey
!
subroutine ps_hard(out)
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: out  !
  !
  ! Dash
  if (out%ps%fast) then
    out%dev%hardw_line_dash = .true.
  elseif (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 EPS (i.e. cropped) PostScripts => error!
  out%dev%hardw_line_weig = .true.
  !
end subroutine ps_hard
!
! subroutine ps_rgbbit
!   use gtv_ps
!   !---------------------------------------------------------------------
!   ! @ private
!   ! Note: this is no longer called
!   !---------------------------------------------------------------------
!   integer :: i
!   !
!   ! Close current line
!   call ps_out(s)
!   !
!   ! Old simple code:
!   write (olun,100) '%%BeginObject: Image '
!   write (olun,100) 'gsave '
!   write (olun,'(''/LUTsize '',I3,'' def'')') cmap%size
!   write (olun,100) '/Red LUTsize array def '
!   write (olun,100) '/Green LUTsize array def '
!   write (olun,100) '/Blue LUTsize array def '
!   write (olun,'(18(F6.4,1X))') (cmap%r(i),i=1,cmap%size)
!   write (olun,100) 'Red astore pop'
!   write (olun,'(18(F6.4,1X))') (cmap%g(i),i=1,cmap%size)
!   write (olun,100) 'Green astore pop'
!   write (olun,'(18(F6.4,1X))') (cmap%b(i),i=1,cmap%size)
!   write (olun,100) 'Blue astore pop'
!   !
! 100 format(a)
! end subroutine ps_rgbbit
