c
c     Copyright (c) 1999,2000, Compaq Computer Corporation
c
c     See the file "license.terms" for information on usage and redistribution
c     of this file, and for a DISCLAIMER OF ALL WARRANTIES.
c
c   A set of routines which encapsulate calls to GKS escape/GDP routines
c   used by Postmini.
c
c   Some escape features are conveniences only, and are not optional.
c   Comments in the code note this. If your GKS does not provide this
c   escape, simply make this a dummy routine, and return (safe) dummy values.
c
c   In the DEC GKS$ binding, calls to GKS ESCAPE require system dependent
c   features, such as the use of %LOC and may have 32/64 bit dependencies
c   because of the manipulation of addresses. This is another reason why
c   the escapes have been isolated in a separate source file.
c
      subroutine pm_escape_inq_seg_extent(ws_id,segment,seg_bbox,ierror)
      implicit none
c
c     This escape inquires the extent of a segment
c
c     Status: REQUIRED
c
c     Usage:  annotate.for, used with box locator PET=-1 (nonstandard locator)
c             If this locator is not supported in your GKS,
c             you may omit this escape, but you will have to recode
c             in annotate.for to avoid using PET=-1
c
      include 'gksdefs.cmn'
c
      integer ws_id, segment, ierror
      real seg_bbox
c
c     Locals
      integer in_data_size, record_buffer_length,
     1        record_size, ws_seg_info(2)
c
      structure /gesc/
         integer    nints
         integer    nfloats
         integer    nstr
         integer*4  int_addr
         integer*4  float_addr
         integer*4  str_len_addr
         integer*4  str_addr
         integer    npointers
         integer*4  pointer_addr
         integer    nlongs
         integer*4  long_addr
      end structure 
      record /gesc/ in_esc, out_esc
c
      ws_seg_info(1) = ws_id
      ws_seg_info(2) = segment
      in_data_size = sizeof(in_esc)
      in_esc.nints  = 2
      in_esc.nfloats = 0
      in_esc.nstr   = 0
      in_esc.int_addr = %LOC(ws_seg_info)
      in_esc.float_addr = 0
      in_esc.str_len_addr = 0
      in_esc.str_addr   = 0
      in_esc.npointers  = 0
      in_esc.pointer_addr = 0
      in_esc.nlongs     = 0
      in_esc.long_addr  = 0
c
      record_buffer_length = sizeof(out_esc)
      record_size = sizeof(out_esc)
      out_esc.nints = 1
      out_esc.nfloats = 4
      out_esc.nstr = 0
      out_esc.int_addr = %LOC(ierror)
      out_esc.float_addr = %LOC(seg_bbox)
      out_esc.str_len_addr = 0
      out_esc.str_addr = 0
      out_esc.npointers  = 0
      out_esc.pointer_addr = 0
      out_esc.nlongs     = 0
      out_esc.long_addr  = 0
c
      call GKS$ESCAPE(GKS$K_ESC_INQ_SEGMENT_EXTENT,
     1                in_esc, in_data_size,
     2                out_esc, record_buffer_length,
     3                record_size)
c
      return
      end
c
      subroutine pm_escape_set_window_title(ws_id, string)
      implicit none
c
c     This escape sets the title string on the plot window
c
c     Status: OPTIONAL
c
c     Usage:  plot_utils.for
c
      include 'gksdefs.cmn'
c
      integer       ws_id
      character*(*) string
c
c     Locals
      integer ilen, string_len
      integer in_data_size, record_buffer_length,
     1        record_size
      integer*4 string_addr
c
      structure /gesc/
         integer    nints
         integer    nfloats
         integer    nstr
         integer*4  int_addr
         integer*4  float_addr
         integer*4  str_len_addr
         integer*4  str_addr
         integer    npointers
         integer*4  pointer_addr
         integer    nlongs
         integer*4  long_addr
      end structure 
      record /gesc/ in_esc, out_esc
c
      in_data_size = sizeof(in_esc)
      ilen = string_len(string)
      in_esc.nints = 1
      in_esc.nfloats = 0
      in_esc.nstr = 1
      in_esc.int_addr = %LOC(ws_id)
      in_esc.float_addr = 0
      in_esc.str_len_addr = %LOC(ilen)
      string_addr = %LOC(string)
      in_esc.str_addr  = %LOC(string_addr)
      in_esc.npointers  = 0
      in_esc.pointer_addr = 0
      in_esc.nlongs     = 0
      in_esc.long_addr  = 0
c
c     No output data
      record_buffer_length = sizeof(out_esc)
      record_size = sizeof(out_esc)
      out_esc.nints = 0
      out_esc.nfloats = 0
      out_esc.nstr = 0
      out_esc.int_addr = 0
      out_esc.float_addr = 0
      out_esc.str_len_addr = 0
      out_esc.str_addr = 0
      out_esc.npointers  = 0
      out_esc.pointer_addr = 0
      out_esc.nlongs     = 0
      out_esc.long_addr  = 0
c     
      call GKS$ESCAPE(GKS$K_ESC_SET_WINDOW_TITLE,in_esc,in_data_size,
     1                out_esc, record_buffer_length, record_size)
c
      return
      end
c
      subroutine pm_escape_set_writing_mode(mode)
      implicit none
c
c     This escape sets the writing mode (e.g. RASTEROP) of the output device
c
c     Status: REQUIRED
c             Normal and compliment (XOR) writing mode are required
c             for interactive output devices
c
c     Usage:  surf_boundingbox.for
c             Used to draw a bounding box cube over a surface plot
c             which can then be quickly erased without redrawing the
c             underlying graphics.
c
c             mode == 0  -> normal drawing mode
c             mode == 1  -> draw in XOR (complement) mode
c
      include 'gksdefs.cmn'
c
      integer mode
c
c     Locals
      integer in_data_size, record_buffer_length,
     1        record_size
      integer wrt_mode
c
      structure /gesc/
         integer    nints
         integer    nfloats
         integer    nstr
         integer*4  int_addr
         integer*4  float_addr
         integer*4  str_len_addr
         integer*4  str_addr
         integer    npointers
         integer*4  pointer_addr
         integer    nlongs
         integer*4  long_addr
      end structure 
      record /gesc/ in_esc, out_esc
c
      if( mode .eq. 1 ) then
         wrt_mode = GKS$K_WRT_MODE_COMPLEMENT
      else
         wrt_mode = GKS$K_WRT_MODE_DEFAULT
      endif
c
      in_data_size = sizeof(in_esc)
      in_esc.nints = 1
      in_esc.nfloats = 0
      in_esc.nstr = 0
      in_esc.int_addr = %LOC(wrt_mode)
      in_esc.float_addr = 0
      in_esc.str_len_addr = 0
      in_esc.str_addr  = 0
      in_esc.npointers  = 0
      in_esc.pointer_addr = 0
      in_esc.nlongs     = 0
      in_esc.long_addr  = 0
c
c     No output data
      record_buffer_length = sizeof(out_esc)
      record_size = sizeof(out_esc)
      out_esc.nints = 0
      out_esc.nfloats = 0
      out_esc.nstr = 0
      out_esc.int_addr = 0
      out_esc.float_addr = 0
      out_esc.str_len_addr = 0
      out_esc.str_addr = 0
      out_esc.npointers  = 0
      out_esc.pointer_addr = 0
      out_esc.nlongs     = 0
      out_esc.long_addr  = 0
c
      call GKS$ESCAPE(GKS$K_ESC_SET_WRITING_MODE,
     1                in_esc, in_data_size,
     2                out_esc, record_buffer_length,
     3                record_size)
c
      return
      end
c
      subroutine pm_gdp_ellipse(itype,x,y,isize)
      implicit none
c
c     Draws an ellipse (itype=1)
c     given center, vector origin point, minor axis vector, major axis vector
c
c     or elliptical arc (itype=2)
c     given center, vector origin point, minor axis vector, major axis vector,
c     two end point vectors
c
c     Status: REQUIRED
c
c     Usage:  annotate.for
c
c     Required only if you want to suport annotation using ellipses.
c     Othewise you may omit it.
c
      include 'gksdefs.cmn'
c
      integer itype, isize
      real    x(isize), y(isize)
c
c     Locals
      integer in_data_size, record_buffer_length,
     1        record_size, arc_type(1), igdp
c
      structure /gesc/
         integer    nints
         integer    nfloats
         integer    nstr
         integer*4  int_addr
         integer*4  float_addr
         integer*4  str_len_addr
         integer*4  str_addr
         integer    npointers
         integer*4  pointer_addr
         integer    nlongs
         integer*4  long_addr
      end structure 
      record /gesc/ in_esc
c
      in_data_size = sizeof(in_esc)
      in_esc.nfloats = 0
      in_esc.nstr = 0
      in_esc.float_addr = 0
      in_esc.str_len_addr = 0
      in_esc.str_addr   = 0
      in_esc.npointers  = 0
      in_esc.pointer_addr = 0
      in_esc.nlongs     = 0
      in_esc.long_addr  = 0
c
      if( itype .eq. 1 ) then
         in_esc.nints = 0
         in_esc.int_addr = 0
         igdp = GKS$K_GDP_ELLIPSE_CTR_AXES
         if( isize .ne. 4 ) then
c           Wrong size
            call plt$error_message('pm_gdp_ellipse',
     1                             'Incorrect array size')
            return
         endif
      else
         in_esc.nints = 1
         in_esc.int_addr = %LOC(arc_type)
         arc_type(1) = GKS$K_ARC_TYPE_OPEN
         igdp = GKS$K_GDP_ELIARC_CTR_AXES_2VEC
         if( isize .ne. 6 ) then
c           Wrong size
            call plt$error_message('pm_gdp_ellipse',
     1                             'Incorrect array size')
            return
         endif
      endif
c
      call GKS$GDP(isize,x,y,igdp,in_esc,in_data_size)
c
      return
      end
