pgdriv.src

        Copyright (c) Kapteyn Laboratorium Groningen 2002
        All Rights Reserved.

Name:         pgdriv.src
Creator:      terlouw
Host:         maxwell
Date:         Jun 21, 2002
Contents:     Makefile.uti pgdriv.dc3 grexec.dc3 addpgdrv.dc3 addpgdrv.h
              grexec.c cpldrv.dc3 cpldrv.c cppdrv.dc3 cppdrv.c
              gdidrv.dc3 gdidrv.c nuldrv.dc3 nuldrv.c psldrv.dc3
              psldrv.c pspdrv.dc3 pspdrv.c tekdrv.dc3 tekdrv.c
              thsdrv.dc3 thsdrv.c x11drv.dc3 x11drv.c xtwdrv.dc3
              xtwdrv.c image.H

#>            Makefile.uti
SHELL  = /bin/sh

pack::
	$$gip_sys/pack.csh pgdriv.src Makefile.uti \
              pgdriv.dc3 grexec.dc3 addpgdrv.dc3 addpgdrv.h grexec.c \
              cpldrv.dc3 cpldrv.c \
              cppdrv.dc3 cppdrv.c gdidrv.dc3 gdidrv.c nuldrv.dc3 \
              nuldrv.c psldrv.dc3 psldrv.c pspdrv.dc3 pspdrv.c \
              tekdrv.dc3 tekdrv.c thsdrv.dc3 thsdrv.c x11drv.dc3 \
              x11drv.c xtwdrv.dc3 xtwdrv.c image.H
#<

#>            pgdriv.dc3
Source:       PGDRIV

Purpose:      all drivers for the GIPSY version of PGPLOT

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          by PGPLOT routines only.
              A local GREXEC replaces PGPLOT's version and calls:

               cpldrv      Colour Postscript Landscape
               cppdrv      Colour Postscript Portrait
               gdidrv      GIDS
               nuldrv      NULl device
               psldrv      PostScript Landscape
               pspdrv      PostScript Portrait
               tekdrv      TEKtronics
               thsdrv      Tektronics file for tHermes
               xtwdrv      XTerm Window
               x11drv      X11 plot server

Updates:      Oct 10, 1991: WZ, Document created.
              Oct 13, 1992: JPT, Added thsdrv.
              Sep  4, 1993: KGB, Added x11drv.
              Jan 28, 1997: JPT, Added support for loadable drivers.
              Nov 19, 1998: JPT, Upgraded PostScript drivers.
              Jan 29, 1999: JPT, Curtailed Tektronix drivers for Linux.
              Apr 27, 2000: JPT, Upgraded to PostScript Level 2.
              May 18, 2000: JPT, Implemented PostScript interpolation
              Nov 24, 2000: JPT, Increased precision for PostScript image matrix
              Jun 21, 2002: JPT, Improved PostScript interpolation.

#<

#>            grexec.dc3

Function:     GREXEC

Purpose:      Interface to device drivers for plot system.

Category:     PLOTTING

Files:        pgdriv.src

Author:       K.G. Begeman

Use:          CALL GREXEC( IDEV ,         Input        INTEGER
                           IFUNC ,        Input        INTEGER
                           RBUF ,      Input/Output    REAL ARRAY
                           NBUF ,      Input/Output    INTEGER
                           CHR ,       Input/Output    CHARACTER*(*)
                           LCHR )      Input/Output    INTEGER

              IDEV         Device identifier for PGPLOT.
              IFUNC        Wanted graphics function.
              RBUF         Real buffer.
              NBUF         Number of items in RBUF.
              CHR          Character buffer.
              LCHR         Number of items in CHR.

Description:  The device information is stored in a text file
              ("gip_loc:grdevices") which is read by GREXEC.

Updates:      Jan 15, 1991: KGB Document created.
              Oct 13, 1992: JPT tHermes tek driver code added
              Jan 28, 1997: JPT support for loadable drivers added
#<

#>            addpgdrv.dc3
Function:    addpgdrv

Purpose:     specify a loadable device driver for PGPLOT

Category:    PLOTTING

File:        pgdriv.src

Author:      J.P. Terlouw

Use:         #include "addpgdrv.h"
             int addpgdrv(driver, name, hardcopy, width, height, hoff, voff);

             driver  : pointer to the driver function.                void(*)()
             name    : PGPLOT 'device' name.                          char *
             hardcopy: command to print hardcopy (if hardcopy device)
                       or name of physical device.                    char *
             width   : width of device in milli-inches.               int  *
             height  : height of device in milli-inches.              int  *
             hoff    : horizontal offset in milli-inches.             int  *
             voff    : vertical offset in milli-inches.               int  *

             This function can only be called from C.
             Arguments hardcopy, width, height, hoffset and voffset
             are optional, i.e. they can be specified as NULL pointers.
             The return value is currently always zero.

Description: addpgdrv allows a program to extend PGPLOT's set of drivers
             with one or more drivers local to the calling program.
             The driver to be added must follow the calling convention
             as defined in grexec.dc3.
             Adding drivers must be done before any other PGPLOT routine
             is called.

Example:
          void mydriver( fint  *idev ,            /* cpl device id */
                         fint  *ifunc ,           /* function */
                         float *rbuf ,            /* float buffer */
                         fint  *nbuf ,            /* # of floats */
                         fchar chr ,              /* character buffer */
                         fint  *lchr )            /* number of characters */
          {
              .
              .   /* actual driver code */
              .
          }



          status = addpgdrv(mydriver, "MYOWN", NULL, NULL, NULL, NULL, NULL);
              .
              .
          status = pgbeg_c(&unit, tofchar("MYOWN"), &nxsub, &nysub);
              .
              .


Related documents: grexec.dc3, grdevices.doc, pgbeg.dc2.

Updates:     Jan 28, 1997: JPT Document created.
#<

#>            addpgdrv.h
#if !defined(_addpgdrv_h_)
#define _addpgdrv_h_
extern int addpgdrv(void(*driver)(), 
                     char *name, char *hardcopy,
                     int *width, int *height, int *hoffset, int *voffset);
#endif /* _addpgdrv_h_ */
#<

#>            grexec.c
/* grexec.c

	Copyright (c) Kapteyn Laboratorium Groningen 1990
	All Rights Reserved.

Fortran to C interface:

@ subroutine grexec( integer, integer, real, integer, character, integer )

*/

/*
 * includes:
 */

#include	"ctype.h"			/* <ctype.h> */
#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"xscanf.h"			/* reads setup files */
#include	"anyout.h"			/* define anyout_c */
#include	"error.h"			/* define error_c */
#include	"fname.h"			/* define fname_c */
#include	"hostname.h"			/* define hostname_c */
#include	"nelc.h"			/* define nelc_c */
#include	"cpldrv.h"			/* define cpldrv_c */
#include	"cppdrv.h"			/* define cppdrv_c */
#include	"gdidrv.h"			/* define gdidrv_c */
#include	"nuldrv.h"			/* define nuldrv_c */
#include	"psldrv.h"			/* define psldrv_c */
#include	"pspdrv.h"			/* define pspdrv_c */
#include	"tekdrv.h"			/* define tekdrv_c */
#include	"thsdrv.h"			/* define thsdrv_c */
#include	"xtwdrv.h"			/* define xtwdrv_c */
#include	"x11drv.h"			/* define x11drv_c */
#include        "addpgdrv.h"                    /* template */


/*
 * Defines:
 */

#define	NUL_DEV		0			/* NULl device */
#define	TEK_DEV		1			/* TEKtronics */
#define	PSL_DEV		2			/* PostScript Landscape */
#define	PSP_DEV		3			/* PostScript Portrait */
#define	CPL_DEV		4			/* Colour Postscript Landscape */
#define	CPP_DEV		5			/* Colour Postscript Portrait */
#define	XTW_DEV		6			/* XTerm Window */
#define	GDI_DEV		7			/* GIPSY Display Interface */
#define	THS_DEV		8			/* tHermes TEK Interface */
#define	X11_DEV		9			/* X11 plot server */
#define NXT_DEV        10                       /* First free device code */

#define	FILENAMELEN	128			/* length of file name */
#define	HOSTNAMELEN	32			/* lenght of host name */
#define	TEXTLEN		80			/* maximum length of strings */
#define	MESLEN		80			/* length of messages */
#define	MAXHOST		32			/* max. number of hosts */

#define New(type) ((type *)calloc(1,sizeof(type)))
#define Delete(x)  {free(x); x=NULL;}

typedef struct {
   char	name[TEXTLEN];				/* name of device */
   fint	gid;					/* graphics driver id  */
   int	type;					/* type of device */
   void	(*drv)();				/* driver routine */
} graphics_struct;

typedef struct _loadable {
   struct _loadable *next;                      /* link to next struct */
   int  nf;                                     /* pseudo number-of-fields */
   void (*driver)();                            /* loadable driver routine */
   char name[TEXTLEN];                          /* name of device */
   char hardcopy[TEXTLEN];                      /* hardcopy device */
   int  width;
   int  height;
   int  hoffset;
   int  voffset;
} _loadable, *loadable;

static	fint		gr_ndev = 0;		/* number of graphics devices */
static	graphics_struct	*gr_devs = NULL;	/* the device info */
static  loadable owndrivers=NULL;

/*
 * nextdriver obtains the specifications of both loadable drivers and
 * standard drivers defined in the file grdevices in the gip_loc directory.
 * It is called in a loop by inigraphics(). First the loadable drivers
 * are returned, then the standard drivers.
 */
static int nextdriver(FILE *f, char *host, int *type, char *name, char *pcmd,
               int *width, int *height, int *offw, int *offh, void(**drv)() )
{
   int nf; 
   static int nextdev=NXT_DEV;

/*
 * First process loadable drivers ...
 */
   if (owndrivers) {
      loadable current = owndrivers;
      strcpy(host,"*");                         /* every host       */
      *type = nextdev++;                        /* free device code */
      strcpy(name,current->name);
      strcpy(pcmd,current->hardcopy);
      *width    = current->width;
      *height   = current->height;
      *offw     = current->hoffset;
      *offh     = current->voffset;
      *drv      = current->driver;
      nf = current->nf;
      owndrivers = current->next;               /* remove struct from list... */
      Delete(current);                          /* ... and free memory.       */
   } else {
/*
 * ... then 'standard' drivers.
 */
      *drv = NULL;
      nf = xscanf( f, "%s %d %s %s %d %d %d %d",
                      host, type, name, pcmd, width, height, offw, offh );
   }
   return nf;
}

/*
 * inigraphics obtains device information from function nextdriver.
 * It selects the different graphics devices for the current host.
 * The information is stored in the graphics_struct.
 */

static	int	inigraphics( void )
{
   FILE		*f;				/* C file descriptor */
   char		pcmd[TEXTLEN];			/* spool command */
   char		name[TEXTLEN];			/* name of device */
   char		fnameb[FILENAMELEN+1];		/* buffer for file name */
   char		hnameb[HOSTNAMELEN+1];		/* buffer for hostname */
   char		host[MAXHOST*HOSTNAMELEN+1];	/* listed host */
   fchar	fname;				/* points to fnameb */
   fchar	hname;				/* points to hnameb */
   fint		r;				/* return value */
   int		nf;				/* number of fields */
   int		hlen;				/* length of hostname */
   int		type;				/* type of device */
   int		height;				/* height of device */
   int		width;				/* width of device */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   void        (*ldriver)();                    /* loadable driver */

   hname.a = hnameb; hname.l = HOSTNAMELEN;	/* initialize f character */
   r = hostname_c( hname );			/* get hostname */
   if (r) return( -1 );				/* cannot obtain hostname */
   hlen = nelc_c( hname );			/* length of hostname */
   hnameb[hlen] = 0;				/* add zero byte */
   fname.a = fnameb; fname.l = FILENAMELEN;	/* initialize f character */
   r = fname_c( tofchar( "gip_loc:grdevices" ), fname );
   if (r) return( -2 );				/* fnameb too small */
   fnameb[nelc_c(fname)] = 0;			/* add zero byte */
   f = fopen( fnameb, "r" );			/* open file */
   if (f == NULL) return( -3 );			/* cannot open file */
   while (!r && (nf = nextdriver( f, host, &type, name, pcmd, &width, 
                                &height, &offw, &offh, &ldriver )) > 2) {
      char	*hptr;
      int	found = 0;
      int	k = 0;

      if (nf == 3) { pcmd[0] = 0; };		/* null string */
      while ( name[k] ) { name[k] = toupper(name[k]); k++; }
      if (!strcmp( host, "*" )) {		/* wild card */
         found = 1;
      } else if ( (hptr = strstr( host, hnameb )) != NULL ) {
         found = 1;
         if (hptr != host) {
            if (hptr[-1] != ',') found = 0;
         }
         if (found && hptr[hlen] != 0 && hptr[hlen] != ',' && hptr[hlen] != '.') {
            found = 0;
         }
      }
      if (found) {				/* our machine */
         int	ndev = 0;

         while ( ndev < gr_ndev && strcmp( name, gr_devs[ndev].name ) ) ndev++;
         if ( ndev == gr_ndev ) {		/* not in list */
            gr_devs = realloc( gr_devs, sizeof( graphics_struct ) * (++gr_ndev) );
            if (gr_devs == NULL) r = -4;	/* cannot allocate space */
         } else {				/* in list */
            if ( type != gr_devs[ndev].type ) {	/* check type */
               r = -6;				/* error code */
            }
         }
         if (!r) {				/* no error */
            void	(*drv)() = NULL;	/* driver routine */

            switch( type ) {			/* which type */
               case CPL_DEV: {			/* ColourPostscriptLandscape */
                  drv = cpldrv_c;		/* the driver */
                  break;
               }
               case CPP_DEV: {			/* ColourPostscriptPortrait */
                  drv = cppdrv_c;		/* the driver */
                  break;
               }
               case NUL_DEV: {			/* NULl */
                  drv = nuldrv_c;		/* the driver */
                  break;
               }
               case PSL_DEV: {			/* PostScriptLandscape */
                  drv = psldrv_c;		/* the driver */
                  break;
               }
               case PSP_DEV: {			/* PostScriptPortrait */
                  drv = pspdrv_c;		/* the driver */
                  break;
               }
               case TEK_DEV: {			/* TEKtronix */
                  drv = tekdrv_c;		/* the driver */
                  break;
               }
               case XTW_DEV: {			/* XTerm Window */
                  drv = xtwdrv_c;		/* the driver */
                  break;
               }
               case GDI_DEV: {			/* GIDS */
                  drv = gdidrv_c;		/* the driver */
                  break;
               }
               case THS_DEV: {			/* tHermes */
                  drv = thsdrv_c;		/* the driver */
                  break;
               }
               case X11_DEV: {			/* X11 window */
                  drv = x11drv_c;		/* the driver */
                  break;
               }
               default: {			/* unknown or loadable device */
                  drv = ldriver;
                  break;
               }
            }
            if (drv != NULL) {			/* we know the type */
               fchar	chr;			/* character data */
               char	buff[TEXTLEN+TEXTLEN+1];	/* buffer */
               fint	idev;			/* device id */
               fint	ifunc = 0;		/* graphics function */
               fint	l;			/* counter */
               int	l1;			/* length of first string */
               int	l2;			/* lenght of second string */
               fint	lchr = 0;		/* number of characters */
               fint	nbuf = 2;		/* number of reals */
               float	rbuf[2];		/* dummy buffer */

               l1 = strlen( name );		/* length of plotter name */
               for (l = 0; l < l1; l++) {	/* copy loop */
                  buff[lchr++] = name[l];	/* first part of string */
               }
               l2 = strlen( pcmd );		/* length of plot command */
               for (l = 0; l < l2; l++) {	/* copy loop */
                  buff[lchr++] = pcmd[l];	/* second part of string */
               }
               gr_devs[ndev].drv = drv;		/* the driver */
               gr_devs[ndev].type = type;	/* type of device */
               chr.a = buff;			/* pointer */
               chr.l = lchr;			/* # of characters */
               rbuf[0] = l1;			/* length of first string */
               rbuf[1] = l2;			/* length of second string */
               drv( &idev, &ifunc, rbuf, &nbuf, chr, &lchr );
               if (nbuf == -1) {		/* error */
                  r = -5;			/* set error code */
               } else {				/* no error */
                  gr_devs[ndev].gid = idev;	/* the id */
                  strcpy( gr_devs[ndev].name, name );	/* put name in list */
                  if (nf >= 6) {		/* size of device */
                     ifunc = -2;		/* special function */
                     rbuf[0] = (float) height;	/* height */
                     rbuf[1] = (float) width;	/* width */
                     nbuf = 2;
                     lchr = 0;
                     drv( &idev, &ifunc, rbuf, &nbuf, chr, &lchr );
                  }
                  if (nf >= 8) {		/* offset */
                     ifunc = -3;		/* special function */
                     rbuf[0] = (float) offh;	/* offset in height */
                     rbuf[1] = (float) offw;	/* offset in width */
                     nbuf = 2;
                     lchr = 0;
                     drv( &idev, &ifunc, rbuf, &nbuf, chr, &lchr );
                  }
               }
            }
         }
      }
   }
   fclose( f );					/* close file */
   if (!r) {					/* no error */
      r = gr_ndev;				/* return number of devices */
   } else {					/* error */
      if (gr_ndev) free( gr_devs );		/* release memory */
      gr_ndev = 0;				/* reset */
   }
   return( r );					/* return to caller */
}

void	grexec_c( fint	*idev ,			/* graphics device code */
                  fint	*ifunc ,		/* graphics operation */
                  float	*rbuf ,			/* numeric data */
                  fint	*nbuf ,			/* number of numeric data */
                  fchar	chr ,			/* alpha numeric data */
                  fint	*lchr )			/* number of alpa numeric data */
{
   fint	error_level = 4;			/* fatal error */

   if (!gr_ndev) {				/* no device table yet ? */
      int	r;				/* return value */

      r = inigraphics( );			/* initialize device table */
      switch( r ) {				/* which error */
         case 0: {				/* also error */
            error_c( &error_level, tofchar( "No graphics devices available!" ) );
         }
         case -1: {
            error_c( &error_level, tofchar( "Cannot obtain hostname!" ) );
            break;
         }
         case -2: {
            error_c( &error_level, tofchar( "Cannot get path to grdevices!" ) );
            break;
         }
         case -3: {
            error_c( &error_level, tofchar( "Cannot open grdevices!" ) );
            break;
         }
         case -4: {
            error_c( &error_level, tofchar( "Cannot allocate enough memory!" ) );
            break;
         }
         case -5: {
            error_c( &error_level, tofchar( "Unknown device type in grdevices!" ) );
            break;
         }
         case -6: {
            error_c( &error_level, tofchar( "Multiple names for different devices!" ) );
            break;
         }
         default: {
            if ( r < 0 ) {
               error_c( &error_level, tofchar( "Undocumented error!" ) );
            }
            break;
         }
      }
   }
   if (*idev == 0) { 				/* means return # of devices */
      rbuf[0] = (float) gr_ndev;		/* # of graphics devices */
      *nbuf = 1;				/* we return one value */
   } else if (*idev > gr_ndev || *idev < 0) {	/* Unknown device code */
      char	msg[MESLEN];			/* message buffer */

      (void) sprintf( msg ,			/* receive the mess */
                      "Unknown device code (%d) in GREXEC!" ,
                      (int) (*idev) );		/* the code */
      error_c( &error_level ,			/* error level */
               tofchar( msg ) );		/* the message */
   } else {					/* do the graphics operation */
      fint	gid = gr_devs[(*idev) - 1].gid;

      gr_devs[(*idev) - 1].drv( &gid, ifunc, rbuf, nbuf, chr, lchr );
   }
}

int addpgdrv(void(*driver)(),
              char  *name, 
              char  *hardcopy,
              int   *width,
              int   *height,
              int   *hoffset,
              int   *voffset )
{
   loadable current=New(_loadable);             /* create struct */

   current->next = owndrivers;                  /* link in list */
   owndrivers    = current;
   current->driver = driver;
   strcpy(current->name,name);
   current->nf = 3;
   if (hardcopy) {
      current->nf++;
      strcpy(current->hardcopy,hardcopy);
      if (width) {
         current->nf++;
         current->width   = *width;
         if (height) {
            current->nf++;  
            current->height  = *height;
            if (hoffset) {
               current->nf++;
               current->hoffset = *hoffset;
               if (voffset) {
                  current->nf++;
                  current->voffset = *voffset;
               }
            }
         }
      }
   }
   return 0; /* always success! */
}
#<

#>            cpldrv.dc3
Function:     CPLDRV

Purpose:      The ColourPostscriptLandscape graphics driver for the GIPSY
              plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL CPLDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Jan 18, 1991: KGB Document created.
              Oct 27, 1998: JPT Invent unique filenames for plot.
              Nov 12, 1998: JPT Implemented opcodes 26 and 29.
              Apr 27, 2000: JPT PostScript level 2; implemented image
                                interpolation, color map and ASCII85 encoding.
              May 18, 2000: JPT Interpolation algorithm in PostScript. 
              Jun 21, 2002: JPT Improved PostScript interpolation.
#<

#>            cpldrv.c
/* cpldrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1991
	All Rights Reserved.

Fortran to C interface:

@ subroutine cpldrv( integer, integer, real, integer, character, integer )

*/
#if !defined(PSLL1)

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */
#include        "pgqbci.h"
#include        "image.H"                       /* image definitions */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.CPL"			/* device format string */
#define	DEVICE	"CPS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	4				/* PS in landscape mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	red[NCOLORS];			/* the reds */
   double	green[NCOLORS];			/* the greens */
   double	blue[NCOLORS];			/* the blues */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} cpl_struct;

static	double		red[] = {		/* initial reds */
   1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00,
   1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67
};
static	double		green[] = {		/* initial greens */
   1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00,
   0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67
};
static	double		blue[] = {		/* initial blues */
   1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00,
   0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67
};

static	int		cpl_ndev = 0;		/* number of cpl devices */
static	cpl_struct	*cpl_devs = NULL;	/* cpl device info */


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}

static int outbytes;
static void outbyte (unsigned char c, FILE *out)
{
  (void)fputc(c, out);

  if (++outbytes > 63 /*||  (outbytes == 1 && c == '%')*/ ) {
     fputc('\n', out);                 /* insert line feed */
     outbytes = 0;
  }
}

/*
 *  Send ASCII85 encoded image data.
 */
static void ASCII85send(float *pixels, int num, FILE *unit)
{
   static int count;
   static unsigned int buf[4];
   static unsigned long power85[5] = {1L,85L,85L*85,85L*85*85,85L*85*85*85};
   register int i;
   unsigned long word, v;

   if (num) {
      while (num--) {
         buf[count++] = *(pixels++);
         if (count==4) {
            count = 0;
            word = (unsigned long)(
                      (((buf[0] << 8) | buf[1]) << 16) |
                        (buf[2] << 8) | buf[3]);
            if (word==0) {
               outbyte('z', unit);
            } else {
               for (i = 4; i >= 0; i--) {
                  v = word / power85[i];
                  outbyte((unsigned char)(v + '!'), unit);
                  word -= v * power85[i];
               }
            }
         }
      }
   } else {
      if (count != 0) {   /* 1-3 bytes left */
         word = 0;
         for (i = count-1; i >= 0; i--)   /* accumulate bytes */
            word += (unsigned long)buf[i] << 8 * (3-i);
         for (i = 4; i >= 4-count; i--) {
            v = word / power85[i];
            outbyte((unsigned char)(v + '!'), unit);
            word -= v * power85[i];
         }
      }
      fputc('~', unit);
      fputc('>', unit);
      count = 0;
      outbytes = 0;   
   }
}

/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = cpl_devs[id].unit;		/* file descriptor */
   char	*obuf = cpl_devs[id].obuf;		/* destination */
   int	lobuf = cpl_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   cpl_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   cpl_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The PostScriptLandscape driver.
 */

void	cpldrv_c( fint	*idev ,			/* cpl device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= cpl_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown cpl device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         cpl_devs[(*idev)].offh = nint( rbuf[0] );
         cpl_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         cpl_devs[(*idev)].height = nint( rbuf[0] );
         cpl_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * cpl device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* cpl device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < cpl_ndev && strncmp( chr.a, cpl_devs[id].type, l1 ) ) id++;
         if ( id == cpl_ndev ) {		/* new entry */
            cpl_devs = realloc( cpl_devs, ++cpl_ndev * sizeof( cpl_struct ) );
            if (cpl_devs == NULL) (*nbuf) = -1;	/* error */
            else cpl_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; cpl_devs[id].type[l++] = chr.a[i++]);
            cpl_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; cpl_devs[id].pfmt[l++] = chr.a[i++]);
            cpl_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( cpl_devs[id].name ,
                            DEVFMT ,
                            cpl_devs[id].type ,
                            getpid( ),
                            cpl_devs[id].seqno );
            for (n = 0; n < 16; n++) {  /* initiate the colours */
               cpl_devs[id].red[n]   = red[n];          /* set initial reds */
               cpl_devs[id].green[n] = green[n];        /* set initial greens */
               cpl_devs[id].blue[n]  = blue[n];         /* set initial blues */
            }
            for (n=16; n<NCOLORS; n++) {
               cpl_devs[id].red[n]   = 0.0;   
               cpl_devs[id].green[n] = 0.0;
               cpl_devs[id].blue[n]  = 0.0;
            }

            cpl_devs[id].height = HEIGHT;	/* default height */
            cpl_devs[id].width  = WIDTH;	/* default width */
            cpl_devs[id].offh   = OFFH;		/* default height offset*/
            cpl_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, cpl_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpl_devs[(*idev)].width-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, cpl_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpl_devs[(*idev)].width-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];
         int    ci;

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( cpl_devs[(*idev)].pcmd ,
                         cpl_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) cpl_devs[(*idev)].offh );
            ow = nint( SCALE * (float) cpl_devs[(*idev)].offw );
            h = nint( SCALE * (float) (cpl_devs[(*idev)].height + cpl_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (cpl_devs[(*idev)].width  + cpl_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, cpl_devs[(*idev)].name );
            cpl_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            cpl_devs[(*idev)].lasti = -1;	/* reset last x */
            cpl_devs[(*idev)].lastj = -1;	/* reset last y */
            cpl_devs[(*idev)].npts  =  0;	/* reset number of points */
            cpl_devs[(*idev)].npage =  0;	/* reset number of pages */
            cpl_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 2\n" );
            fprintf( unit, "%%%%Orientation: Landscape\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/grimip false def /Blank 0 def\n");
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "/SCR {CMAP 3 1 roll putinterval} bind def\n");
            fprintf( unit, "/SCI /setcolor load def\n");
            fprintf( unit, "/CMAP %d string def\n", NCOLORS*3 );
            fprintf( unit, "CMAP 0 <");
            for (ci=0; ci<16; ci++) {
            fprintf(unit, "%2.2X%2.2X%2.2X",
               nint(255.0*cpl_devs[(*idev)].red[ci]),
               nint(255.0*cpl_devs[(*idev)].green[ci]),
               nint(255.0*cpl_devs[(*idev)].blue[ci]) );
            }
            fprintf( unit, "> putinterval\n");
            fprintf( unit, "[/Indexed /DeviceRGB %d CMAP] setcolorspace\n",
                           NCOLORS-1);
            fprintf( unit, INTERPOL);
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = cpl_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", cpl_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( cpl_devs[(*idev)].pcmd );
         cpl_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( cpl_devs[(*idev)].name ,
                         DEVFMT ,
                         cpl_devs[(*idev)].type ,
                         getpid( ),
                         cpl_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = cpl_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++cpl_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate 90 rotate\n", cpl_devs[(*idev)].width + cpl_devs[(*idev)].offw, cpl_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = cpl_devs[(*idev)].lasti;/* last x */
         int	lastj = cpl_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         cpl_devs[(*idev)].lasti = i1;		/* save end x */
         cpl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         cpl_devs[(*idev)].lasti = i1;		/* save end x */
         cpl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (cpl_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( cpl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpl_devs[(*idev)].lobuf ,
                     cpl_devs[(*idev)].obuf );
            cpl_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( cpl_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %d SCI", ci);
         cpl_devs[(*idev)].lasti = -1;		/* reset end x */
         cpl_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (cpl_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( cpl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpl_devs[(*idev)].lobuf ,
                     cpl_devs[(*idev)].obuf );
            cpl_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = cpl_devs[(*idev)].npts;	/* number of points */
         int	start = cpl_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = cpl_devs[(*idev)].lasti;
            lastj = cpl_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            cpl_devs[(*idev)].lasti = lasti;
            cpl_devs[(*idev)].lastj = lastj;
         }
         cpl_devs[(*idev)].npts  = npts;
         cpl_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         char   instr[TXTLEN];                  /* character buffer */
         int    l;                              /* number of characters */
         int    i1 = nint( rbuf[0] );

         cpl_devs[(*idev)].red[i1]   = rbuf[1];	/* red */
         cpl_devs[(*idev)].green[i1] = rbuf[2];	/* green */
         cpl_devs[(*idev)].blue[i1]  = rbuf[3];	/* blue */
         l = sprintf(instr,"%d <%2.2X%2.2X%2.2X> SCR", i1*3,
               nint(255.0*cpl_devs[(*idev)].red[i1]),
               nint(255.0*cpl_devs[(*idev)].green[i1]),
               nint(255.0*cpl_devs[(*idev)].blue[i1]) );
         send( instr, l, (*idev) );             /* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         cpl_devs[(*idev)].lasti = -1;
         cpl_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( cpl_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         cpl_devs[(*idev)].lasti = -1;
         cpl_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         static int bufcnt;
         int i;
         int n=rbuf[0];

         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];

            bufcnt = 0;
            fprintf( cpl_devs[(*idev)].unit, "save\n");
            /*  declare Blank color index */
            {
               fint bci;  
               pgqbci_c(&bci);
               fprintf( cpl_devs[(*idev)].unit, "/Blank %d def\n", bci);
            }
            fprintf( cpl_devs[(*idev)].unit, IMGPAR,
                     nxp, nyp,
                     rbuf[7], rbuf[8], rbuf[9], rbuf[10], rbuf[11], rbuf[12],
                     xorg, yorg, xlen, ylen, -xlen );
            
            fprintf( cpl_devs[(*idev)].unit,
                     "%f %f moveto %f 0 rlineto 0 %f rlineto\n",
                    xorg, yorg, xlen, ylen);
            fprintf( cpl_devs[(*idev)].unit,
                     "%f 0 rlineto closepath clip\n", -xlen);

            fprintf( cpl_devs[(*idev)].unit, "<<\n");
            fprintf( cpl_devs[(*idev)].unit, "  /ImageType 1\n");
            fprintf( cpl_devs[(*idev)].unit, "  /BitsPerComponent 8\n");
            fprintf( cpl_devs[(*idev)].unit, "  /Decode [0 %d]\n", NCOLORS-1);
            fprintf( cpl_devs[(*idev)].unit, "  /Width  Nx\n");
            fprintf( cpl_devs[(*idev)].unit, "  /Height Ny\n");
            fprintf( cpl_devs[(*idev)].unit, "  /ImageMatrix Imgmat\n");
            fprintf( cpl_devs[(*idev)].unit, "  /DataSource { pixels }\n");
            fprintf( cpl_devs[(*idev)].unit, ">> image\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            ASCII85send(NULL, 0, cpl_devs[(*idev)].unit);
            fprintf( cpl_devs[(*idev)].unit, "\nrestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            ASCII85send(rbuf+1, n, cpl_devs[(*idev)].unit);
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = cpl_devs[(*idev)].red[ci];
         rbuf[2] = cpl_devs[(*idev)].green[ci];
         rbuf[3] = cpl_devs[(*idev)].blue[ci];
         break;                                 /* done */
      }
            
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#else

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.CPL"			/* device format string */
#define	DEVICE	"CPS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	4				/* PS in landscape mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	red[NCOLORS];			/* the reds */
   double	green[NCOLORS];			/* the greens */
   double	blue[NCOLORS];			/* the blues */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} cpl_struct;

static	double		red[] = {		/* initial reds */
   1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00,
   1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67
};
static	double		green[] = {		/* initial greens */
   1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00,
   0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67
};
static	double		blue[] = {		/* initial blues */
   1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00,
   0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67
};

static	int		cpl_ndev = 0;		/* number of cpl devices */
static	cpl_struct	*cpl_devs = NULL;	/* cpl device info */


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = cpl_devs[id].unit;		/* file descriptor */
   char	*obuf = cpl_devs[id].obuf;		/* destination */
   int	lobuf = cpl_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   cpl_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   cpl_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The PostScriptLandscape driver.
 */

void	cpldrv_c( fint	*idev ,			/* cpl device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= cpl_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown cpl device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         cpl_devs[(*idev)].offh = nint( rbuf[0] );
         cpl_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         cpl_devs[(*idev)].height = nint( rbuf[0] );
         cpl_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * cpl device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* cpl device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < cpl_ndev && strncmp( chr.a, cpl_devs[id].type, l1 ) ) id++;
         if ( id == cpl_ndev ) {		/* new entry */
            cpl_devs = realloc( cpl_devs, ++cpl_ndev * sizeof( cpl_struct ) );
            if (cpl_devs == NULL) (*nbuf) = -1;	/* error */
            else cpl_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; cpl_devs[id].type[l++] = chr.a[i++]);
            cpl_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; cpl_devs[id].pfmt[l++] = chr.a[i++]);
            cpl_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( cpl_devs[id].name ,
                            DEVFMT ,
                            cpl_devs[id].type ,
                            getpid( ),
                            cpl_devs[id].seqno );
            for (n = 0; n < NCOLORS; n++) {		/* initiate the colours */
               cpl_devs[id].red[n] = red[n%16];	/* set initial reds */
               cpl_devs[id].green[n] = green[n%16];/* set initial greens */
               cpl_devs[id].blue[n] = blue[n%16];/* set initial blues */
            }
            cpl_devs[id].height = HEIGHT;	/* default height */
            cpl_devs[id].width  = WIDTH;	/* default width */
            cpl_devs[id].offh   = OFFH;		/* default height offset*/
            cpl_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, cpl_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpl_devs[(*idev)].width-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, cpl_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpl_devs[(*idev)].width-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( cpl_devs[(*idev)].pcmd ,
                         cpl_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) cpl_devs[(*idev)].offh );
            ow = nint( SCALE * (float) cpl_devs[(*idev)].offw );
            h = nint( SCALE * (float) (cpl_devs[(*idev)].height + cpl_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (cpl_devs[(*idev)].width  + cpl_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, cpl_devs[(*idev)].name );
            cpl_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            cpl_devs[(*idev)].lasti = -1;	/* reset last x */
            cpl_devs[(*idev)].lastj = -1;	/* reset last y */
            cpl_devs[(*idev)].npts  =  0;	/* reset number of points */
            cpl_devs[(*idev)].npage =  0;	/* reset number of pages */
            cpl_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 1\n" );
            fprintf( unit, "%%%%Orientation: Landscape\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = cpl_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", cpl_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( cpl_devs[(*idev)].pcmd );
         cpl_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( cpl_devs[(*idev)].name ,
                         DEVFMT ,
                         cpl_devs[(*idev)].type ,
                         getpid( ),
                         cpl_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = cpl_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++cpl_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate 90 rotate\n", cpl_devs[(*idev)].width + cpl_devs[(*idev)].offw, cpl_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = cpl_devs[(*idev)].lasti;/* last x */
         int	lastj = cpl_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         cpl_devs[(*idev)].lasti = i1;		/* save end x */
         cpl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         cpl_devs[(*idev)].lasti = i1;		/* save end x */
         cpl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (cpl_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( cpl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpl_devs[(*idev)].lobuf ,
                     cpl_devs[(*idev)].obuf );
            cpl_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( cpl_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %f %f %f setrgbcolor",
            cpl_devs[(*idev)].red[ci],
            cpl_devs[(*idev)].green[ci],
            cpl_devs[(*idev)].blue[ci] );
         cpl_devs[(*idev)].lasti = -1;		/* reset end x */
         cpl_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (cpl_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( cpl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpl_devs[(*idev)].lobuf ,
                     cpl_devs[(*idev)].obuf );
            cpl_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = cpl_devs[(*idev)].npts;	/* number of points */
         int	start = cpl_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = cpl_devs[(*idev)].lasti;
            lastj = cpl_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            cpl_devs[(*idev)].lasti = lasti;
            cpl_devs[(*idev)].lastj = lastj;
         }
         cpl_devs[(*idev)].npts  = npts;
         cpl_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         int	i1 = nint( rbuf[0] );

         cpl_devs[(*idev)].red[i1]   = rbuf[1];	/* red */
         cpl_devs[(*idev)].green[i1] = rbuf[2];	/* green */
         cpl_devs[(*idev)].blue[i1]  = rbuf[3];	/* blue */
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         cpl_devs[(*idev)].lasti = -1;
         cpl_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( cpl_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         cpl_devs[(*idev)].lasti = -1;
         cpl_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         int i;
         int n=rbuf[0];

         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];

            fprintf( cpl_devs[(*idev)].unit, "gsave newpath\n");
            fprintf( cpl_devs[(*idev)].unit,
                     "%f %f moveto %f 0 rlineto 0 %f rlineto\n",
                    xorg, yorg, xlen, ylen);
            fprintf( cpl_devs[(*idev)].unit,
                     "%f 0 rlineto closepath clip\n", -xlen);
            fprintf( cpl_devs[(*idev)].unit, "/picstr %d string def\n", nxp);
            fprintf( cpl_devs[(*idev)].unit, "%d %d 8 [",  nxp, nyp);  
            for (i=7; i<13; i++) {
               fprintf( cpl_devs[(*idev)].unit, " %.4E ", rbuf[i]);  
            }
            fprintf( cpl_devs[(*idev)].unit, "]\n");
            fprintf( cpl_devs[(*idev)].unit,
               "{currentfile picstr readhexstring pop} false 3 colorimage\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            fprintf( cpl_devs[(*idev)].unit, "grestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            for (i=0; i<n; i++) {
               int ci = rbuf[i+1];
               fprintf( cpl_devs[(*idev)].unit, "%2.2X%2.2X%2.2X",
               nint(255.0*cpl_devs[(*idev)].red[ci]),
               nint(255.0*cpl_devs[(*idev)].green[ci]),
               nint(255.0*cpl_devs[(*idev)].blue[ci]) );
            }
            fprintf( cpl_devs[(*idev)].unit, "\n");
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = cpl_devs[(*idev)].red[ci];
         rbuf[2] = cpl_devs[(*idev)].green[ci];
         rbuf[3] = cpl_devs[(*idev)].blue[ci];
         break;                                 /* done */
      }
            
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#endif
#<

#>            cppdrv.dc3
Function:     CPPDRV

Purpose:      The ColourPostscriptLandscape graphics driver for the GIPSY
              plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL CPPDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Jan 18, 1991: KGB Document created.
              Oct 27, 1998: JPT Invent unique filenames for plot.
              Nov 12, 1998: JPT Implemented opcodes 26 and 29.
              Apr 27, 2000: JPT PostScript level 2; implemented image
                                interpolation, color map and ASCII85 encoding.
              May 18, 2000: JPT Interpolation algorithm in PostScript.
              Jun 21, 2002: JPT Improved PostScript interpolation.

#<

#>            cppdrv.c
/* cppdrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1991, 1998
	All Rights Reserved.

Fortran to C interface:

@ subroutine cppdrv( integer, integer, real, integer, character, integer )

*/
#if !defined(PSLL1)

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */
#include        "pgqbci.h"
#include        "image.H"                       /* image definitions */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.CPP"			/* device format string */
#define	DEVICE	"VCPS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	5				/* PS in portrait mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	red[NCOLORS];			/* the reds */
   double	green[NCOLORS];			/* the greens */
   double	blue[NCOLORS];			/* the blues */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} cpp_struct;

static	double		red[] = {		/* initial reds */
   1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00,
   1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67
};
static	double		green[] = {		/* initial greens */
   1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00,
   0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67
};
static	double		blue[] = {		/* initial blues */
   1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00,
   0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67
};

static	int		cpp_ndev = 0;		/* number of cpp devices */
static	cpp_struct	*cpp_devs = NULL;	/* cpp device info */


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}

static int outbytes;
static void outbyte (unsigned char c, FILE *out)
{
  (void)fputc(c, out);
        
  if (++outbytes > 63 /*||  (outbytes == 1 && c == '%')*/ ) {
     fputc('\n', out);                 /* insert line feed */
     outbytes = 0;
  }
}

/*
 *  Send ASCII85 encoded image data.
 */
static void ASCII85send(float *pixels, int num, FILE *unit)
{
   static int count;
   static unsigned int buf[4];
   static unsigned long power85[5] = {1L,85L,85L*85,85L*85*85,85L*85*85*85};
   register int i;
   unsigned long word, v;
    
   if (num) {
      while (num--) {
         buf[count++] = *(pixels++);
         if (count==4) {
            count = 0;
            word = (unsigned long)(
                      (((buf[0] << 8) | buf[1]) << 16) |
                        (buf[2] << 8) | buf[3]);
            if (word==0) {
               outbyte('z', unit);
            } else {
               for (i = 4; i >= 0; i--) {
                  v = word / power85[i];
                  outbyte((unsigned char)(v + '!'), unit);
                  word -= v * power85[i];
               }
            }
         }
      }
   } else {
      if (count != 0) {   /* 1-3 bytes left */
         word = 0;
         for (i = count-1; i >= 0; i--)   /* accumulate bytes */
            word += (unsigned long)buf[i] << 8 * (3-i);
         for (i = 4; i >= 4-count; i--) {
            v = word / power85[i];
            outbyte((unsigned char)(v + '!'), unit);
            word -= v * power85[i];
         }
      }
      fputc('~', unit);
      fputc('>', unit);
      count = 0;
      outbytes = 0;
   }
}

/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = cpp_devs[id].unit;		/* file descriptor */
   char	*obuf = cpp_devs[id].obuf;		/* destination */
   int	lobuf = cpp_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   cpp_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   cpp_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The PostScriptPortrait driver.
 */

void	cppdrv_c( fint	*idev ,			/* cpp device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= cpp_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown cpp device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         cpp_devs[(*idev)].offh = nint( rbuf[0] );
         cpp_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         cpp_devs[(*idev)].height = nint( rbuf[0] );
         cpp_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * cpp device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* cpp device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < cpp_ndev && strncmp( chr.a, cpp_devs[id].type, l1 ) ) id++;
         if ( id == cpp_ndev ) {		/* new entry */
            cpp_devs = realloc( cpp_devs, ++cpp_ndev * sizeof( cpp_struct ) );
            if (cpp_devs == NULL) (*nbuf) = -1;	/* error */
            else cpp_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; cpp_devs[id].type[l++] = chr.a[i++]);
            cpp_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; cpp_devs[id].pfmt[l++] = chr.a[i++]);
            cpp_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( cpp_devs[id].name ,
                            DEVFMT ,
                            cpp_devs[id].type ,
                            getpid( ),
                            cpp_devs[id].seqno );
            for (n = 0; n < 16; n++) {	/* initiate the colours */
               cpp_devs[id].red[n]   = red[n];    	/* set initial reds */
               cpp_devs[id].green[n] = green[n];	/* set initial greens */
               cpp_devs[id].blue[n]  = blue[n];		/* set initial blues */
            }
            for (n=16; n<NCOLORS; n++) {
               cpp_devs[id].red[n]   = 0.0;
               cpp_devs[id].green[n] = 0.0;
               cpp_devs[id].blue[n]  = 0.0;
            }

            cpp_devs[id].height = HEIGHT;	/* default height */
            cpp_devs[id].width  = WIDTH;	/* default width */
            cpp_devs[id].offh   = OFFH;		/* default height offset*/
            cpp_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, cpp_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpp_devs[(*idev)].height-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, cpp_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpp_devs[(*idev)].height-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];
         int    ci;

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( cpp_devs[(*idev)].pcmd ,
                         cpp_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) cpp_devs[(*idev)].offh );
            ow = nint( SCALE * (float) cpp_devs[(*idev)].offw );
            h = nint( SCALE * (float) (cpp_devs[(*idev)].height + cpp_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (cpp_devs[(*idev)].width  + cpp_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, cpp_devs[(*idev)].name );
            cpp_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            cpp_devs[(*idev)].lasti = -1;	/* reset last x */
            cpp_devs[(*idev)].lastj = -1;	/* reset last y */
            cpp_devs[(*idev)].npts  =  0;	/* reset number of points */
            cpp_devs[(*idev)].npage =  0;	/* reset number of pages */
            cpp_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 2\n" );
            fprintf( unit, "%%%%Orientation: Portrait\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/grimip false def /Blank 0 def\n");
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "/SCR {CMAP 3 1 roll putinterval} bind def\n");
            fprintf( unit, "/SCI /setcolor load def\n");
            fprintf( unit, "/CMAP %d string def\n", NCOLORS*3 );
            fprintf( unit, "CMAP 0 <");
            for (ci=0; ci<16; ci++) {
            fprintf(unit, "%2.2X%2.2X%2.2X",
               nint(255.0*cpp_devs[(*idev)].red[ci]),
               nint(255.0*cpp_devs[(*idev)].green[ci]),
               nint(255.0*cpp_devs[(*idev)].blue[ci]) );
            }
            fprintf( unit, "> putinterval\n");
            fprintf( unit, "[/Indexed /DeviceRGB %d CMAP] setcolorspace\n",
                           NCOLORS-1);
            fprintf( unit, INTERPOL);
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = cpp_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", cpp_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( cpp_devs[(*idev)].pcmd );
         cpp_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( cpp_devs[(*idev)].name ,
                         DEVFMT ,
                         cpp_devs[(*idev)].type ,
                         getpid( ),
                         cpp_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = cpp_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++cpp_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate\n", cpp_devs[(*idev)].offw, cpp_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = cpp_devs[(*idev)].lasti;/* last x */
         int	lastj = cpp_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         cpp_devs[(*idev)].lasti = i1;		/* save end x */
         cpp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         cpp_devs[(*idev)].lasti = i1;		/* save end x */
         cpp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (cpp_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( cpp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpp_devs[(*idev)].lobuf ,
                     cpp_devs[(*idev)].obuf );
            cpp_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( cpp_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %d SCI", ci);
         cpp_devs[(*idev)].lasti = -1;		/* reset end x */
         cpp_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (cpp_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( cpp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpp_devs[(*idev)].lobuf ,
                     cpp_devs[(*idev)].obuf );
            cpp_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = cpp_devs[(*idev)].npts;	/* number of points */
         int	start = cpp_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = cpp_devs[(*idev)].lasti;
            lastj = cpp_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            cpp_devs[(*idev)].lasti = lasti;
            cpp_devs[(*idev)].lastj = lastj;
         }
         cpp_devs[(*idev)].npts  = npts;
         cpp_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         char   instr[TXTLEN];                  /* character buffer */
         int    l;                              /* number of characters */
         int	i1 = nint( rbuf[0] );
         

         cpp_devs[(*idev)].red[i1]   = rbuf[1];	/* red */
         cpp_devs[(*idev)].green[i1] = rbuf[2];	/* green */
         cpp_devs[(*idev)].blue[i1]  = rbuf[3];	/* blue */
         l = sprintf(instr,"%d <%2.2X%2.2X%2.2X> SCR", i1*3,
               nint(255.0*cpp_devs[(*idev)].red[i1]),  
               nint(255.0*cpp_devs[(*idev)].green[i1]), 
               nint(255.0*cpp_devs[(*idev)].blue[i1]) );
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         cpp_devs[(*idev)].lasti = -1;
         cpp_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( cpp_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         cpp_devs[(*idev)].lasti = -1;
         cpp_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         static int bufcnt;
         int i;
         int n=rbuf[0];
            
         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];

            bufcnt = 0;
            fprintf( cpp_devs[(*idev)].unit, "save\n");
            /*  declare Blank color index */
            {
               fint bci;  
               pgqbci_c(&bci);
               fprintf( cpp_devs[(*idev)].unit, "/Blank %d def\n", bci);
            }
            fprintf( cpp_devs[(*idev)].unit, IMGPAR,
                     nxp, nyp,
                     rbuf[7], rbuf[8], rbuf[9], rbuf[10], rbuf[11], rbuf[12],
                     xorg, yorg, xlen, ylen, -xlen );
            
            fprintf( cpp_devs[(*idev)].unit, "<<\n");
            fprintf( cpp_devs[(*idev)].unit, "  /ImageType 1\n");
            fprintf( cpp_devs[(*idev)].unit, "  /BitsPerComponent 8\n");
            fprintf( cpp_devs[(*idev)].unit, "  /Decode [0 %d]\n", NCOLORS-1);
            fprintf( cpp_devs[(*idev)].unit, "  /Width  Nx\n");
            fprintf( cpp_devs[(*idev)].unit, "  /Height Ny\n");           
            fprintf( cpp_devs[(*idev)].unit, "  /ImageMatrix Imgmat\n");
            fprintf( cpp_devs[(*idev)].unit, "  /DataSource { pixels }\n");
            fprintf( cpp_devs[(*idev)].unit, ">> image\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            ASCII85send(NULL, 0, cpp_devs[(*idev)].unit);
            fprintf( cpp_devs[(*idev)].unit, "\nrestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            ASCII85send(rbuf+1, n, cpp_devs[(*idev)].unit);
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = cpp_devs[(*idev)].red[ci];
         rbuf[2] = cpp_devs[(*idev)].green[ci];
         rbuf[3] = cpp_devs[(*idev)].blue[ci];
         break;                                 /* done */
      }

      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#else

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.CPP"			/* device format string */
#define	DEVICE	"VCPS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	5				/* PS in portrait mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	red[NCOLORS];			/* the reds */
   double	green[NCOLORS];			/* the greens */
   double	blue[NCOLORS];			/* the blues */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} cpp_struct;

static	double		red[] = {		/* initial reds */
   1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00,
   1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67
};
static	double		green[] = {		/* initial greens */
   1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00,
   0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67
};
static	double		blue[] = {		/* initial blues */
   1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00,
   0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67
};

static	int		cpp_ndev = 0;		/* number of cpp devices */
static	cpp_struct	*cpp_devs = NULL;	/* cpp device info */


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = cpp_devs[id].unit;		/* file descriptor */
   char	*obuf = cpp_devs[id].obuf;		/* destination */
   int	lobuf = cpp_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   cpp_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   cpp_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The PostScriptLandscape driver.
 */

void	cppdrv_c( fint	*idev ,			/* cpp device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= cpp_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown cpp device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         cpp_devs[(*idev)].offh = nint( rbuf[0] );
         cpp_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         cpp_devs[(*idev)].height = nint( rbuf[0] );
         cpp_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * cpp device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* cpp device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < cpp_ndev && strncmp( chr.a, cpp_devs[id].type, l1 ) ) id++;
         if ( id == cpp_ndev ) {		/* new entry */
            cpp_devs = realloc( cpp_devs, ++cpp_ndev * sizeof( cpp_struct ) );
            if (cpp_devs == NULL) (*nbuf) = -1;	/* error */
            else cpp_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; cpp_devs[id].type[l++] = chr.a[i++]);
            cpp_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; cpp_devs[id].pfmt[l++] = chr.a[i++]);
            cpp_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( cpp_devs[id].name ,
                            DEVFMT ,
                            cpp_devs[id].type ,
                            getpid( ),
                            cpp_devs[id].seqno );
            for (n = 0; n < NCOLORS; n++) {	/* initiate the colours */
               cpp_devs[id].red[n] = red[n%16];	/* set initial reds */
               cpp_devs[id].green[n] = green[n%16];/* set initial greens */
               cpp_devs[id].blue[n] = blue[n%16];/* set initial blues */
            }
            cpp_devs[id].height = HEIGHT;	/* default height */
            cpp_devs[id].width  = WIDTH;	/* default width */
            cpp_devs[id].offh   = OFFH;		/* default height offset*/
            cpp_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, cpp_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpp_devs[(*idev)].height-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, cpp_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (cpp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (cpp_devs[(*idev)].height-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( cpp_devs[(*idev)].pcmd ,
                         cpp_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) cpp_devs[(*idev)].offh );
            ow = nint( SCALE * (float) cpp_devs[(*idev)].offw );
            h = nint( SCALE * (float) (cpp_devs[(*idev)].height + cpp_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (cpp_devs[(*idev)].width  + cpp_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, cpp_devs[(*idev)].name );
            cpp_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            cpp_devs[(*idev)].lasti = -1;	/* reset last x */
            cpp_devs[(*idev)].lastj = -1;	/* reset last y */
            cpp_devs[(*idev)].npts  =  0;	/* reset number of points */
            cpp_devs[(*idev)].npage =  0;	/* reset number of pages */
            cpp_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 1\n" );
            fprintf( unit, "%%%%Orientation: Portrait\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = cpp_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", cpp_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( cpp_devs[(*idev)].pcmd );
         cpp_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( cpp_devs[(*idev)].name ,
                         DEVFMT ,
                         cpp_devs[(*idev)].type ,
                         getpid( ),
                         cpp_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = cpp_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++cpp_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate\n", cpp_devs[(*idev)].offw, cpp_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = cpp_devs[(*idev)].lasti;/* last x */
         int	lastj = cpp_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         cpp_devs[(*idev)].lasti = i1;		/* save end x */
         cpp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         cpp_devs[(*idev)].lasti = i1;		/* save end x */
         cpp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (cpp_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( cpp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpp_devs[(*idev)].lobuf ,
                     cpp_devs[(*idev)].obuf );
            cpp_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( cpp_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %f %f %f setrgbcolor",
            cpp_devs[(*idev)].red[ci],
            cpp_devs[(*idev)].green[ci],
            cpp_devs[(*idev)].blue[ci] );
         cpp_devs[(*idev)].lasti = -1;		/* reset end x */
         cpp_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (cpp_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( cpp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     cpp_devs[(*idev)].lobuf ,
                     cpp_devs[(*idev)].obuf );
            cpp_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = cpp_devs[(*idev)].npts;	/* number of points */
         int	start = cpp_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = cpp_devs[(*idev)].lasti;
            lastj = cpp_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            cpp_devs[(*idev)].lasti = lasti;
            cpp_devs[(*idev)].lastj = lastj;
         }
         cpp_devs[(*idev)].npts  = npts;
         cpp_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         int	i1 = nint( rbuf[0] );

         cpp_devs[(*idev)].red[i1]   = rbuf[1];	/* red */
         cpp_devs[(*idev)].green[i1] = rbuf[2];	/* green */
         cpp_devs[(*idev)].blue[i1]  = rbuf[3];	/* blue */
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         cpp_devs[(*idev)].lasti = -1;
         cpp_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( cpp_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         cpp_devs[(*idev)].lasti = -1;
         cpp_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         int i;
         int n=rbuf[0];
            
         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];
       
            fprintf( cpp_devs[(*idev)].unit, "gsave newpath\n");
            fprintf( cpp_devs[(*idev)].unit,
                     "%f %f moveto %f 0 rlineto 0 %f rlineto\n",
                    xorg, yorg, xlen, ylen);
            fprintf( cpp_devs[(*idev)].unit,
                     "%f 0 rlineto closepath clip\n", -xlen);
            fprintf( cpp_devs[(*idev)].unit, "/picstr %d string def\n", nxp);
            fprintf( cpp_devs[(*idev)].unit, "%d %d 8 [",  nxp, nyp);
            for (i=7; i<13; i++) {
               fprintf( cpp_devs[(*idev)].unit, " %.4E ", rbuf[i]);
            }  
            fprintf( cpp_devs[(*idev)].unit, "]\n");
            fprintf( cpp_devs[(*idev)].unit,
               "{currentfile picstr readhexstring pop} false 3 colorimage\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            fprintf( cpp_devs[(*idev)].unit, "grestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            for (i=0; i<n; i++) {
               int ci = rbuf[i+1];
               fprintf( cpp_devs[(*idev)].unit, "%2.2X%2.2X%2.2X",
               nint(255.0*cpp_devs[(*idev)].red[ci]),
               nint(255.0*cpp_devs[(*idev)].green[ci]),
               nint(255.0*cpp_devs[(*idev)].blue[ci]) );
            }
            fprintf( cpp_devs[(*idev)].unit, "\n");
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = cpp_devs[(*idev)].red[ci];
         rbuf[2] = cpp_devs[(*idev)].green[ci];
         rbuf[3] = cpp_devs[(*idev)].blue[ci];
         break;                                 /* done */
      }

      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#endif
#<

#>            gdidrv.dc3

Function:     GDIDRV

Purpose:      The GIDS graphics driver for the GIPSY plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL GDIDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Apr 29, 1992: KGB Document created.


#<

#>            gdidrv.c
/* gdidrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1992
	All Rights Reserved.

Fortran to C interface:

@ subroutine gdidrv( integer, integer, real, integer, character, integer )

*/

/*
 * include files and definitions:
 */

#include	"ctype.h"			/* <ctype.h> */
#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */

#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"gdi_open.h"
#include	"gdi_close.h"
#include	"gdi_pgplot.h"

#define	DEVICE	"GIDS"				/* PGPLOT device name */
#define	DEVNAM	"DEFAULT_DISPLAY"		/* default device name */
#define	TXTLEN	80				/* length of text buffers */

typedef struct {
   char	name[TXTLEN+1];				/* name of device */
   char	type[TXTLEN+1];				/* name of device */
   fint	unit;					/* device handle */
   int	poly;					/* poly count */
} gdi_struct;

static	int		gdi_ndev = 0;		/* number of gdi devices */
static	gdi_struct	*gdi_devs = NULL;	/* gdi device info */


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[TXTLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   gdi_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The GIDS driver.
 */

void	gdidrv_c( fint	*idev ,			/* gdi device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= gdi_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown GDI device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and return GDI device id.
       * (KGB implementation.)
       */
      case 0: {
         int	i = 0;				/* counter */
         int	id = 0;				/* gdi device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < gdi_ndev && strncmp( chr.a, gdi_devs[id].type, l1 ) ) id++;
         if ( id == gdi_ndev ) {		/* new entry */
            gdi_devs = realloc( gdi_devs, ++gdi_ndev * sizeof( gdi_struct ) );
            if (gdi_devs == NULL) (*nbuf) = -1;	/* error */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; gdi_devs[id].type[l++] = chr.a[i++]);
            gdi_devs[id].type[l1] = 0;		/* add ending zero byte */
            if (l2) {				/* device specified */
               for (l = 0; l < l2; gdi_devs[id].name[l++] = chr.a[i++]);
               gdi_devs[id].name[l2] = 0;
            } else {
               strcpy( gdi_devs[id].name, DEVNAM );/* default device name */
            }
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, gdi_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         fint	unit = gdi_devs[(*idev)].unit;

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         fint	unit = gdi_devs[(*idev)].unit;

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       */
      case 4: {
         fint	unit = gdi_devs[(*idev)].unit;

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*nbuf) = 0;
         (*lchr) = fcopy( chr, gdi_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         fint	unit = gdi_devs[(*idev)].unit;

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         fint	unit = gdi_devs[(*idev)].unit;

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         fchar	name;
         fint	unit;

         (*nbuf) = 3;
         name.a = chr.a; name.l = (*lchr);
         unit = gdi_open_c( name );
         (*lchr) = 0;
         if (unit < 0) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
            (*nbuf) = 2;
         } else {				/* file open */
            gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
            rbuf[0] = (*idev);
            gdi_devs[(*idev)].unit = unit;	/* file descriptor */
            gdi_devs[(*idev)].poly = 0;
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         gdi_close_c( &unit );			/* close it */
         gdi_devs[(*idev)].unit = -1;		/* reset */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 4;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 2;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 1;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 1;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 0;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       */
      case 17: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 2;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       */
      case 19: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 1;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         if (gdi_devs[(*idev)].poly) {
            (*nbuf) = 2;
         } else {
            gdi_devs[(*idev)].poly = nint( rbuf[0] ) + 1;
            (*nbuf) = 1;
         }
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         gdi_devs[(*idev)].poly--;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 4;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 1;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       * (Not implemented: ignored.)
       */
      case 23: {
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       */
      case 24: {
         fint	unit = gdi_devs[(*idev)].unit;	/* close a file */

         (*nbuf) = 4;
         (*lchr) = 0;
         gdi_pgplot_c( &unit, ifunc, rbuf, nbuf, chr, lchr );
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented: ignored.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Line of pixels.
       * (Not implemented: ignored.)
       */
      case 26: {
         break;					/* done */
      }
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#<

#>            nuldrv.dc3

Function:     NULDRV

Purpose:      The NULL drive for the GIPSY plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL NULDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Jan 31, 1991: KGB Document created.

#<

#>            nuldrv.c
/* nuldrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1991
	All Rights Reserved.

Fortran to C interface:

@ subroutine nuldrv( integer, integer, real, integer, character, integer )

*/

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */

#define	DEVICE	"NULL"				/* PGPLOT device name */
#define	HEIGHT	7799				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	RESOL	1000				/* device resolution */
#define	TYPE	0				/* means NULL driver */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	10499				/* width of paper */

typedef struct {
   char	name[TXTLEN+1];				/* name of device file */
   char	type[TXTLEN+1];				/* name of device */
} nul_struct;

static	int		nul_ndev = 0;		/* number of psl devices */
static	nul_struct	*nul_devs = NULL;	/* psl device info */

/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   nul_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The NULL driver.
 */

void	nuldrv_c( fint	*idev ,			/* psl device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= nul_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown NULL device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * PSL device id.
       * (KGB implementation.)
       */
      case 0: {
         int	i = 0;				/* counter */
         int	id = 0;				/* psl device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < nul_ndev && strncmp( chr.a, nul_devs[id].type, l1 ) ) id++;
         if ( id == nul_ndev ) {		/* new entry */
            nul_devs = realloc( nul_devs, ++nul_ndev * sizeof( nul_struct ) );
            if (nul_devs == NULL) (*nbuf) = -1;	/* error */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; nul_devs[id].type[l++] = chr.a[i++]);
            nul_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; nul_devs[id].name[l++] = chr.a[i++]);
            nul_devs[id].name[l2] = 0;		/* add ending zero byte */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, nul_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* upper right x */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* upper right y */
         rbuf[4] = 0.0;				/* must be zero */
         rbuf[5] = 255.0;			/* number of colors */
         (*nbuf) = 6;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 1;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNDATRNNNN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, nul_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* x of upper right */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* y of upper right */
         (*nbuf) = 4;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 1.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         rbuf[0] = (*idev);
         rbuf[1] = 1;
         (*nbuf) = 2;
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       * (Not implemented.)
       */
      case 21: {
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Line of pixels.
       * (Not implemented.)
       */
      case 26: {
         break;					/* done */
      }
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#<

#>            psldrv.dc3
Function:     PSLDRV

Purpose:      The PostScriptLandscape graphics driver for the GIPSY
              plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL PSLDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Jan 18, 1991: KGB Document created.
              Oct 27, 1998: JPT Invent unique filenames for plot.
              Nov 12, 1998: JPT Implemented opcodes 26 and 29.
              Apr 27, 2000: JPT PostScript level 2; implemented image
                                interpolation and ASCII85 encoding.
              May 18, 2000: JPT Interpolation algorithm in PostScript. 
              Jun 21, 2002: JPT Improved PostScript interpolation.

#<

#>            psldrv.c
/* psldrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1991, 1998
	All Rights Reserved.

Fortran to C interface:

@ subroutine psldrv( integer, integer, real, integer, character, integer )

*/
#if !defined(PSLL1)

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */
#include        "pgqbci.h"
#include        "image.H"                       /* image definitions */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.PSL"			/* device format string */
#define	DEVICE	"PS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	2				/* PS in landscape mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	gray[NCOLORS];			/* the grays */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} psl_struct;

static	double		gray[] = {		/* initial grays */
   1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,
   0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67
};

static	int		psl_ndev = 0;		/* number of psl devices */
static	psl_struct	*psl_devs = NULL;	/* psl device info */


static int outbytes;
static void outbyte (unsigned char c, FILE *out)
{
  (void)fputc(c, out);

  if (++outbytes > 63 /*||  (outbytes == 1 && c == '%')*/ ) {  
     fputc('\n', out);                 /* insert line feed */
     outbytes = 0;
  }
}

/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 *  Send ASCII85 encoded image data.
 */
static void ASCII85send(float *pixels, int num, double *gray, FILE *unit)
{
   static int count;
   static unsigned int buf[4];
   static unsigned long power85[5] = {1L,85L,85L*85,85L*85*85,85L*85*85*85};
   register int i, ci;
   unsigned long word, v;
   
   if (num) {
      while (num--) {
         ci = *(pixels++);
         buf[count++] = nint(255.0*gray[ci]);
         if (count==4) {
            count = 0;
            word = (unsigned long)(
                      (((buf[0] << 8) | buf[1]) << 16) |
                        (buf[2] << 8) | buf[3]);
            if (word==0) {
               outbyte('z', unit);
            } else {  
               for (i = 4; i >= 0; i--) {
                  v = word / power85[i];
                  outbyte((unsigned char)(v + '!'), unit);   
                  word -= v * power85[i];
               }
            }
         }
      }
   } else {
      if (count != 0) {   /* 1-3 bytes left */
         word = 0;
         for (i = count-1; i >= 0; i--)   /* accumulate bytes */
            word += (unsigned long)buf[i] << 8 * (3-i);
         for (i = 4; i >= 4-count; i--) {
            v = word / power85[i];
            outbyte((unsigned char)(v + '!'), unit);
            word -= v * power85[i];
         }
      }
      fputc('~', unit);
      fputc('>', unit);
      count = 0;
      outbytes = 0;   
   }
}

/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = psl_devs[id].unit;		/* file descriptor */
   char	*obuf = psl_devs[id].obuf;		/* destination */
   int	lobuf = psl_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   psl_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   psl_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * The PostScriptLandscape driver.
 */

void	psldrv_c( fint	*idev ,			/* psl device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= psl_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown PSL device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         psl_devs[(*idev)].offh = nint( rbuf[0] );
         psl_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         psl_devs[(*idev)].height = nint( rbuf[0] );
         psl_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * psl device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* psl device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < psl_ndev && strncmp( chr.a, psl_devs[id].type, l1 ) ) id++;
         if ( id == psl_ndev ) {		/* new entry */
            psl_devs = realloc( psl_devs, ++psl_ndev * sizeof( psl_struct ) );
            if (psl_devs == NULL) (*nbuf) = -1;	/* error */
            else psl_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; psl_devs[id].type[l++] = chr.a[i++]);
            psl_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; psl_devs[id].pfmt[l++] = chr.a[i++]);
            psl_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( psl_devs[id].name ,
                            DEVFMT ,
                            psl_devs[id].type ,
                            getpid( ),
                            psl_devs[id].seqno );
            for (n = 0; n < NCOLORS; n++) {	/* initiate the colours */
               psl_devs[id].gray[n] = gray[n%16];/* set initial grays */
            }
            psl_devs[id].height = HEIGHT;	/* default height */
            psl_devs[id].width  = WIDTH;	/* default width */
            psl_devs[id].offh   = OFFH;		/* default height offset*/
            psl_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, psl_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psl_devs[(*idev)].width-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, psl_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psl_devs[(*idev)].width-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( psl_devs[(*idev)].pcmd ,
                         psl_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) psl_devs[(*idev)].offh );
            ow = nint( SCALE * (float) psl_devs[(*idev)].offw );
            h = nint( SCALE * (float) (psl_devs[(*idev)].height + psl_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (psl_devs[(*idev)].width  + psl_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, psl_devs[(*idev)].name );
            psl_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            psl_devs[(*idev)].lasti = -1;	/* reset last x */
            psl_devs[(*idev)].lastj = -1;	/* reset last y */
            psl_devs[(*idev)].npts  =  0;	/* reset number of points */
            psl_devs[(*idev)].npage =  0;	/* reset number of pages */
            psl_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 2\n" );
            fprintf( unit, "%%%%Orientation: Landscape\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/grimip false def /Blank 0 def\n");
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "/DeviceGray setcolorspace\n" );
            fprintf( unit, INTERPOL);
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = psl_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", psl_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( psl_devs[(*idev)].pcmd );
         psl_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( psl_devs[(*idev)].name ,
                         DEVFMT ,
                         psl_devs[(*idev)].type ,
                         getpid( ),
                         psl_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = psl_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++psl_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate 90 rotate\n", psl_devs[(*idev)].width + psl_devs[(*idev)].offw, psl_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = psl_devs[(*idev)].lasti;/* last x */
         int	lastj = psl_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         psl_devs[(*idev)].lasti = i1;		/* save end x */
         psl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         psl_devs[(*idev)].lasti = i1;		/* save end x */
         psl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (psl_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( psl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psl_devs[(*idev)].lobuf ,
                     psl_devs[(*idev)].obuf );
            psl_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( psl_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %f setgray", psl_devs[(*idev)].gray[ci]);
         psl_devs[(*idev)].lasti = -1;		/* reset end x */
         psl_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (psl_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( psl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psl_devs[(*idev)].lobuf ,
                     psl_devs[(*idev)].obuf );
            psl_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = psl_devs[(*idev)].npts;	/* number of points */
         int	start = psl_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = psl_devs[(*idev)].lasti;
            lastj = psl_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            psl_devs[(*idev)].lasti = lasti;
            psl_devs[(*idev)].lastj = lastj;
         }
         psl_devs[(*idev)].npts  = npts;
         psl_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         int	i1 = nint( rbuf[0] );

         psl_devs[(*idev)].gray[i1] =
                                0.30*rbuf[1] + 0.59*rbuf[2] + 0.11*rbuf[3];
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         psl_devs[(*idev)].lasti = -1;
         psl_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( psl_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         psl_devs[(*idev)].lasti = -1;
         psl_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         int i;
         int n=rbuf[0];
            
         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];
       
            fprintf( psl_devs[(*idev)].unit, "save\n");
            /*  redefine Blank for DeviceGray */
            {
               fint bci;
               pgqbci_c(&bci);
               fprintf( psl_devs[(*idev)].unit, "/Blank %d def\n",
                       nint(255.0*psl_devs[(*idev)].gray[bci]));
            }
            fprintf( psl_devs[(*idev)].unit, IMGPAR,
                     nxp, nyp,
                     rbuf[7], rbuf[8], rbuf[9], rbuf[10], rbuf[11], rbuf[12],
                     xorg, yorg, xlen, ylen, -xlen );

            fprintf( psl_devs[(*idev)].unit, "<<\n");
            fprintf( psl_devs[(*idev)].unit, "  /ImageType 1\n");
            fprintf( psl_devs[(*idev)].unit, "  /BitsPerComponent 8\n");
            fprintf( psl_devs[(*idev)].unit, "  /Decode [0 1]\n");
            fprintf( psl_devs[(*idev)].unit, "  /Width  Nx\n");
            fprintf( psl_devs[(*idev)].unit, "  /Height Ny\n");
            fprintf( psl_devs[(*idev)].unit, "  /ImageMatrix Imgmat\n");
            fprintf( psl_devs[(*idev)].unit, "  /DataSource { pixels }\n");
            fprintf( psl_devs[(*idev)].unit, ">> image\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            ASCII85send(NULL, 0, NULL, psl_devs[(*idev)].unit);
            fprintf( psl_devs[(*idev)].unit, "\nrestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            ASCII85send(rbuf+1, n, psl_devs[(*idev)].gray,
                                   psl_devs[(*idev)].unit);
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = psl_devs[(*idev)].gray[ci];
         rbuf[2] = psl_devs[(*idev)].gray[ci];
         rbuf[3] = psl_devs[(*idev)].gray[ci];
         break;                                 /* done */
      }

      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#else

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.PSL"			/* device format string */
#define	DEVICE	"PS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	2				/* PS in landscape mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	gray[NCOLORS];			/* the grays */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} psl_struct;

static	double		gray[] = {		/* initial grays */
   1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,
   0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67
};

static	int		psl_ndev = 0;		/* number of psl devices */
static	psl_struct	*psl_devs = NULL;	/* psl device info */


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = psl_devs[id].unit;		/* file descriptor */
   char	*obuf = psl_devs[id].obuf;		/* destination */
   int	lobuf = psl_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   psl_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   psl_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The PostScriptLandscape driver.
 */

void	psldrv_c( fint	*idev ,			/* psl device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= psl_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown PSL device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         psl_devs[(*idev)].offh = nint( rbuf[0] );
         psl_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         psl_devs[(*idev)].height = nint( rbuf[0] );
         psl_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * psl device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* psl device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < psl_ndev && strncmp( chr.a, psl_devs[id].type, l1 ) ) id++;
         if ( id == psl_ndev ) {		/* new entry */
            psl_devs = realloc( psl_devs, ++psl_ndev * sizeof( psl_struct ) );
            if (psl_devs == NULL) (*nbuf) = -1;	/* error */
            else psl_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; psl_devs[id].type[l++] = chr.a[i++]);
            psl_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; psl_devs[id].pfmt[l++] = chr.a[i++]);
            psl_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( psl_devs[id].name ,
                            DEVFMT ,
                            psl_devs[id].type ,
                            getpid( ),
                            psl_devs[id].seqno );
            for (n = 0; n < NCOLORS; n++) {	/* initiate the colours */
               psl_devs[id].gray[n] = gray[n%16];/* set initial grays */
            }
            psl_devs[id].height = HEIGHT;	/* default height */
            psl_devs[id].width  = WIDTH;	/* default width */
            psl_devs[id].offh   = OFFH;		/* default height offset*/
            psl_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, psl_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psl_devs[(*idev)].width-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, psl_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psl_devs[(*idev)].height-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psl_devs[(*idev)].width-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( psl_devs[(*idev)].pcmd ,
                         psl_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) psl_devs[(*idev)].offh );
            ow = nint( SCALE * (float) psl_devs[(*idev)].offw );
            h = nint( SCALE * (float) (psl_devs[(*idev)].height + psl_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (psl_devs[(*idev)].width  + psl_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, psl_devs[(*idev)].name );
            psl_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            psl_devs[(*idev)].lasti = -1;	/* reset last x */
            psl_devs[(*idev)].lastj = -1;	/* reset last y */
            psl_devs[(*idev)].npts  =  0;	/* reset number of points */
            psl_devs[(*idev)].npage =  0;	/* reset number of pages */
            psl_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 1\n" );
            fprintf( unit, "%%%%Orientation: Portrait\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = psl_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", psl_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( psl_devs[(*idev)].pcmd );
         psl_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( psl_devs[(*idev)].name ,
                         DEVFMT ,
                         psl_devs[(*idev)].type ,
                         getpid( ),
                         psl_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = psl_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++psl_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate 90 rotate\n", psl_devs[(*idev)].width + psl_devs[(*idev)].offw, psl_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = psl_devs[(*idev)].lasti;/* last x */
         int	lastj = psl_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         psl_devs[(*idev)].lasti = i1;		/* save end x */
         psl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         psl_devs[(*idev)].lasti = i1;		/* save end x */
         psl_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (psl_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( psl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psl_devs[(*idev)].lobuf ,
                     psl_devs[(*idev)].obuf );
            psl_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( psl_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %f setgray", psl_devs[(*idev)].gray[ci]);
         psl_devs[(*idev)].lasti = -1;		/* reset end x */
         psl_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (psl_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( psl_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psl_devs[(*idev)].lobuf ,
                     psl_devs[(*idev)].obuf );
            psl_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = psl_devs[(*idev)].npts;	/* number of points */
         int	start = psl_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = psl_devs[(*idev)].lasti;
            lastj = psl_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            psl_devs[(*idev)].lasti = lasti;
            psl_devs[(*idev)].lastj = lastj;
         }
         psl_devs[(*idev)].npts  = npts;
         psl_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         int	i1 = nint( rbuf[0] );

         psl_devs[(*idev)].gray[i1] =
                                0.30*rbuf[1] + 0.59*rbuf[2] + 0.11*rbuf[3];
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         psl_devs[(*idev)].lasti = -1;
         psl_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( psl_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         psl_devs[(*idev)].lasti = -1;
         psl_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         int i;
         int n=rbuf[0];
            
         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];
       
            fprintf( psl_devs[(*idev)].unit, "gsave newpath\n");
            fprintf( psl_devs[(*idev)].unit,
                     "%f %f moveto %f 0 rlineto 0 %f rlineto\n",
                    xorg, yorg, xlen, ylen);
            fprintf( psl_devs[(*idev)].unit,
                     "%f 0 rlineto closepath clip\n", -xlen);
            fprintf( psl_devs[(*idev)].unit, "/picstr %d string def\n", nxp);
            fprintf( psl_devs[(*idev)].unit, "%d %d 8 [",  nxp, nyp);
            for (i=7; i<13; i++) {
               fprintf( psl_devs[(*idev)].unit, " %.4E ", rbuf[i]);
            }  
            fprintf( psl_devs[(*idev)].unit, "]\n");
            fprintf( psl_devs[(*idev)].unit,
               "{currentfile picstr readhexstring pop} image\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            fprintf( psl_devs[(*idev)].unit, "grestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            for (i=0; i<n; i++) {
               int ci = rbuf[i+1];
               fprintf( psl_devs[(*idev)].unit, "%2.2X",
               nint(255.0*psl_devs[(*idev)].gray[ci]) );
            }
            fprintf( psl_devs[(*idev)].unit, "\n");
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = psl_devs[(*idev)].gray[ci];
         rbuf[2] = psl_devs[(*idev)].gray[ci];
         rbuf[3] = psl_devs[(*idev)].gray[ci];
         break;                                 /* done */
      }

      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#endif
#<

#>            pspdrv.dc3
Function:     PSPDRV

Purpose:      The PostScriptPortrait graphics driver for the GIPSY
              plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL PSPDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Feb  1, 1991: KGB Document created.
              Oct 27, 1998: JPT Invent unique filenames for plot.
              Nov 12, 1998: JPT Implemented opcodes 26 and 29.
              Apr 27, 2000: JPT PostScript level 2; implemented image
                                interpolation and ASCII85 encoding.
              May 18, 2000: JPT Interpolation algorithm in PostScript. 
              Jun 21, 2002: JPT Improved PostScript interpolation. 
#<

#>            pspdrv.c
/* pspdrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1991, 1998, 2000
	All Rights Reserved.

Fortran to C interface:

@ subroutine pspdrv( integer, integer, real, integer, character, integer )

*/
#if !defined(PSLL1)

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */
#include        "pgqbci.h"
#include        "image.H"                       /* image definitions */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.PSP"			/* device format string */
#define	DEVICE	"VPS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	3				/* PS in portrait mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	gray[NCOLORS];			/* the grays */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} psp_struct;

static	double		gray[] = {		/* initial grays */
   1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,
   0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67
};

static	int		psp_ndev = 0;		/* number of psp devices */
static	psp_struct	*psp_devs = NULL;	/* psp device info */


static int outbytes;
static void outbyte (unsigned char c, FILE *out)
{
  (void)fputc(c, out);

  if (++outbytes > 63 /*||  (outbytes == 1 && c == '%')*/ ) { 
     fputc('\n', out);                 /* insert line feed */
     outbytes = 0;
  }
}

/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}

/*
 *  Send ASCII85 encoded image data.
 */
static void ASCII85send(float *pixels, int num, double *gray, FILE *unit)
{
   static int count;
   static unsigned int buf[4];
   static unsigned long power85[5] = {1L,85L,85L*85,85L*85*85,85L*85*85*85};
   register int i, ci;
   unsigned long word, v;

   if (num) {
      while (num--) {
         ci = *(pixels++);
         buf[count++] = nint(255.0*gray[ci]);
         if (count==4) {
            count = 0;
            word = (unsigned long)(
                      (((buf[0] << 8) | buf[1]) << 16) |
                        (buf[2] << 8) | buf[3]);
            if (word==0) {
               outbyte('z', unit);
            } else {
               for (i = 4; i >= 0; i--) {
                  v = word / power85[i];
                  outbyte((unsigned char)(v + '!'), unit);
                  word -= v * power85[i];
               }
            }
         }
      }
   } else {
      if (count != 0) {   /* 1-3 bytes left */
         word = 0;
         for (i = count-1; i >= 0; i--)   /* accumulate bytes */
            word += (unsigned long)buf[i] << 8 * (3-i);
         for (i = 4; i >= 4-count; i--) {
            v = word / power85[i];
            outbyte((unsigned char)(v + '!'), unit);
            word -= v * power85[i];
         }   
      }
      fputc('~', unit);   
      fputc('>', unit);
      count = 0;
      outbytes = 0;   
   }
}

/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = psp_devs[id].unit;		/* file descriptor */
   char	*obuf = psp_devs[id].obuf;		/* destination */
   int	lobuf = psp_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   psp_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   psp_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * The PostScriptPortrait driver.
 */

void	pspdrv_c( fint	*idev ,			/* psp device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= psp_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown psp device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         psp_devs[(*idev)].offh = nint( rbuf[0] );
         psp_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         psp_devs[(*idev)].height = nint( rbuf[0] );
         psp_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * psp device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* psp device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < psp_ndev && strncmp( chr.a, psp_devs[id].type, l1 ) ) id++;
         if ( id == psp_ndev ) {		/* new entry */
            psp_devs = realloc( psp_devs, ++psp_ndev * sizeof( psp_struct ) );
            if (psp_devs == NULL) (*nbuf) = -1;	/* error */
            else psp_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; psp_devs[id].type[l++] = chr.a[i++]);
            psp_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; psp_devs[id].pfmt[l++] = chr.a[i++]);
            psp_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( psp_devs[id].name ,
                            DEVFMT ,
                            psp_devs[id].type ,
                            getpid( ),
                            psp_devs[id].seqno );
            for (n = 0; n < NCOLORS; n++) {	/* initiate the colours */
               psp_devs[id].gray[n] = gray[n%16];/* set initial grays */
            }
            psp_devs[id].height = HEIGHT;	/* default height */
            psp_devs[id].width  = WIDTH;	/* default width */
            psp_devs[id].offh   = OFFH;		/* default height offset*/
            psp_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, psp_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psp_devs[(*idev)].height-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, psp_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psp_devs[(*idev)].height-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( psp_devs[(*idev)].pcmd ,
                         psp_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) psp_devs[(*idev)].offh );
            ow = nint( SCALE * (float) psp_devs[(*idev)].offw );
            h = nint( SCALE * (float) (psp_devs[(*idev)].height + psp_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (psp_devs[(*idev)].width  + psp_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, psp_devs[(*idev)].name );
            psp_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            psp_devs[(*idev)].lasti = -1;	/* reset last x */
            psp_devs[(*idev)].lastj = -1;	/* reset last y */
            psp_devs[(*idev)].npts  =  0;	/* reset number of points */
            psp_devs[(*idev)].npage =  0;	/* reset number of pages */
            psp_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 1\n" );
            fprintf( unit, "%%%%Orientation: Portrait\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/grimip false def /Blank 0 def\n");
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "/DeviceGray setcolorspace\n" );
            fprintf( unit, INTERPOL);
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = psp_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", psp_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( psp_devs[(*idev)].pcmd );
         psp_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( psp_devs[(*idev)].name ,
                         DEVFMT ,
                         psp_devs[(*idev)].type ,
                         getpid( ),
                         psp_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = psp_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++psp_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate\n", psp_devs[(*idev)].offw, psp_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = psp_devs[(*idev)].lasti;/* last x */
         int	lastj = psp_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         psp_devs[(*idev)].lasti = i1;		/* save end x */
         psp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         psp_devs[(*idev)].lasti = i1;		/* save end x */
         psp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (psp_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( psp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psp_devs[(*idev)].lobuf ,
                     psp_devs[(*idev)].obuf );
            psp_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( psp_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %f setgray", psp_devs[(*idev)].gray[ci]);
         psp_devs[(*idev)].lasti = -1;		/* reset end x */
         psp_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (psp_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( psp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psp_devs[(*idev)].lobuf ,
                     psp_devs[(*idev)].obuf );
            psp_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = psp_devs[(*idev)].npts;	/* number of points */
         int	start = psp_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = psp_devs[(*idev)].lasti;
            lastj = psp_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            psp_devs[(*idev)].lasti = lasti;
            psp_devs[(*idev)].lastj = lastj;
         }
         psp_devs[(*idev)].npts  = npts;
         psp_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         int	i1 = nint( rbuf[0] );

         psp_devs[(*idev)].gray[i1] =
                                0.30*rbuf[1] + 0.59*rbuf[2] + 0.11*rbuf[3];
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         psp_devs[(*idev)].lasti = -1;
         psp_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( psp_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         psp_devs[(*idev)].lasti = -1;
         psp_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         int i;
         int n=rbuf[0];
            
         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];
       
            fprintf( psp_devs[(*idev)].unit, "save\n");
            /*  redefine Blank for DeviceGray */
            {
               fint bci;
               pgqbci_c(&bci);
               fprintf( psp_devs[(*idev)].unit, "/Blank %d def\n",
                       nint(255.0*psp_devs[(*idev)].gray[bci]));
            }
            fprintf( psp_devs[(*idev)].unit, IMGPAR,
                     nxp, nyp,
                     rbuf[7], rbuf[8], rbuf[9], rbuf[10], rbuf[11], rbuf[12],
                     xorg, yorg, xlen, ylen, -xlen );  

            fprintf( psp_devs[(*idev)].unit, "<<\n");
            fprintf( psp_devs[(*idev)].unit, "  /ImageType 1\n");
            fprintf( psp_devs[(*idev)].unit, "  /BitsPerComponent 8\n");
            fprintf( psp_devs[(*idev)].unit, "  /Decode [0 1]\n");
            fprintf( psp_devs[(*idev)].unit, "  /Width  Nx\n");
            fprintf( psp_devs[(*idev)].unit, "  /Height Ny\n");
            fprintf( psp_devs[(*idev)].unit, "  /ImageMatrix Imgmat\n");
            fprintf( psp_devs[(*idev)].unit, "  /DataSource { pixels }\n");
            fprintf( psp_devs[(*idev)].unit, ">> image\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            ASCII85send(NULL, 0, NULL, psp_devs[(*idev)].unit);
            fprintf( psp_devs[(*idev)].unit, "\nrestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            ASCII85send(rbuf+1, n, psp_devs[(*idev)].gray, 
                                   psp_devs[(*idev)].unit);
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = psp_devs[(*idev)].gray[ci];
         rbuf[2] = psp_devs[(*idev)].gray[ci];
         rbuf[3] = psp_devs[(*idev)].gray[ci];
         break;                                 /* done */
      }

      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#else

/*
 * include files and definitions:
 */

#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"time.h"			/* <time.h> */
#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"getlognam.h"			/* define getlognam_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */

#define NCOLORS 256
#define	BUFLEN	132				/* size of output buffer */
#define	DEVFMT	"%s%d_%d.PSP"			/* device format string */
#define	DEVICE	"VPS"				/* PGPLOT device name */
#define	HEIGHT	10500				/* height of paper */
#define	MESLEN	80				/* length of messages */
#define	OFFH	576				/* offset in height */
#define	OFFW	233				/* offset in width */
#define	RESOL	1000				/* device resolution */
#define	SCALE	0.072				/* scaling */
#define	TYPE	3				/* PS in portrait mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	7800				/* width of paper */

typedef struct {
   FILE		*unit;				/* file descriptor */
   char		name[TXTLEN+1];			/* name of device file */
   char		obuf[BUFLEN+1];			/* buffers output */
   char		pfmt[TXTLEN+1];			/* printer cmd format string */
   char		pcmd[TXTLEN+1];			/* printer command */
   char		type[TXTLEN+1];			/* name of device */
   double	gray[NCOLORS];			/* the grays */
   int		lasti;				/* last x pen position */
   int		lastj;				/* last y pen position */
   int		lobuf;				/* contents of output buffer */
   int		npage;				/* current page number */
   int		npts;				/* points in polygon */
   int		start;				/* polygon already started */
   int		height;				/* height of paper */
   int		width;				/* width of paper */
   int		offh;				/* offset in height */
   int		offw;				/* offset in width */
   int  seqno;                                  /* plot sequence number */
} psp_struct;

static	double		gray[] = {		/* initial grays */
   1.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00,
   0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67
};

static	int		psp_ndev = 0;		/* number of psp devices */
static	psp_struct	*psp_devs = NULL;	/* psp device info */


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   FILE	*unit = psp_devs[id].unit;		/* file descriptor */
   char	*obuf = psp_devs[id].obuf;		/* destination */
   int	lobuf = psp_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l + 1) > BUFLEN) {		/* empty buffer */
      (void) fprintf( unit, "%.*s\n", lobuf, obuf );
      lobuf = l;				/* fill buffer */
      strncpy( obuf, instr, l );		/* okay */
   } else {					/* put in buffer */
      if (lobuf) obuf[lobuf++] = ' ';		/* add space */
      strncpy( &obuf[lobuf], instr, l );	/* concatenate */
      lobuf += l;				/* new buffer size */
   }
   psp_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   psp_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The PostScriptPortrait driver.
 */

void	pspdrv_c( fint	*idev ,			/* psp device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= psp_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown psp device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -3
       * Set paper offsets.
       * (KGB implementation.)
       */
      case -3: {
         psp_devs[(*idev)].offh = nint( rbuf[0] );
         psp_devs[(*idev)].offw = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -2
       * Set size of paper.
       * (KGB implementation.)
       */
      case -2: {
         psp_devs[(*idev)].height = nint( rbuf[0] );
         psp_devs[(*idev)].width  = nint( rbuf[1] );
         (*lchr) = (*nbuf) = 0;
         break;
      }
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and printer command and return
       * psp device id.
       * (KGB implementation.)
       */
      case 0: {
         int	getpid( );			/* returns program id */
         int	i = 0;				/* counter */
         int	id = 0;				/* psp device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */
         int	n;				/* colour counter */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < psp_ndev && strncmp( chr.a, psp_devs[id].type, l1 ) ) id++;
         if ( id == psp_ndev ) {		/* new entry */
            psp_devs = realloc( psp_devs, ++psp_ndev * sizeof( psp_struct ) );
            if (psp_devs == NULL) (*nbuf) = -1;	/* error */
            else psp_devs[id].seqno  = 1;       /* plot sequence number */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; psp_devs[id].type[l++] = chr.a[i++]);
            psp_devs[id].type[l1] = 0;		/* add ending zero byte */
            for (l = 0; l < l2; psp_devs[id].pfmt[l++] = chr.a[i++]);
            psp_devs[id].pfmt[l2] = 0;		/* add ending zero byte */
            (void) sprintf( psp_devs[id].name ,
                            DEVFMT ,
                            psp_devs[id].type ,
                            getpid( ),
                            psp_devs[id].seqno );
            for (n = 0; n < NCOLORS; n++) {	/* initiate the colours */
               psp_devs[id].gray[n] = gray[n%16];/* set initial grays */
            }
            psp_devs[id].height = HEIGHT;	/* default height */
            psp_devs[id].width  = WIDTH;	/* default width */
            psp_devs[id].offh   = OFFH;		/* default height offset*/
            psp_devs[id].offw   = OFFW;		/* default width offset */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, psp_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psp_devs[(*idev)].height-1);
         rbuf[4] = 0.0;
         rbuf[5] = NCOLORS-1;
         (*nbuf) = 6;
         break;
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 5;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, Area fill,
       * Thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "HNNATNQNYN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, psp_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;
         rbuf[1] = (float) (psp_devs[(*idev)].width-1);
         rbuf[2] = 0.0;
         rbuf[3] = (float) (psp_devs[(*idev)].height-1);
         (*nbuf) = 4;
         break;
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 8.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         FILE	*unit;				/* file descriptor */
         char	name[TXTLEN+1];

         strncpy( name, chr.a, (*lchr) );	/* name of device */
         name[(*lchr)] = 0;
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         (void) sprintf( psp_devs[(*idev)].pcmd ,
                         psp_devs[(*idev)].pfmt ,
                         name );
         unit = fopen( name, "w" );		/* open file */
         if (unit == NULL) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            char	task[TXTLEN+1];		/* name of application */
            char	user[TXTLEN+1];		/* login name of user */
            fchar	tnam;			/* points to task */
            fchar	unam;			/* points to user */
            time_t	tp;			/* current time */
            int		oh, ow, h, w;

            oh = nint( SCALE * (float) psp_devs[(*idev)].offh );
            ow = nint( SCALE * (float) psp_devs[(*idev)].offw );
            h = nint( SCALE * (float) (psp_devs[(*idev)].height + psp_devs[(*idev)].offh) );
            w = nint( SCALE * (float) (psp_devs[(*idev)].width  + psp_devs[(*idev)].offw) );
            tp = time( NULL );			/* current time */
            tnam.a = task; tnam.l = TXTLEN;	/* make fchar */
            myname_c( tnam );			/* get task name */
            task[nelc_c( tnam )] = 0;		/* add zero byte */
            unam.a = user; unam.l = TXTLEN;	/* make fchar */
            getlognam_c( unam );		/* get user name */
            user[nelc_c( unam )] = 0;		/* add zero byte */
            (*lchr) = fcopy( chr, psp_devs[(*idev)].name );
            psp_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            psp_devs[(*idev)].lasti = -1;	/* reset last x */
            psp_devs[(*idev)].lastj = -1;	/* reset last y */
            psp_devs[(*idev)].npts  =  0;	/* reset number of points */
            psp_devs[(*idev)].npage =  0;	/* reset number of pages */
            psp_devs[(*idev)].unit  =  unit;	/* file descriptor */
            fprintf( unit, "%%!PS-Adobe-3.0 EPSF-3.0\n" );
            fprintf( unit, "%%%%Creator: %s\n", task );
            fprintf( unit, "%%%%For: %s\n", user );
            fprintf( unit, "%%%%Title: GIPSY PostScript plot\n" );
            fprintf( unit, "%%%%CreationDate: %s", ctime( &tp ) );
            fprintf( unit, "%%%%BoundingBox: %d %d %d %d\n", ow, oh, w, h );
            fprintf( unit, "%%%%DocumentFonts: (atend)\n" );
            fprintf( unit, "%%%%LanguageLevel: 1\n" );
            fprintf( unit, "%%%%Orientation: Portrait\n" );
            fprintf( unit, "%%%%Pages: (atend)\n" );
            fprintf( unit, "%%%%EndComments\n" );
            fprintf( unit, "%%%%BeginProlog\n" );
            fprintf( unit, "/l {moveto rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/c {rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n" );
            fprintf( unit, "/SLW {5 mul setlinewidth} bind def\n" );
            fprintf( unit, "/SCF /pop load def\n" );
            fprintf( unit, "/BP {newpath moveto} bind def\n" );
            fprintf( unit, "/LP /rlineto load def\n" );
            fprintf( unit, "/EP {rlineto closepath eofill} bind def\n" );
            fprintf( unit, "/MB {gsave translate MFAC dup scale 1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def\n" );
            fprintf( unit, "/ME /grestore load def\n" );
            fprintf( unit, "/C {0 360 arc stroke} bind def\n" );
            fprintf( unit, "/FC {0 360 arc fill} bind def\n" );
            fprintf( unit, "%%%%EndProlog\n" );
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         FILE	*unit = psp_devs[(*idev)].unit;	/* file descriptor */

         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Trailer\n" );
         fprintf( unit, "%%%%DocumentFonts: \n" );
         fprintf( unit, "%%%%Pages: %d\n", psp_devs[(*idev)].npage );
         fprintf( unit, "%%%%EOF\n" );
         fclose( unit );			/* close file */
         (void) system( psp_devs[(*idev)].pcmd );
         psp_devs[(*idev)].seqno++;             /* increment plot number */
         (void) sprintf( psp_devs[(*idev)].name ,
                         DEVFMT ,
                         psp_devs[(*idev)].type ,
                         getpid( ),
                         psp_devs[(*idev)].seqno );  /* update filename */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         FILE	*unit = psp_devs[(*idev)].unit;	/* file descriptor */
         fint	npage;				/* page number */

         npage = ++psp_devs[(*idev)].npage;	/* next page */
         fprintf( unit, "\n" );
         fprintf( unit, "%%%%Page: %d %d\n", npage, npage );
         fprintf( unit, "%%%%BeginPageSetup\n" );
         fprintf( unit, "/PGPLOT save def\n" );
         fprintf( unit, "%f %f scale\n", SCALE, SCALE );
         fprintf( unit, "%d %d translate\n", psp_devs[(*idev)].offw, psp_devs[(*idev)].offh );
         fprintf( unit, "1 setlinejoin 1 setlinecap 1 SLW 1 SCF\n" );
         fprintf( unit, "%%%%EndPageSetup\n" );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         char	instr[TXTLEN];			/* character buffer */
         int	i0 = nint( rbuf[0] );		/* begin x */
         int	j0 = nint( rbuf[1] );		/* begin y */
         int	i1 = nint( rbuf[2] );		/* end x */
         int	j1 = nint( rbuf[3] );		/* end y */
         int	l;				/* number of characters */
         int	lasti = psp_devs[(*idev)].lasti;/* last x */
         int	lastj = psp_devs[(*idev)].lastj;/* last y */

         if (i0 == lasti && j0 == lastj) {	/* continue drawing */
            l = sprintf( instr, "%d %d c", i1 - i0, j1 - j0 );
         } else {				/* new segment */
            l = sprintf( instr, "%d %d %d %d l", i1 - i0, j1 - j0, i0, j0 );
         }
         psp_devs[(*idev)].lasti = i1;		/* save end x */
         psp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         char	instr[TXTLEN];			/* character buffer */
         int	i1 = nint( rbuf[0] );		/* x position */
         int	j1 = nint( rbuf[1] );		/* y position */
         int	l;				/* number of characters */

         l = sprintf( instr, "%d %d d", i1, j1 );
         psp_devs[(*idev)].lasti = i1;		/* save end x */
         psp_devs[(*idev)].lastj = j1;		/* save end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         if (psp_devs[(*idev)].lobuf) {		/* data in buffer ? */
            fprintf( psp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psp_devs[(*idev)].lobuf ,
                     psp_devs[(*idev)].obuf );
            psp_devs[(*idev)].lobuf = 0;	/* reset */
         }
         fprintf( psp_devs[(*idev)].unit, "showpage PGPLOT restore\n" );
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         char	instr[TXTLEN];			/* character buffer */
         int	ci = nint( rbuf[0] );		/* color index */
         int	l;				/* number of characters */

         l = sprintf( instr, " %f setgray", psp_devs[(*idev)].gray[ci]);
         psp_devs[(*idev)].lasti = -1;		/* reset end x */
         psp_devs[(*idev)].lastj = -1;		/* reset end y */
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         if (psp_devs[(*idev)].lobuf) {		/* data in buffer */
            fprintf( psp_devs[(*idev)].unit ,
                     "%.*s\n" ,
                     psp_devs[(*idev)].lobuf ,
                     psp_devs[(*idev)].obuf );
            psp_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Not implemented: should not be called.)
       */
      case 17: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	npts = psp_devs[(*idev)].npts;	/* number of points */
         int	start = psp_devs[(*idev)].start;

         if (npts == 0) {	 		/* start of polygon */
            npts = nint( rbuf[0] );		/* number of points */
            start = 1;				/* start */
         } else {				/* next segment */
            int	i0 = nint( rbuf[0] );		/* x position */
            int	j0 = nint( rbuf[1] );		/* y position */
            int	lasti;
            int	lastj;

            lasti = psp_devs[(*idev)].lasti;
            lastj = psp_devs[(*idev)].lastj;
            npts = npts - 1;			/* decrease segment counter */
            if (start) {			/* start */
               l = sprintf( instr, "%d %d BP", i0, j0 );
               start = 0;			/* already started */
               lasti = i0;			/* save x */
               lastj = j0;			/* save y */
            } else if (npts == 0) {		/* close polygon */
               l = sprintf( instr, "%d %d EP", i0 - lasti, j0 - lastj );
               lasti = lastj = -1;		/* reset */
            } else {				/* do full segment */
               l = sprintf( instr, "%d %d LP", i0 - lasti, j0 - lastj );
               lasti = i0;			/* save end x */
               lastj = j0;			/* save end y */
            }
            send( instr, l, (*idev) );		/* ship out */
            psp_devs[(*idev)].lasti = lasti;
            psp_devs[(*idev)].lastj = lastj;
         }
         psp_devs[(*idev)].npts  = npts;
         psp_devs[(*idev)].start = start;
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21: {
         int	i1 = nint( rbuf[0] );

         psp_devs[(*idev)].gray[i1] =
                                0.30*rbuf[1] + 0.59*rbuf[2] + 0.11*rbuf[3];
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22: {
         char	instr[TXTLEN];			/* character buffer */
         int	l;				/* number of characters */
         int	lw = nint( rbuf[0] );		/* get line width */

         l = sprintf( instr, "%d SLW", lw );	/* PS command */
         psp_devs[(*idev)].lasti = -1;
         psp_devs[(*idev)].lastj = -1;
         send( instr, l, (*idev) );		/* ship out */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       */
      case 23: {
         fprintf( psp_devs[(*idev)].unit, "%.*s\n", (int) (*lchr), chr.a );
         psp_devs[(*idev)].lasti = -1;
         psp_devs[(*idev)].lastj = -1;
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Image.
       */
      case 26: {
         int i;
         int n=rbuf[0];
            
         if (n==0) {
/*
 *   -- First: setup for image
 *   -- Set clipping region (rbuf[1...4])
 */
            int   nxp=rbuf[1],  nyp=rbuf[2];
            float xorg=rbuf[3], xlen=rbuf[4]-rbuf[3];
            float yorg=rbuf[5], ylen=rbuf[6]-rbuf[5];
       
            fprintf( psp_devs[(*idev)].unit, "gsave newpath\n");
            fprintf( psp_devs[(*idev)].unit,
                     "%f %f moveto %f 0 rlineto 0 %f rlineto\n",
                    xorg, yorg, xlen, ylen);
            fprintf( psp_devs[(*idev)].unit,
                     "%f 0 rlineto closepath clip\n", -xlen);
            fprintf( psp_devs[(*idev)].unit, "/picstr %d string def\n", nxp);
            fprintf( psp_devs[(*idev)].unit, "%d %d 8 [",  nxp, nyp);
            for (i=7; i<13; i++) {
               fprintf( psp_devs[(*idev)].unit, " %.4E ", rbuf[i]);
            }  
            fprintf( psp_devs[(*idev)].unit, "]\n");
            fprintf( psp_devs[(*idev)].unit,
               "{currentfile picstr readhexstring pop} image\n");
         } else if (n==-1) {
/*
 *   -- Last: terminate image
 */
            fprintf( psp_devs[(*idev)].unit, "grestore\n");
         } else {
/*
 *   -- Middle: write N image pixels
 */
            for (i=0; i<n; i++) {
               int ci = rbuf[i+1];
               fprintf( psp_devs[(*idev)].unit, "%2.2X",
               nint(255.0*psp_devs[(*idev)].gray[ci]) );
            }
            fprintf( psp_devs[(*idev)].unit, "\n");
         }
         break;                                 /* done */
      }
                     
      /*
       * IFUNC = 29
       * Color representation query.
       */
      case 29: {
         int ci = rbuf[0];
         (*nbuf) = 4;
         rbuf[1] = psp_devs[(*idev)].gray[ci];
         rbuf[2] = psp_devs[(*idev)].gray[ci];
         rbuf[3] = psp_devs[(*idev)].gray[ci];
         break;                                 /* done */
      }

      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#endif
#<

#>            tekdrv.dc3

Function:     TEKDRV

Purpose:      The TEKTRONIX graphics driver for the GIPS plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL TEKDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Jan 24, 1991: KGB Document created.

#<

#>            tekdrv.c
/* tekdrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1990
	All Rights Reserved.

Fortran to C interface:

@ subroutine tekdrv( integer, integer, real, integer, character, integer )

*/

/*
 * include files and definitions:
 */

#include	"ctype.h"			/* <ctype.h> */
#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */

#define	ioctl	IOCTL
#define	open	OPEN
#define	sleep	SLEEP

#if	defined(__convex__) && defined(__GNUC__)
#define	_SYS_TERMIOS_H_
#endif

#include	<fcntl.h>
#include	<sgtty.h>

#undef	ioctl
#undef	open
#undef	sleep

#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */

#define	BUFLEN	1024				/* size of output buffer */
#define	DEVICE	"TEK4010"			/* PGPLOT device name */
#define	DEVNAM	"/dev/tty"			/* default device name */
#define	HEIGHT	779				/* height of screen */
#define	MESLEN	80				/* length of messages */
#define	RESOL	130				/* device resolution */
#define	TYPE	1				/* TEKTRONIX mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	1023				/* width of screen */

typedef struct {
   bool	append;					/* append */
   char	name[TXTLEN+1];				/* name of device */
   char	obuf[BUFLEN+1];				/* buffers output */
   char	type[TXTLEN+1];				/* name of device */
   int	ic;					/* color index */
   int	lasti;					/* last x pen position */
   int	lastj;					/* last y pen position */
   int	lobuf;					/* contents of output buffer */
   int	unit;					/* device handle */
} tek_struct;

static	int		tek_ndev = 0;		/* number of psl devices */
static	tek_struct	*tek_devs = NULL;	/* psl device info */

/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Send data to graphics device.
 */
static	void	wterm( int id, char *buf, int l )
{
   int			unit = tek_devs[id].unit;
   int			write( );
   int			flags;
   int			ioctl( );
#ifdef __linux__
   (void) write( unit, buf, l );
#else
#ifdef	__sgi__
   struct termio	tty;

   (void) ioctl( unit, LIOCGETP, &tty );
   flags = tty.c_lflag;
   tty.c_lflag |= ICANON;
   (void) ioctl( unit, LIOCSETP, &tty );
   (void) write( unit, buf, l );
   tty.c_lflag = flags;
   (void) ioctl( unit, LIOCSETP, &tty );
#else
   struct sgttyb	tty;

   (void) ioctl( unit, TIOCGETP, &tty );
   flags = tty.sg_flags;
   tty.sg_flags |= RAW;
   (void) ioctl( unit, TIOCSETP, &tty );
   (void) write( unit, buf, l );
   tty.sg_flags = flags;
   (void) ioctl( unit, TIOCSETP, &tty );
#endif
#endif
}


/*
 * Get data from graphics device.
 */
static	void	rterm( int id, char *buf, int l )
{
   int			flags;
   int			ioctl( );
   int			read( );
   int			unit = tek_devs[id].unit;
#ifdef __linux__
   (void) read( unit, buf, l );
#else
#ifdef	__sgi__
   struct termio	tty;

   (void) ioctl( unit, LIOCGETP, &tty );
   flags = tty.c_lflag;
   tty.c_lflag &= 0xef;
   (void) ioctl( unit, LIOCSETP, &tty );
   (void) read( unit, buf, l );
   tty.c_lflag = flags;
   (void) ioctl( unit, LIOCSETP, &tty );
#else
   struct sgttyb	tty;

   (void) ioctl( unit, TIOCGETP, &tty );
   flags = tty.sg_flags;
   tty.sg_flags |= RAW;
   (void) ioctl( unit, TIOCSETP, &tty );
   (void) read( unit, buf, l );
   tty.sg_flags = flags;
   (void) ioctl( unit, TIOCSETP, &tty );
#endif
#endif
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   char	*obuf = tek_devs[id].obuf;		/* destination */
   int	i;					/* counter */
   int	lobuf = tek_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l) > BUFLEN) {			/* empty buffer */
      wterm( id, obuf, lobuf );			/* flush buffer */
      lobuf = 0;				/* fill buffer */
   }
   for (i = 0; i < l; obuf[lobuf++] = instr[i++] );
   tek_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   tek_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The TEKTRONIX driver.
 */

void	tekdrv_c( fint	*idev ,			/* psl device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= tek_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown TEK device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and return TEK device id.
       * (KGB implementation.)
       */
      case 0: {
         int	i = 0;				/* counter */
         int	id = 0;				/* psl device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < tek_ndev && strncmp( chr.a, tek_devs[id].type, l1 ) ) id++;
         if ( id == tek_ndev ) {		/* new entry */
            tek_devs = realloc( tek_devs, ++tek_ndev * sizeof( tek_struct ) );
            if (tek_devs == NULL) (*nbuf) = -1;	/* error */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; tek_devs[id].type[l++] = chr.a[i++]);
            tek_devs[id].type[l1] = 0;		/* add ending zero byte */
            if (l2) {				/* device specified */
               for (l = 0; l < l2; tek_devs[id].name[l++] = chr.a[i++]);
               tek_devs[id].name[l2] = 0;
            } else {
               strcpy( tek_devs[id].name, DEVNAM );/* default device name */
            }
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, tek_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* upper right x */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* upper right y */
         rbuf[4] = 0.0;				/* must be zero */
         rbuf[5] = 1.0;				/* number of colors */
         (*nbuf) = 6;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 1.0;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Interactive, cursor, No dashed lines, No area fill,
       * No thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "ICNNNNNNNN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, tek_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* x of upper right */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* y of upper right */
         (*nbuf) = 4;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 2.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         char	*tdev;				/* translated name */
         char	name[TXTLEN+1];
         int	l;
         int	open( );
         int	unit;

         if (rbuf[2] != 0.0) {
            tek_devs[(*idev)].append = 1;
         } else {
            tek_devs[(*idev)].append = 0;
         }
         for (l = 0; l < (*lchr); l++) {
            name[l] = chr.a[l]; /* tolower( chr.a[l] ); */
         }
         name[l] = 0;				/* ending zero byte */
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         tdev = getenv( name );			/* try translation */
         if (tdev == NULL) tdev = name;		/* no translation */
         unit = open( tdev, O_CREAT | O_RDWR, 0644 );
         if (unit == -1) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            tek_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            tek_devs[(*idev)].lasti = -1;	/* reset last x */
            tek_devs[(*idev)].lastj = -1;	/* reset last y */
            tek_devs[(*idev)].unit  = unit;	/* file descriptor */
            tek_devs[(*idev)].ic    = 1;
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         int	close( );			/* close a file */

         close( tek_devs[(*idev)].unit );	/* close it */
         tek_devs[(*idev)].unit = -1;		/* reset */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         char	instr[3];
         int	l = 0;
         int	sleep( );

         if (tek_devs[(*idev)].append) break;	/* quit now */
         instr[l++] = 29;
         instr[l++] = 27;
         instr[l++] = 12;
         send( instr, l, (*idev) );
         if (tek_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), tek_devs[(*idev)].obuf, tek_devs[(*idev)].lobuf );
            tek_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         (void) sleep( 2 );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         if (tek_devs[(*idev)].ic) {
            char	instr[12];		/* character buffer */
            int		i0 = nint( rbuf[0] );	/* begin x */
            int		j0 = nint( rbuf[1] );	/* begin y */
            int		i1 = nint( rbuf[2] );	/* end x */
            int		j1 = nint( rbuf[3] );	/* end y */
            int		l = 0;			/* number of characters */
            int		lasti = tek_devs[(*idev)].lasti;
            int		lastj = tek_devs[(*idev)].lastj;

            if (i0 == lasti && j0 == lastj) {	/* continue drawing */
               instr[l++] = ( j1 / 32 ) + 32;
               instr[l++] = ( j1 % 32 ) + 96;
               instr[l++] = ( i1 / 32 ) + 32;
               instr[l++] = ( i1 % 32 ) + 64;
            } else {				/* new segment */
               char	hiy = ( j1 / 32 ) + 32;
               char	loy = ( j1 % 32 ) + 96;
               char	hix = ( i1 / 32 ) + 32;
               char	lox = ( i1 % 32 ) + 64;

               instr[l++] = 29;
               instr[l++] = ( j0 / 32 ) + 32;
               instr[l++] = ( j0 % 32 ) + 96;
               instr[l++] = ( i0 / 32 ) + 32;
               instr[l++] = ( i0 % 32 ) + 64;
               instr[l++] = 0;
               if (hiy != instr[1]) instr[l++] = hiy;
               if (loy != instr[2] || hix != instr[3]) instr[l++] = loy;
               if (hix != instr[3]) instr[l++] = hix;
               instr[l++] = lox;
            }
            instr[l++] = 0;
            tek_devs[(*idev)].lasti = i1;	/* save end x */
            tek_devs[(*idev)].lastj = j1;	/* save end y */
            send( instr, l, (*idev) );		/* ship out */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         if (tek_devs[(*idev)].ic) {
            char	instr[8];		/* character buffer */
            int		i1 = nint( rbuf[0] );	/* x position */
            int		j1 = nint( rbuf[1] );	/* y position */
            int		l = 0;			/* number of characters */

            instr[l++] = 29;
            instr[l++] = ( j1 / 32 ) + 32;
            instr[l++] = ( j1 % 32 ) + 96;
            instr[l++] = ( i1 / 32 ) + 32;
            instr[l++] = ( i1 % 32 ) + 64;
            instr[l++] = 0;
            instr[l++] = instr[4];
            instr[l++] = 0;
            tek_devs[(*idev)].lasti = i1;	/* save end x */
            tek_devs[(*idev)].lastj = j1;	/* save end y */
            send( instr, l, (*idev) );		/* ship out */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         int	ic = nint( rbuf[0] );

         tek_devs[(*idev)].ic    = ic;
         if (ic) rbuf[0] = 1.0;
         tek_devs[(*idev)].lasti = -1;		/* reset end x */
         tek_devs[(*idev)].lastj = -1;		/* reset end y */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         char	instr[6];
         int	l = 0;

         instr[l++] = 29;
         instr[l++] = 55;
         instr[l++] = 127;
         instr[l++] = 32;
         instr[l++] = 64;
         instr[l++] = 31;
         send( instr, l, (*idev) );
         if (tek_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), tek_devs[(*idev)].obuf, tek_devs[(*idev)].lobuf );
            tek_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         tek_devs[(*idev)].lasti = -1;		/* reset end x */
         tek_devs[(*idev)].lastj = -1;		/* reset end y */
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       */
      case 17: {
         char	instr[7];
         int	ix = nint( rbuf[0] );
         int	iy = nint( rbuf[1] );
         int	ic;
         int	l = 0;

         if (tek_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), tek_devs[(*idev)].obuf, tek_devs[(*idev)].lobuf );
            tek_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         tek_devs[(*idev)].lasti = -1;		/* reset end x */
         tek_devs[(*idev)].lastj = -1;		/* reset end y */
         instr[l++] = 29;
         instr[l++] = ( ( iy / 32 ) & 31 ) | 32;
         instr[l++] = ( ( iy % 32 ) | 96 );
         instr[l++] = ( ( ix / 32 ) & 31 ) | 32;
         instr[l++] = ( ( ix % 32 ) | 64 );
         instr[l++] = 27;
         instr[l++] = 26;
         wterm( (*idev), instr, l );
         instr[0] = 0;
         rterm( (*idev), instr, 6 );
         ic = instr[0];
         ix = ( 32 * ( instr[1] & 31 ) + ( instr[2] & 31 ) );
         iy = ( 32 * ( instr[3] & 31 ) + ( instr[4] & 31 ) );
         rbuf[0] = (float) ix;
         rbuf[1] = (float) iy;
         (*nbuf) = 2;
         chr.a[0] = ic;
         (*lchr) = 1;
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       * (Not implemented: should not be called.)
       */
      case 20: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       * (Not implemented: should not be called.)
       */
      case 21: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       * (Not implemented: should not be called.)
       */
      case 22: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       * (Not implemented: ignored.)
       */
      case 23: {
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented: ignored.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented: ignored.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Line of pixels.
       * (Not implemented: ignored.)
       */
      case 26: {
         break;					/* done */
      }
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#<

#>            thsdrv.dc3

Function:     THSDRV

Purpose:      The THERMES driver for the GIPS plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       J.P. Terlouw

Use:          CALL THSDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Oct 13, 1992: JPT Derived from KGB's TEKDRV.
#<

#>            thsdrv.c
/* thsdrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1992
	All Rights Reserved.

Fortran to C interface:

@ subroutine thsdrv( integer, integer, real, integer, character, integer )

*/

/*
 * include files and definitions:
 */

#include        "stddef.h"
#include	"ctype.h"			/* <ctype.h> */
#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */

#include	<fcntl.h>
#include        <sys/file.h>

#ifndef L_SET
#define L_SET   SEEK_SET
#endif
#ifndef L_INCR
#define L_INCR  SEEK_CUR
#endif
#ifndef L_XTND
#define L_XTND  SEEK_END
#endif

#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */

#define	BUFLEN	1024				/* size of output buffer */
#define	DEVICE	"THERTEK"			/* PGPLOT device name */
#define	DEVNAM	"THERTEK"			/* default device name */
#define	HEIGHT	779				/* height of screen */
#define	MESLEN	80				/* length of messages */
#define	RESOL	130				/* device resolution */
#define	TYPE	8				/* tHermes mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	1023				/* width of screen */

typedef struct {
   bool	append;					/* append */
   char	name[TXTLEN+1];				/* name of device */
   char	obuf[BUFLEN+1];				/* buffers output */
   char	type[TXTLEN+1];				/* name of device */
   int	ic;					/* color index */
   int	lasti;					/* last x pen position */
   int	lastj;					/* last y pen position */
   int	lobuf;					/* contents of output buffer */
   int	unit;					/* device handle */
} ths_struct;

static	int		ths_ndev = 0;		/* number of ths devices */
static	ths_struct	*ths_devs = NULL;	/* ths device info */

/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Send data to graphics device.
 */
static	void	wterm( int id, char *buf, int l )
{
   int			unit = ths_devs[id].unit;
   int			write( );

   (void) write( unit, buf, l );
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   char	*obuf = ths_devs[id].obuf;		/* destination */
   int	i;					/* counter */
   int	lobuf = ths_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l) > BUFLEN) {			/* empty buffer */
      wterm( id, obuf, lobuf );			/* flush buffer */
      lobuf = 0;				/* fill buffer */
   }
   for (i = 0; i < l; obuf[lobuf++] = instr[i++] );
   ths_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   ths_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The TEKTRONIX FILE driver.
 */

void	thsdrv_c( fint	*idev ,			/* ths device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   static unsigned int seed=0;

   if (!seed) {
      seed = getpid();
      srand(seed);
   }
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= ths_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown THS device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and return THS device id.
       * (KGB implementation.)
       */
      case 0: {
         int	i = 0;				/* counter */
         int	id = 0;				/* ths device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < ths_ndev && strncmp( chr.a, ths_devs[id].type, l1 ) ) id++;
         if ( id == ths_ndev ) {		/* new entry */
            ths_devs = realloc( ths_devs, ++ths_ndev * sizeof( ths_struct ) );
            if (ths_devs == NULL) (*nbuf) = -1;	/* error */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; ths_devs[id].type[l++] = chr.a[i++]);
            ths_devs[id].type[l1] = 0;		/* add ending zero byte */
            if (l2) {				/* device specified */
               for (l = 0; l < l2; ths_devs[id].name[l++] = chr.a[i++]);
               ths_devs[id].name[l2] = 0;
            } else {
               strcpy( ths_devs[id].name, DEVNAM );/* default device name */
            }
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, ths_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* upper right x */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* upper right y */
         rbuf[4] = 0.0;				/* must be zero */
         rbuf[5] = 1.0;				/* number of colors */
         (*nbuf) = 6;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 1.0;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Hardcopy, No cursor, No dashed lines, No area fill,
       * No thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "INNNNNNNNN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, ths_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* x of upper right */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* y of upper right */
         (*nbuf) = 4;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 2.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         char	*tdev;				/* translated name */
         char	name[TXTLEN+1];
         int	l;
         int	unit;

         if (rbuf[2] != 0.0) {
            ths_devs[(*idev)].append = 1;
         } else {
            ths_devs[(*idev)].append = 0;
         }
         for (l = 0; l < (*lchr); l++) {
            name[l] = chr.a[l]; /* tolower( chr.a[l] ); */
         }
         name[l] = 0;				/* ending zero byte */
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         tdev = getenv( name );			/* try translation */
         if (tdev == NULL) tdev = name;		/* no translation */
         unit = open( tdev, O_CREAT | O_RDWR, 0644 );
         if (unit == -1) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            ths_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            ths_devs[(*idev)].lasti = -1;	/* reset last x */
            ths_devs[(*idev)].lastj = -1;	/* reset last y */
            ths_devs[(*idev)].unit  = unit;	/* file descriptor */
            ths_devs[(*idev)].ic    = 1;
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         int	close( );			/* close a file */

         close( ths_devs[(*idev)].unit );	/* close it */
         ths_devs[(*idev)].unit = -1;		/* reset */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         int    plotid;

         if (ths_devs[(*idev)].append) {
            (void)lseek(ths_devs[*idev].unit,0,L_XTND);
            break;
         }
         if (ths_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), ths_devs[(*idev)].obuf, ths_devs[(*idev)].lobuf );
            ths_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         (void)lseek(ths_devs[*idev].unit,0,L_SET);
         (void)ftruncate(ths_devs[*idev].unit,0);
         plotid = rand();
         wterm( (*idev), (char*)&plotid, sizeof(plotid));
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         if (ths_devs[(*idev)].ic) {
            char	instr[12];		/* character buffer */
            int		i0 = nint( rbuf[0] );	/* begin x */
            int		j0 = nint( rbuf[1] );	/* begin y */
            int		i1 = nint( rbuf[2] );	/* end x */
            int		j1 = nint( rbuf[3] );	/* end y */
            int		l = 0;			/* number of characters */
            int		lasti = ths_devs[(*idev)].lasti;
            int		lastj = ths_devs[(*idev)].lastj;

            if (i0 == lasti && j0 == lastj) {	/* continue drawing */
               instr[l++] = ( j1 / 32 ) + 32;
               instr[l++] = ( j1 % 32 ) + 96;
               instr[l++] = ( i1 / 32 ) + 32;
               instr[l++] = ( i1 % 32 ) + 64;
            } else {				/* new segment */
               char	hiy = ( j1 / 32 ) + 32;
               char	loy = ( j1 % 32 ) + 96;
               char	hix = ( i1 / 32 ) + 32;
               char	lox = ( i1 % 32 ) + 64;

               instr[l++] = 29;
               instr[l++] = ( j0 / 32 ) + 32;
               instr[l++] = ( j0 % 32 ) + 96;
               instr[l++] = ( i0 / 32 ) + 32;
               instr[l++] = ( i0 % 32 ) + 64;
               instr[l++] = 0;
               if (hiy != instr[1]) instr[l++] = hiy;
               if (loy != instr[2] || hix != instr[3]) instr[l++] = loy;
               if (hix != instr[3]) instr[l++] = hix;
               instr[l++] = lox;
            }
            instr[l++] = 0;
            ths_devs[(*idev)].lasti = i1;	/* save end x */
            ths_devs[(*idev)].lastj = j1;	/* save end y */
            send( instr, l, (*idev) );		/* ship out */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         if (ths_devs[(*idev)].ic) {
            char	instr[8];		/* character buffer */
            int		i1 = nint( rbuf[0] );	/* x position */
            int		j1 = nint( rbuf[1] );	/* y position */
            int		l = 0;			/* number of characters */

            instr[l++] = 29;
            instr[l++] = ( j1 / 32 ) + 32;
            instr[l++] = ( j1 % 32 ) + 96;
            instr[l++] = ( i1 / 32 ) + 32;
            instr[l++] = ( i1 % 32 ) + 64;
            instr[l++] = 0;
            instr[l++] = instr[4];
            instr[l++] = 0;
            ths_devs[(*idev)].lasti = i1;	/* save end x */
            ths_devs[(*idev)].lastj = j1;	/* save end y */
            send( instr, l, (*idev) );		/* ship out */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         int	ic = nint( rbuf[0] );

         ths_devs[(*idev)].ic    = ic;
         if (ic) rbuf[0] = 1.0;
         ths_devs[(*idev)].lasti = -1;		/* reset end x */
         ths_devs[(*idev)].lastj = -1;		/* reset end y */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         char	instr[6];
         int	l = 0;

         instr[l++] = 29;
         instr[l++] = 55;
         instr[l++] = 127;
         instr[l++] = 32;
         instr[l++] = 64;
         instr[l++] = 31;
         send( instr, l, (*idev) );
         if (ths_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), ths_devs[(*idev)].obuf, ths_devs[(*idev)].lobuf );
            ths_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         ths_devs[(*idev)].lasti = -1;		/* reset end x */
         ths_devs[(*idev)].lastj = -1;		/* reset end y */
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       * (Null operation: non-interactive.)
       */

      case 17: {
         break;
      }

      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       * (Not implemented: should not be called.)
       */
      case 20: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       * (Not implemented: should not be called.)
       */
      case 21: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       * (Not implemented: should not be called.)
       */
      case 22: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       * (Not implemented: ignored.)
       */
      case 23: {
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented: ignored.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented: ignored.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Line of pixels.
       * (Not implemented: ignored.)
       */
      case 26: {
         break;					/* done */
      }
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#<

#>            x11drv.dc3

Function:     X11DRV

Purpose:      The X11 graphics driver for the GIPSY plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL X11DRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Sep  5, 1993: KGB Document created.

#<

#>            x11drv.c
/* x11drv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1992
	All Rights Reserved.

Fortran to C interface:

@ subroutine x11drv( integer, integer, real, integer, character, integer )

*/

/*
 * include files and definitions:
 */

#include	"ctype.h"			/* <ctype.h> */
#include	"errno.h"			/* <errno.h> */
#include	"signal.h"			/* <signal.h> */
#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */
#include	"xscanf.h"			/* scans setup files */

typedef struct {			/* command structure */
   int	cmd;				/* the command */
   int	code;				/* encryption */
   int	nbytes;				/* number of bytes to expect */
} Command_struct;

#define	PLS_OPEN		0
#define	PLS_OPEN_CLIENT		1
#define	PLS_PGPLOT		2
#define	PLS_CLOSE		3
#define	PLS_MYNAME		4

#define	PLSE_SUCCESS		0
#define	PLSE_C_SEND		-1
#define	PLSE_C_RECEIVE		-2
#define	PLSE_NOSERVERSTART	-3
#define	PLSE_NOCOMFILE		-4
#define	PLSE_WRONGCOMFILE	-5
#define	PLSE_NOUSOCKET		-6
#define	PLSE_NOUCONNECT		-7
#define	PLSE_NOHADDRESS		-8
#define	PLSE_NOISOCKET		-9
#define	PLSE_NOICONNECT		-10
#define	PLSE_NOTIMPLEMENTED	-11
#define	PLSE_WRONGCONTYPE	-12
#define	PLSE_S_NOOPEN		-13
#define	PLSE_S_NOFONT		-14
#define	PLSE_S_NOCON		-15
#define	PLSE_S_NOCOMFILE	-16
#define	PLSE_S_RECEIVE		-17
#define	PLSE_S_SEND		-18
#define	PLSE_S_FLUSH		-19
#define	PLSE_ERROR_UNKNOWN	-20

#if	defined(__unix__)			/* for UNIX only */

#include	<sys/types.h>			/* define some weird types */
#include	<sys/socket.h>			/* the socket things */
#include	<sys/un.h>			/* unix things */
#include	<netinet/in.h>			/* inet things */
#include	<netdb.h>			/* network */
#if	defined(__sysv__)
#include	<sys/utsname.h>			/* SYSV only */
#endif
#if	!defined(htons) & !defined(__alpha__) & !defined(__linux__)
extern	u_short	htons( );
#endif

extern	int	close( );
extern	int	read( );
extern	int	write( );

#endif						/* __unix__ */

#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */
#include	"myname.h"			/* define myname_c */
#include	"nelc.h"			/* define nelc_c */

#define	DEVICE	"X11"				/* PGPLOT device name */
#define	DEVNAM	"PGWINDOW"			/* default device name */
#define	TXTLEN	80				/* length of text buffers */

#define	CHECK( r )	\
if ((r) != PLSE_SUCCESS) { \
   (*nbuf) = -1; \
   x11_devs[(*idev)].open = 0; \
   close( sock ); \
   break; \
}

typedef struct {
   char	name[TXTLEN+1];				/* name of device */
   char	type[TXTLEN+1];				/* name of device */
   int	poly;					/* poly count */
   int	open;					/* devices opened */
   int	sock;					/* socket */
} x11_struct;

static	int		x11_ndev = 0;		/* number of x11 devices */
static	x11_struct	*x11_devs = NULL;	/* x11 device info */
static	Command_struct	srv;			/* header for server */


/*
 * broken_pipe signal handler.
 */
static	void	broken_pipe( int sig )
{
   if (sig == SIGPIPE) signal( sig, broken_pipe );
}


/*
 * name_of_host obtains the name of the current host.
 */
static	int	name_of_host( char *hostname, int len )
{
#if	defined(__bsd__)
   int	gethostname( );

   return( gethostname( hostname, len ) );
#elif	defined(__sysv__)
   int			r = -1;
   struct utsname	name;

   if (uname( &name ) != -1) {
      r = 0;
      if (strlen( name.nodename ) > len) {
         strncpy( hostname, name.nodename, len );
      } else {
         strcpy( hostname, name.nodename );
      }
   }
   return( r );
#else
   return( -1 );
#endif
}


/*
 * srv_send sends data to the server.
 */
static	int	srv_send( int socket, void *data, int ndata )
{
   char	*p = (char *) data;			/* make character pointer */
   int	nd = 0;					/* current byte count */
   int	nl = ndata;				/* number of bytes left  */
   int	nt = 0;					/* number of bytes done */
   int	r = PLSE_SUCCESS;			/* return value */

   while (nl) {
      while ((nd = write( socket, &p[nt], nl )) == -1 && errno == EINTR);
      if (nd == -1) { r = PLSE_C_SEND; break; }
      nl -= nd;
      nt += nd;
   }
   return( r );					/* return to caller */
}


/*
 * srv_receive gets data from the server.
 */
static	int	srv_receive( int socket, void *data, int ndata )
{
   char	*p = (char *) data;			/* make character pointer */
   int	nd = 0;					/* current byte count */
   int	nl = ndata;				/* number of bytes left  */
   int	nt = 0;					/* number of bytes done */
   int	r = PLSE_SUCCESS;			/* return value */

   while (nl) {
      while ((nd = read( socket, &p[nt], nl )) == -1 && errno == EINTR);
      if (nd == -1) { r = PLSE_C_RECEIVE; break; }
      nl -= nd;
      nt += nd;
   }
   return( r );					/* return to caller */
}


/*
 * srv_start starts the server.
 */
static	int	srv_start( fchar name )
{
   FILE	*f;
   char	cmd[128];
   char	comf[TXTLEN];
   char	host[TXTLEN];
   char	unix_name[TXTLEN];
   char	inet_name[TXTLEN];
   char	dnet_name[TXTLEN];
   int	getpid( );
   int	nf;
   int	r = -1;
   int	sock = -1;

   sprintf( comf, "/tmp/.plserver_sockets.%d", getpid( ) );
   sprintf( cmd, "$gip_exe/plserver -window %.*s -comfile %s", nelc_c( name ),
      name.a, comf );
   if (system( cmd )) return( PLSE_NOSERVERSTART );
   f = fopen( comf, "r" );
   if (f == NULL) return( PLSE_NOCOMFILE );
   nf = xscanf( f, "%s %s %s %s", host, unix_name, inet_name, dnet_name );
   fclose( f );
   remove( comf );
   if (nf < 1) return( PLSE_WRONGCOMFILE );
   if (nf == 1) return( atoi( host ) );
   {
      char		hostname[80];
      int		connect( );
      int		con_type;
      int		ftype = OS_FLOATING_TYPE;
      int		ha;
      int		inet_addr( );
      int		socket( );
      struct hostent	*gethostbyname( );
      struct hostent	*hp;

      name_of_host( hostname, sizeof( hostname ) );	/* get host name */
      hp = gethostbyname( hostname );
      if (hp == NULL) {
         ha = inet_addr( hostname );
      } else {
         memmove( (void *) &ha, (void *) hp->h_addr,
            hp->h_length > sizeof( int ) ? sizeof( int ) : hp->h_length );
      }
      if (ha == inet_addr( host )) {
         con_type = 0;
      } else {
         con_type = 1;
      }
      if (con_type == 0 && unix_name[0] == 0) {
         con_type = 1;				/* try inet connection */
      }
      if (con_type == 1 && inet_name[0] == 0) {
         con_type = 2;				/* try dnet connection */
      }
      if (con_type == 2 && dnet_name[0] == 0) {
         con_type = -1;				/* unknown connection */
      }
      switch( con_type ) {
         case 0: {				/* unix connection */
            struct sockaddr_un	server;		/* unix socket address struct */

            sock = socket( AF_UNIX, SOCK_STREAM, 0 );	/* create socket */
            if (sock < 0) {			/* error creating socket */
               return( PLSE_NOUSOCKET );	/* code */
            }
            server.sun_family = AF_UNIX;	/* unix socket */
            strcpy( server.sun_path, unix_name );	/* name of socket */
            if (connect( sock, (struct sockaddr *)&server, sizeof( server )) < 0) {
               close( sock );			/* close socket */
               return( PLSE_NOUCONNECT );	/* code */
            } else {
               signal( SIGPIPE, broken_pipe );	/* catch broken pipes */
            }
            break;
         }
         case 1: {				/* inet connection */
            short		port;		/* inet port number */
            struct hostent	*hp;		/* host entry struct */
            struct hostent	*gethostbyname( );	/* get host info */
            struct sockaddr_in	server;		/* inet socket address struct */

            hp = gethostbyname( host );		/* get host by name */
            if (hp == NULL) {			/* unknown host */
               server.sin_addr.s_addr = inet_addr( host );
               if (server.sin_addr.s_addr == -1) {
                  return( PLSE_NOHADDRESS );	/* code */
               }
            } else {
               memmove( (char *)&server.sin_addr, (char *)hp->h_addr,
                  hp->h_length );
            }
            sock = socket( AF_INET, SOCK_STREAM, 0 );	/* create socket */
            if (sock < 0) {			/* error creating socket */
               return( PLSE_NOISOCKET );	/* code */
            }
            port = atoi( inet_name );		/* port number */
            server.sin_family = AF_INET;	/* internet socket */
            server.sin_port = htons( port );	/* port number */
            if (connect( sock, (struct sockaddr *)&server, sizeof( server )) < 0) {
               return( PLSE_NOICONNECT );	/* code */
            }
            break;
         }
         case 2: { 				/* dnet connection */
            return( PLSE_NOTIMPLEMENTED );	/* code */
            break;
         }
         default: {
            return( PLSE_WRONGCONTYPE );	/* code */
            break;
         }
      }
      srv.cmd    = PLS_OPEN;			/* command for server */
      srv.code   = PLS_OPEN_CLIENT;		/* open by client */
      srv.nbytes = sizeof( ftype );		/* next send */
      r = srv_send( sock, &srv, sizeof( srv ) );
      if (r != PLSE_SUCCESS) return( r );	/* send error */
      r = srv_send( sock, &ftype, sizeof( ftype ) );
      if (r != PLSE_SUCCESS) return( r );	/* send error */
      r = srv_receive( sock, &srv, sizeof( srv ) );
      if (r != PLSE_SUCCESS) return( r );	/* receive error */
      if (srv.code != PLSE_SUCCESS) return( srv.code );		/* error from server */
   }
   return( sock );
}


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[TXTLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   x11_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The X11 driver.
 */

void	x11drv_c( fint	*idev ,			/* x11 device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= x11_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown X11 device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and return x11 device id.
       * (KGB implementation.)
       */
      case 0: {
         int	i = 0;				/* counter */
         int	id = 0;				/* x11 device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < x11_ndev && strncmp( chr.a, x11_devs[id].type, l1 ) ) id++;
         if ( id == x11_ndev ) {		/* new entry */
            x11_devs = realloc( x11_devs, ++x11_ndev * sizeof( x11_struct ) );
            if (x11_devs == NULL) (*nbuf) = -1;	/* error */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; x11_devs[id].type[l++] = chr.a[i++]);
            x11_devs[id].type[l1] = 0;		/* add ending zero byte */
            if (l2) {				/* device specified */
               for (l = 0; l < l2; x11_devs[id].name[l++] = chr.a[i++]);
               x11_devs[id].name[l2] = 0;
            } else {
               strcpy( x11_devs[id].name, DEVNAM );/* default device name */
            }
            x11_devs[id].open = 0;		/* not open yet */
            x11_devs[id].sock = -1;		/* no connection yet */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, x11_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2:
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3:
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6:
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         int	sock = x11_devs[(*idev)].sock;

         (*nbuf) = 0;
         (*lchr) = 0;
         srv.cmd    = PLS_PGPLOT;
         srv.code   = (*ifunc);
         srv.nbytes = 0;
         CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
         CHECK( srv_receive( sock, &srv, sizeof( srv ) ) );
         (*nbuf) = srv.nbytes / sizeof( float );
         CHECK( srv_receive( sock, rbuf, srv.nbytes ) );
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       */
      case 4: {
         int	sock = x11_devs[(*idev)].sock;

         (*nbuf) = 0;
         (*lchr) = 0;
         srv.cmd    = PLS_PGPLOT;
         srv.code   = (*ifunc);
         srv.nbytes = 0;
         CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
         CHECK( srv_receive( sock, &srv, sizeof( srv ) ) );
         (*lchr) = srv.nbytes;
         CHECK( srv_receive( sock, chr.a, srv.nbytes ) );
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*nbuf) = 0;
         (*lchr) = fcopy( chr, x11_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         fchar	name;
         fchar	task;
         char	taskname[TXTLEN];
         int	sock;

         (*nbuf) = 3;
         name.a = chr.a; name.l = (*lchr);
         sock = srv_start( name );
         (*lchr) = 0;
         if (sock < 0) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
            (*nbuf) = 2;
         } else {				/* file open */
            x11_devs[(*idev)].open = 1;
            x11_devs[(*idev)].sock = sock;	/* file descriptor */
            x11_devs[(*idev)].poly = 0;
            srv.cmd    = PLS_PGPLOT;
            srv.code   = (*ifunc);
            srv.nbytes = (*nbuf) * sizeof( float );
            CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
            CHECK( srv_send( sock, rbuf, srv.nbytes ) );
            CHECK( srv_receive( sock, &srv, sizeof( srv ) ) );
            (*nbuf) = srv.nbytes / sizeof( float );
            (*lchr) = 0;
            CHECK( srv_receive( sock, rbuf, srv.nbytes ) );
            task.a = taskname;
            task.l = sizeof( taskname );
            myname_c( task );
            srv.cmd    = PLS_MYNAME;
            srv.code   = 0;
            srv.nbytes = nelc_c( task );
            CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
            CHECK( srv_send( sock, task.a, srv.nbytes ) );
            rbuf[0] = (*idev);
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         int	sock = x11_devs[(*idev)].sock;	/* close a file */

         (*nbuf) = 0;
         (*lchr) = 0;
         srv.cmd    = PLS_PGPLOT;
         srv.code   = (*ifunc);
         srv.nbytes = 0;
         CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
         srv.cmd    = PLS_CLOSE;
         srv.code   = 0;
         srv.nbytes = 0;
         CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
         CHECK( srv_receive( sock, &srv, sizeof( srv ) ) );
         close( sock );				/* close it */
         x11_devs[(*idev)].open = 0;		/* not open */
         x11_devs[(*idev)].sock = -1;		/* reset */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11:
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         int	sock = x11_devs[(*idev)].sock;	/* close a file */

         (*nbuf) = 0;
         (*lchr) = 0;
         srv.cmd    = PLS_PGPLOT;
         srv.code   = (*ifunc);
         srv.nbytes = 0;
         CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12:
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13:
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14:
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15:
      /*
       * IFUNC = 19
       * Set line style.
       */
      case 19:
      /*
       * IFUNC = 20
       * Polygon fill.
       */
      case 20:
      /*
       * IFUNC = 21
       * Set color representation.
       */
      case 21:
      /*
       * IFUNC = 22
       * Set line width.
       */
      case 22:
      /*
       * IFUNC = 24
       * Rectangle fill.
       */
      case 24: {
         int	sock = x11_devs[(*idev)].sock;

         switch( *ifunc ) {
            case 14:
            case 15:
            case 19:
            case 22: {
               (*nbuf) = 1;
               break;
            }
            case 20: {
               if (x11_devs[(*idev)].poly) {
                  (*nbuf) = 2;
               } else {
                  x11_devs[(*idev)].poly = nint( rbuf[0] ) + 1;
                  (*nbuf) = 1;
               }
               x11_devs[(*idev)].poly--;
	       break;
	    }
            case 13: {
               (*nbuf) = 2;
               break;
            }
            case 12:
            case 21:
            case 24: {
               (*nbuf) = 4;
               break;
            }
            default: {
               (*nbuf) = 0;
               break;
            }
         }
         srv.cmd    = PLS_PGPLOT;
         srv.code   = (*ifunc);
         srv.nbytes = (*nbuf) * sizeof( float );
         CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
         CHECK( srv_send( sock, rbuf, srv.nbytes ) );
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       */
      case 17: {
         int	nc, nf;
         int	sock = x11_devs[(*idev)].sock;

         (*nbuf) = 2;
         (*lchr) = 0;
         srv.cmd    = PLS_PGPLOT;
         srv.code   = (*ifunc);
         srv.nbytes = (*nbuf) * sizeof( float );
         CHECK( srv_send( sock, &srv, sizeof( srv ) ) );
         CHECK( srv_send( sock, rbuf, srv.nbytes ) );
         CHECK( srv_receive( sock, &srv, sizeof( srv ) ) );
         nf = srv.nbytes / sizeof( float );
         nc = srv.nbytes - nf * sizeof( float );
         (*nbuf) = nf;
         (*lchr) = nc;
         CHECK( srv_receive( sock, rbuf, srv.nbytes - nc ) );
         CHECK( srv_receive( sock, chr.a, nc ) );
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       * (Ignored.)
       */
      case 8:
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18:
      /*
       * IFUNC = 23
       * Escape.
       * (Not implemented: ignored.)
       */
      case 23:
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented: ignored.)
       */
      case 25:
      /*
       * IFUNC = 26
       * Line of pixels.
       * (Not implemented: ignored.)
       */
      case 26: {
         break;					/* done */
      }
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#<

#>            xtwdrv.dc3

Function:     XTWDRV

Purpose:      The XTERM graphics driver for the GIPS plot system.

Category:     GRAPHICS

File:         pgdriv.src

Author:       K.G. Begeman

Use:          CALL XTWDRV( IDEV ,     Input/Output    INTEGER
                           IFUNC ,       Input        INTEGER
                           RBUF ,     Input/Output    REAL ARRAY
                           NBUF ,     Input/Output    INTEGER
                           CHR ,      Input/Output    CHARACTER*(*)
                           LCHR )     Input/Output    INTEGER

              IDEV       Device identifier.
              IFUNC      Operation code which specifies what operation
                         the device handler is to perform. (see the
                         programmers guide.)
              RBUF       Floating-point array used to pass numerical
                         data to or from the device handler.
              NBUF       Indicates how many elements of RBUF are used.
              CHR        Used to pass character data to or from the
                         device handler.
              LCHR       Indicates how many characters are used.

Updates:      Jan 24, 1991: KGB Document created.

#<

#>            xtwdrv.c
/* xtwdrv.c

	Copyright (c) Kapteyn Laboratorium Groningen 1990
	All Rights Reserved.

Fortran to C interface:

@ subroutine xtwdrv( integer, integer, real, integer, character, integer )

*/

/*
 * include files and definitions:
 */

#include	"ctype.h"			/* <ctype.h> */
#include	"stdio.h"			/* <stdio.h> */
#include	"stdlib.h"			/* <stdlib.h> */
#include	"string.h"			/* <string.h> */

#define	chmod	CHMOD
#define	ioctl	IOCTL
#define	open	OPEN
#define	sleep	SLEEP

#if	defined(__convex__)
#define	_SYS_TERMIOS_H_
#endif

#include	<fcntl.h>
#if !defined(__linux__)
#include	<sgtty.h>
#endif

#undef	chmod
#undef	ioctl
#undef	open
#undef	sleep

#include	"gipsyc.h"			/* GIPSY definitions */
#include	"error.h"			/* define error_c */

#define	BUFLEN	1024				/* size of output buffer */
#define	DEVICE	"TEK4010"			/* PGPLOT device name */
#define	DEVNAM	"/dev/tty"			/* default device name */
#define	HEIGHT	779				/* height of screen */
#define	MESLEN	80				/* length of messages */
#define	RESOL	130				/* device resolution */
#define	TYPE	1				/* TEKTRONIX mode */
#define	TXTLEN	80				/* max length of text strings */
#define	WIDTH	1023				/* width of screen */

typedef struct {
   bool	append;					/* append */
   char	name[TXTLEN+1];				/* name of device */
   char	obuf[BUFLEN+1];				/* buffers output */
   char	type[TXTLEN+1];				/* name of device */
   int	ic;					/* color index */
   int	lasti;					/* last x pen position */
   int	lastj;					/* last y pen position */
   int	lobuf;					/* contents of output buffer */
   int	unit;					/* device handle */
} xtw_struct;

static	int		xtw_ndev = 0;		/* number of psl devices */
static	xtw_struct	*xtw_devs = NULL;	/* psl device info */


/*
 * opendevice tries to obtain the devicename of the xterm. This name
 * is in a file in the users HOME directory with name: .xterm_hostname.
 * If the file is not present, opendevice tries to start an xterm session
 * in the background. A c-shell script is created which is executed by
 * xterm and which writes the device name in the file, which is created by
 * the c-shell script. The script then waits until ^D is typed and tries to
 * destroy all intermediate files.
 */

static	int	opendevice( void )
{
   FILE	*f;
   char	device[80];
   char	filename[80];
   char	hname[80];
   char	*session_id;
   int	chmod( );
   int	count = 0;
   int	gethostname( );
   int	open( );

   gethostname( hname, 80 );
   session_id = getenv( "SESSION_ID" );
   if (session_id != NULL) {
      sprintf( filename, "%s/.xterm_%s_%s", getenv( "HOME" ), hname, session_id );
   } else {
      sprintf( filename, "%s/.xterm_%s_1", getenv( "HOME" ), hname );
   }
   if ((f = fopen( filename, "r" )) == NULL) {
      int	fork( );

      if (fork() == 0) {
         FILE	*c;
         char	cname[FILENAME_MAX];
         char	command[1024];

         sprintf( cname, "%s_start", filename );
         c = fopen( cname, "w" );
         fprintf( c, "#!/bin/sh\n" );
         fprintf( c, "echo 'Type ^D or run xkill to stop'\n" );
         fprintf( c, "tty > %s\n", filename );
         fprintf( c, "cat > /dev/null\n" );
         fprintf( c, "exit\n" );
         fclose( c );
         chmod( cname, 0755 );
         sprintf( command, "xterm -n Gipsy -title Gipsy@%s -t -e %s", hname, cname );
         system( command );
         remove( cname );
         remove( filename );
         exit( 0 );
      }
   } else {
      fclose( f );
      f = NULL;
   }
   while (f == NULL && count < 30) {
      f = fopen( filename, "r" );
      if ( f != NULL ) {
         if (fscanf( f, "%s", device ) != 1) {
            fclose( f );
            f = NULL;
         }
      } else {
         int	sleep( );

         sleep( 1 );
      }
      count += 1;
   }
   if (f == NULL) return( -1 );
   fclose( f );
   return( open( device, O_CREAT | O_RDWR, 0644 ) );
}


/*
 * fcopy fills a fortran character variable with the contents of an
 * asciiz string and returns the length of the asciiz string.
 */

static  int     fcopy( fchar d, char *s )
{
   int  l;					/* loop counter */
   int  l1;					/* length of source */
   int  l2;					/* length of desctination */

   l1 = strlen( s );				/* length of source */
   l2 = d.l;					/* length of destination */
   for (l = 0; l < l1 && l < l2; l++) {		/* copy loop */
      d.a[l] = s[l];				/* do the copy */
   }
   while (l < l2) d.a[l++] = ' ';		/* rest is blank */
   return( l1 );				/* return lenght of source */
}


/*
 * Send data to graphics device.
 */
static	void	wterm( int id, char *buf, int l )
{
   int			unit = xtw_devs[id].unit;
   int			write( );
   int			flags;
   int			ioctl( );
#ifdef __linux__
   (void) write( unit, buf, l );
#else
#ifdef	__sgi__
   struct termio	tty;

   (void) ioctl( unit, LIOCGETP, &tty );
   flags = tty.c_lflag;
   tty.c_lflag |= ICANON;
   (void) ioctl( unit, LIOCSETP, &tty );
   (void) write( unit, buf, l );
   tty.c_lflag = flags;
   (void) ioctl( unit, LIOCSETP, &tty );
#else
   struct sgttyb	tty;

   (void) ioctl( unit, TIOCGETP, &tty );
   flags = tty.sg_flags;
   tty.sg_flags |= RAW;
   (void) ioctl( unit, TIOCSETP, &tty );
   (void) write( unit, buf, l );
   tty.sg_flags = flags;
   (void) ioctl( unit, TIOCSETP, &tty );
#endif
#endif
}


/*
 * Get data from graphics device.
 */
static	void	rterm( int id, char *buf, int l )
{
   int			flags;
   int			ioctl( );
   int			read( );
   int			unit = xtw_devs[id].unit;
   int			write( );
#ifdef __linux__
   (void) read( unit, buf, l );
#else
#ifdef	__sgi__
   struct termio	tty;

   (void) ioctl( unit, LIOCGETP, &tty );
   flags = tty.c_lflag;
   tty.c_lflag &= 0xef;
   (void) ioctl( unit, LIOCSETP, &tty );
   (void) read( unit, buf, l );
   tty.c_lflag = flags;
   (void) ioctl( unit, LIOCSETP, &tty );
#else
   struct sgttyb	tty;

   (void) ioctl( unit, TIOCGETP, &tty );
   flags = tty.sg_flags;
   tty.sg_flags |= RAW;
   (void) ioctl( unit, TIOCSETP, &tty );
   (void) read( unit, buf, l );
   tty.sg_flags = flags;
   (void) ioctl( unit, TIOCSETP, &tty );
#endif
#endif
}


/*
 * Buffer output if possible.
 */

static	void	send( char *instr, int l, int id )
{
   char	*obuf = xtw_devs[id].obuf;		/* destination */
   int	i;					/* counter */
   int	lobuf = xtw_devs[id].lobuf;		/* # of chars in buffer */

   if ((lobuf + l) > BUFLEN) {			/* empty buffer */
      wterm( id, obuf, lobuf );			/* flush buffer */
      lobuf = 0;				/* fill buffer */
   }
   for (i = 0; i < l; obuf[lobuf++] = instr[i++] );
   xtw_devs[id].lobuf = lobuf;			/* save this number */
}


/*
 * Error: unimplemented function.
 */

static	void	noop( int ifunc, int id )
{
   char	message[MESLEN];			/* buffer for message */
   fint	error_level = 1;			/* warning message */

   (void) sprintf( message ,			/* message */
                   "Unimplemented function (%d) in %s device driver" ,
                   ifunc ,			/* the function */
                   xtw_devs[id].type );		/* device name */
   error_c( &error_level ,			/* error level */
            tofchar( message ) );		/* the message */
}


/*
 * Rounds float to int.
 */

static	int	nint( float f )
{
   int	r;					/* return value */

   r = (f + 0.5);				/* add 0.5 and truncate */
   return( r );					/* return to caller */
}


/*
 * The TEKTRONIX driver.
 */

void	xtwdrv_c( fint	*idev ,			/* psl device id */
                  fint	*ifunc ,		/* function */
                  float	*rbuf ,			/* float buffer */
                  fint	*nbuf ,			/* # of floats */
                  fchar	chr ,			/* character buffer */
                  fint	*lchr )			/* number of characters */
{
   if ((*ifunc) && ((*idev) < 0 || (*idev) >= xtw_ndev)) {
      fint	error_level = 4;		/* fatal error */

      error_c( &error_level, tofchar( "Unknown TEK device!" ) );
   }
   switch( *ifunc ) {				/* which function */
      /*
       * IFUNC = -1
       * Get PGPLOT device type.
       * (KGB implementation.)
       */
      case -1: {
         (*lchr) = fcopy( chr, DEVICE );
         break;
      }
      /*
       * IFUNC = 0
       * Set local device name and return TEK device id.
       * (KGB implementation.)
       */
      case 0: {
         int	i = 0;				/* counter */
         int	id = 0;				/* psl device id */
         int	l;				/* counter */
         int	l1;				/* length of first string */
         int	l2;				/* length of second string */

         l1 = nint( rbuf[0] );			/* convert to integer */
         l2 = nint( rbuf[1] );			/* convert to integer */
         while ( id < xtw_ndev && strncmp( chr.a, xtw_devs[id].type, l1 ) ) id++;
         if ( id == xtw_ndev ) {		/* new entry */
            xtw_devs = realloc( xtw_devs, ++xtw_ndev * sizeof( xtw_struct ) );
            if (xtw_devs == NULL) (*nbuf) = -1;	/* error */
         }
         if ((*nbuf) != -1) {			/* continue */
            (*idev) = id;			/* device id */
            for (l = 0; l < l1; xtw_devs[id].type[l++] = chr.a[i++]);
            xtw_devs[id].type[l1] = 0;		/* add ending zero byte */
            if (l2) {				/* device specified */
               for (l = 0; l < l2; xtw_devs[id].name[l++] = chr.a[i++]);
               xtw_devs[id].name[l2] = 0;
            } else {
               strcpy( xtw_devs[id].name, DEVNAM );/* default device name */
            }
         }
         break;					/* done */
      }
      /*
       * IFUNC = 1
       * Return device name.
       */
      case 1: {
         (*lchr) = fcopy( chr, xtw_devs[(*idev)].type );
         break;					/* done */
      }
      /*
       * IFUNC = 2
       * Return physical min and max for plot device, and range
       * of color indices.
       */
      case 2: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* upper right x */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* upper right y */
         rbuf[4] = 0.0;				/* must be zero */
         rbuf[5] = 1.0;				/* number of colors */
         (*nbuf) = 6;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 3
       * Return device resolution.
       */
      case 3: {
         rbuf[0] = RESOL;			/* resolution in x */
         rbuf[1] = RESOL;			/* resolution in y */
         rbuf[2] = 1.0;				/* pen width */
         (*nbuf) = 3;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 4
       * Return misc device info.
       * (This device is Interactive, cursor, No dashed lines, No area fill,
       * No thick lines).
       */
      case 4: {
         (*lchr) = fcopy( chr, "ICNNNNNNNN" );	/* the capability string */
         break;					/* done */
      }
      /*
       * IFUNC = 5
       * Return default file name.
       */
      case 5: {
         (*lchr) = fcopy( chr, xtw_devs[(*idev)].name );
         break;					/* done */
      }
      /*
       * IFUNC = 6
       * Return default physical size of plot.
       */
      case 6: {
         rbuf[0] = 0.0;				/* must be zero */
         rbuf[1] = (float) WIDTH;		/* x of upper right */
         rbuf[2] = 0.0;				/* must be zero */
         rbuf[3] = (float) HEIGHT;		/* y of upper right */
         (*nbuf) = 4;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 7
       *  Return misc defaults.
       */
      case 7: {
         rbuf[0] = 2.0;				/* return eight ? */
         (*nbuf) = 1;				/* this much */
         break;					/* done */
      }
      /*
       * IFUNC = 8
       * Select plot.
       */
      case 8: {
         break;					/* done */
      }
      /*
       * IFUNC = 9
       * Open workstation.
       */
      case 9: {
         char	name[TXTLEN+1];
         int	l;
         int	unit;

         if (rbuf[2] != 0.0) {
            xtw_devs[(*idev)].append = 1;
         } else {
            xtw_devs[(*idev)].append = 0;
         }
         for (l = 0; l < (*lchr); l++) {
            name[l] = chr.a[l]; /* tolower( chr.a[l] ); */
         }
         name[l] = 0;				/* ending zero byte */
         rbuf[0] = (*idev);			/* channel number */
         rbuf[1] = 1.0;				/* success code */
         (*nbuf) = 2;				/* this much */
         unit = opendevice( );
         if (unit == -1) {			/* not openend */
            rbuf[1] = 0.0;			/* error code */
         } else {				/* file open */
            xtw_devs[(*idev)].lobuf =  0;	/* reset buffer counter */
            xtw_devs[(*idev)].lasti = -1;	/* reset last x */
            xtw_devs[(*idev)].lastj = -1;	/* reset last y */
            xtw_devs[(*idev)].unit  = unit;	/* file descriptor */
            xtw_devs[(*idev)].ic    = 1;
         }
         break;					/* done */
      }
      /*
       * IFUNC = 10
       * Close workstation.
       */
      case 10: {
         int	close( );			/* close a file */

         close( xtw_devs[(*idev)].unit );	/* close it */
         xtw_devs[(*idev)].unit = -1;		/* reset */
         break;					/* done */
      }
      /*
       * IFUNC = 11
       * Begin picture.
       */
      case 11: {
         char	instr[3];
         int	l = 0;
         int	sleep( );

         if (xtw_devs[(*idev)].append) break;	/* quit now */
         instr[l++] = 29;
         instr[l++] = 27;
         instr[l++] = 12;
         send( instr, l, (*idev) );
         if (xtw_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), xtw_devs[(*idev)].obuf, xtw_devs[(*idev)].lobuf );
            xtw_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         (void) sleep( 2 );
         break;					/* done */
      }
      /*
       * IFUNC=12
       * Draw line.
       */
      case 12: {
         if (xtw_devs[(*idev)].ic) {
            char	instr[12];		/* character buffer */
            int		i0 = nint( rbuf[0] );	/* begin x */
            int		j0 = nint( rbuf[1] );	/* begin y */
            int		i1 = nint( rbuf[2] );	/* end x */
            int		j1 = nint( rbuf[3] );	/* end y */
            int		l = 0;			/* number of characters */
            int		lasti = xtw_devs[(*idev)].lasti;
            int		lastj = xtw_devs[(*idev)].lastj;

            if (i0 == lasti && j0 == lastj) {	/* continue drawing */
               instr[l++] = ( j1 / 32 ) + 32;
               instr[l++] = ( j1 % 32 ) + 96;
               instr[l++] = ( i1 / 32 ) + 32;
               instr[l++] = ( i1 % 32 ) + 64;
            } else {				/* new segment */
               char	hiy = ( j1 / 32 ) + 32;
               char	loy = ( j1 % 32 ) + 96;
               char	hix = ( i1 / 32 ) + 32;
               char	lox = ( i1 % 32 ) + 64;

               instr[l++] = 29;
               instr[l++] = ( j0 / 32 ) + 32;
               instr[l++] = ( j0 % 32 ) + 96;
               instr[l++] = ( i0 / 32 ) + 32;
               instr[l++] = ( i0 % 32 ) + 64;
               instr[l++] = 0;
               if (hiy != instr[1]) instr[l++] = hiy;
               if (loy != instr[2] || hix != instr[3]) instr[l++] = loy;
               if (hix != instr[3]) instr[l++] = hix;
               instr[l++] = lox;
            }
            instr[l++] = 0;
            xtw_devs[(*idev)].lasti = i1;	/* save end x */
            xtw_devs[(*idev)].lastj = j1;	/* save end y */
            send( instr, l, (*idev) );		/* ship out */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 13
       * Draw dot.
       */
      case 13: {
         if (xtw_devs[(*idev)].ic) {
            char	instr[8];		/* character buffer */
            int		i1 = nint( rbuf[0] );	/* x position */
            int		j1 = nint( rbuf[1] );	/* y position */
            int		l = 0;			/* number of characters */

            instr[l++] = 29;
            instr[l++] = ( j1 / 32 ) + 32;
            instr[l++] = ( j1 % 32 ) + 96;
            instr[l++] = ( i1 / 32 ) + 32;
            instr[l++] = ( i1 % 32 ) + 64;
            instr[l++] = 0;
            instr[l++] = instr[4];
            instr[l++] = 0;
            xtw_devs[(*idev)].lasti = i1;	/* save end x */
            xtw_devs[(*idev)].lastj = j1;	/* save end y */
            send( instr, l, (*idev) );		/* ship out */
         }
         break;					/* done */
      }
      /*
       * IFUNC = 14
       * End picture.
       */
      case 14: {
         break;					/* done */
      }
      /*
       * IFUNC = 15
       * Select color index.
       */
      case 15: {
         int	ic = nint( rbuf[0] );

         xtw_devs[(*idev)].ic    = ic;
         if (ic) rbuf[0] = 1.0;
         xtw_devs[(*idev)].lasti = -1;		/* reset end x */
         xtw_devs[(*idev)].lastj = -1;		/* reset end y */
         break;					/* done */
      }
      /*
       * IFUNC = 16
       * Flush buffer.
       */
      case 16: {
         char	instr[6];
         int	l = 0;

         instr[l++] = 29;
         instr[l++] = 55;
         instr[l++] = 127;
         instr[l++] = 32;
         instr[l++] = 64;
         instr[l++] = 31;
         send( instr, l, (*idev) );
         if (xtw_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), xtw_devs[(*idev)].obuf, xtw_devs[(*idev)].lobuf );
            xtw_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         xtw_devs[(*idev)].lasti = -1;		/* reset end x */
         xtw_devs[(*idev)].lastj = -1;		/* reset end y */
         break;					/* done */
      }
      /*
       * IFUNC = 17
       * Read cursor.
       */
      case 17: {
         char	instr[7];
         int	ix = nint( rbuf[0] );
         int	iy = nint( rbuf[1] );
         int	ic;
         int	l = 0;

         if (xtw_devs[(*idev)].lobuf) {		/* data in buffer */
            wterm( (*idev), xtw_devs[(*idev)].obuf, xtw_devs[(*idev)].lobuf );
            xtw_devs[(*idev)].lobuf = 0;	/* buffer now empty */
         }
         xtw_devs[(*idev)].lasti = -1;		/* reset end x */
         xtw_devs[(*idev)].lastj = -1;		/* reset end y */
         instr[l++] = 29;
         instr[l++] = ( ( iy / 32 ) & 31 ) | 32;
         instr[l++] = ( ( iy % 32 ) | 96 );
         instr[l++] = ( ( ix / 32 ) & 31 ) | 32;
         instr[l++] = ( ( ix % 32 ) | 64 );
         instr[l++] = 27;
         instr[l++] = 26;
         wterm( (*idev), instr, l );
         instr[0] = 0;
         rterm( (*idev), instr, 6 );
         ic = instr[0];
         ix = ( 32 * ( instr[1] & 31 ) + ( instr[2] & 31 ) );
         iy = ( 32 * ( instr[3] & 31 ) + ( instr[4] & 31 ) );
         rbuf[0] = (float) ix;
         rbuf[1] = (float) iy;
         (*nbuf) = 2;
         chr.a[0] = ic;
         (*lchr) = 1;
         break;					/* done */
      }
      /*
       * IFUNC = 18
       * Erase alpha screen.
       * (Null operation: there is no alpha screen.)
       */
      case 18: {
         break;					/* done */
      }
      /*
       * IFUNC = 19
       * Set line style.
       * (Not implemented: should not be called.)
       */
      case 19: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 20
       * Polygon fill.
       * (Not implemented: should not be called.)
       */
      case 20: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 21
       * Set color representation.
       * (Not implemented: should not be called.)
       */
      case 21: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 22
       * Set line width.
       * (Not implemented: should not be called.)
       */
      case 22: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
      /*
       * IFUNC = 23
       * Escape.
       * (Not implemented: ignored.)
       */
      case 23: {
         break;					/* done */
      }
      /*
       * IFUNC = 24
       * Rectangle fill.
       * (Not implemented: ignored.)
       */
      case 24: {
         break;					/* done */
      }
      /*
       * IFUNC = 25
       * Set fill pattern.
       * (Not implemented: ignored.)
       */
      case 25: {
         break;					/* done */
      }
      /*
       * IFUNC = 26
       * Line of pixels.
       * (Not implemented: ignored.)
       */
      case 26: {
         break;					/* done */
      }
      /*
       * IFUNC = ?
       * Unknown function.
       */
      default: {
         noop( (*ifunc), (*idev) );		/* error */
         (*nbuf) = -1;				/* error code */
         break;					/* done */
      }
   }
}
#<

#>            image.H
/* image.H
 *
 *  This file contains definitions for image generation to be used by
 *  the different PostScript drivers.
 *  These are represented in a compact form which is equivalent
 *  to the annotated code below.
 */

/*
% =============================================================================
%  Image interpolation procedures
% -----------------------------------------------------------------------------
%  The following procedures perform a bi-linear interpolation on an image.
%  The pixel values should represent some value. These values are interpolated
%  and the resulting pixels values are used as an index in the color map,
%  which eventually determines the color to be shown.
%
%  Some relevant variables:
%
%  Blank    - color index used for BLANK values
%  Nx       - resulting number of pixels per row
%  Ny       - resulting number of pixels per column
%  Inrow    - string with pixels of the original image
%             first and last elements are set to Blank
%  Indata   - the portion if Inrow into which data are read
%  Cur, Nxt - work buffers, Nx long
%  Out      - output buffer, Nx long
%  NxDiv    - number of sub-pixels in x-direction
%  NyDiv    - number of sub-pixels in y-direction
%  Cx, Cy   - "central" sub-pixels with respect to indexing
%  Y        - current y-coordinate
%
%  In the procedures comments are provided which show the state of the stack
%  in an informal "short-hand" format.
%
%
%  Author: J. P. Terlouw

% -----------------------------------------------------------------------------
%  resolution constant
% -----------------------------------------------------------------------------
%  This constant is used to determine the number of subdivisions per pixel.
%  It is the approximate interpolated pixel size in units of 0.001 inch.

/ImgRes 10 def

% -----------------------------------------------------------------------------
%  check blank "participant"
% -----------------------------------------------------------------------------
%  Compare top two elements on stack with Blank and if so, replace it
%  by the other stack element's value.
%
%  int int oneblank int int

/oneblank {
                                         % cval nval
   dup Blank eq {
      pop dup                            % cval cval
   } {
        exch dup Blank eq {
           pop dup                       % nval nval
        } {
           exch                          % cval nval
        } ifelse
   } ifelse
} bind def

% -----------------------------------------------------------------------------
%  set line to Blank
% -----------------------------------------------------------------------------
%  Set all elements of the argument string to Blank.
%
%  str setblank -

/setblank {
   0 exch dup { pop 2 copy exch Blank put  exch 1 add exch} forall
   pop pop
} bind def

% -----------------------------------------------------------------------------
%  read and interpolate image line
% -----------------------------------------------------------------------------
%  Obtain a line from the input image and perform a linear interpolation.
%  If the data is exhausted, blanks are returned.
%  The result is stored in the string argument.
%
%  str getline -

/getline {
                                            %  arg
   source InData readstring {
      pop
      0 1 Nx 1 sub {
                                            %  arg x
         exch dup 3 -1 roll                 %  arg arg x

         dup NxDiv add NxDiv idiv InRow exch get Blank eq {
            Blank  put                     %  arg
         } {
            dup dup                        %  arg x x x
            NxDiv add Cx sub
            NxDiv idiv                     %  arg x x c
            dup 1 add exch                 %  arg x x n c
            InRow exch get                 %  arg x x n cval
            exch InRow exch get            %  arg x x cval nval
            oneblank
            3 -1 roll                      %  arg x cval nval x
            NxDiv add Cx sub NxDiv mod     %  arg x cval nval wn
            dup NxDiv exch sub             %  arg x cval nval wn wc
            4 1 roll                       %  arg x wc cval nval wn
            mul                            %  arg x wc cval nval.wn
            3 1 roll                       %  arg x nval.wn wc cval
            mul add                        %  arg x nval.wn+wc.cval
            NxDiv div                      %  arg x (nval.wn+wc.cval)/nxdiv
            put                            %  arg
        } ifelse
     } for
     pop
   } {
      pop setblank
   } ifelse
} bind def
   
% -----------------------------------------------------------------------------
%  generate pixels
% -----------------------------------------------------------------------------
%  Procedure to be called by the image operator whenever it needs data.
%  This is the outer loop of the interpolation algorithm.
%
%  - pixels str

/pixels {
   Y
   dup 0 eq Y NyDiv mod Cy eq or {
      /Tmp Nxt def  /Nxt Cur def /Cur Tmp def Nxt getline
   } if
   NyDiv 1 eq {
      pop 1
   } {
      NyDiv add Cy sub NyDiv mod
   } ifelse
   
   dup NyDiv exch sub                       % wn wc
   2 copy gt NyDiv 1 eq or {0} {1} ifelse   % wn wc 0|1
   3 1 roll                                 % 0|1 wn wc
      0 1 Nx 1 sub {
         dup dup                            %  0|1 wn wc x x x
         Cur exch get                       %  0|1 wn wc x x cval
         exch Nxt exch get                  %  0|1 wn wc x cval nval
         5 index                            %  0|1 wn wc x cval nval 0|1
         index Blank eq                     %  0|1 wn wc x cval nval true|false
         {
            pop pop Blank                   %  0|1 wn wc x blank
         }
         {
            oneblank
            4 index mul                  %  0|1 wn wc x cval nval.wn
            exch 3 index mul add         %  0|1 wn wc x nval.wn+cval.wc
            NyDiv div round cvi          %  0|1 wn wc x (nval.wn+cval.wc)/nydiv
         } ifelse
         Out 3 1 roll put                %  0|1 wn wc
      } for
   /Y Y 1 add def
   pop pop pop
   Out
} bind def

% =============================================================================
%  Per-image instructions
% -----------------------------------------------------------------------------
%  These instructions are in the form of a C format string to be
%  used in a call to fprintf(). Comments after double slashes are
%  not part of the instructions.
%

/source currentfile /ASCII85Decode filter def  // Image input stream

/Width %d def /Height %d def            // Number of colums and rows

/Imgmat
        [ %.4E  %.4E
          %.4E  %.4E
          %.4E  %.4E] def               // Image matrix
                        
grimip {
   /NxDiv 1 0 Imgmat idtransform
            dup mul exch dup mul add sqrt ImgRes div ceiling cvi 1 or def
   /NyDiv 0 1 Imgmat idtransform
            dup mul exch dup mul add sqrt ImgRes div ceiling cvi 1 or def
} {
   /NxDiv 1 def
   /NyDiv 1 def
} ifelse                                // Number of subdivisions per pixel

/Cx NxDiv 2 idiv def                    // "Central" subpixel with respect ...
/Cy NyDiv 2 idiv def                    // ... to indexing
/InRow Width 2 add string def           // Input buffer
InRow 0 Blank put                       // Blank at both start ...
InRow Width 1 add Blank put             // ... and end of buffer
/InData InRow 1 Width getinterval def   // Central part of buffer
/Nx Width  NxDiv mul def                // Resulting number of pixels in "x" ...
/Ny Height NyDiv mul def                // ... and in "y"
/Cur Nx array def                       // Work buffer
/Nxt Nx array def                       // Work buffer
Nxt setblank                            // Start with Blank buffer
/Out Nx string def                      // Output buffer
/Y 0 def                                // Initialize "y"-coordinate

Imgmat [ NxDiv 0 0 NyDiv 0 0 ] Imgmat
   concatmatrix pop                     // Apply subdivisions to image matrix
newpath %f %f moveto %f 0 rlineto 0 %f rlineto %f 0 rlineto closepath clip


% ===========================================================================
*/

#define INTERPOL "\
/ImgRes 10 def\n\
/oneblank { dup Blank eq {\n\
pop dup } { exch dup Blank eq { pop dup } { exch } ifelse } ifelse }\n\
bind def /setblank { 0 exch dup { pop 2 copy exch Blank put exch 1 add\n\
exch} forall pop pop } bind def /getline { source InData readstring {\n\
pop 0 1 Nx 1 sub { exch dup 3 -1 roll dup NxDiv add NxDiv idiv InRow\n\
exch get Blank eq { Blank put } { dup dup NxDiv add Cx sub NxDiv idiv\n\
dup 1 add exch InRow exch get exch InRow exch get oneblank 3 -1 roll\n\
NxDiv add Cx sub NxDiv mod dup NxDiv exch sub 4 1 roll mul 3 1 roll mul\n\
add NxDiv div put } ifelse } for pop } { pop setblank } ifelse\n\
} bind def /pixels { Y dup 0 eq Y NyDiv mod Cy eq or { /Tmp Nxt def /Nxt\n\
Cur def /Cur Tmp def Nxt getline } if NyDiv 1 eq { pop 1 } { NyDiv add\n\
Cy sub NyDiv mod } ifelse dup NyDiv exch sub 2 copy gt NyDiv 1 eq or {0}\n\
{1} ifelse 3 1 roll 0 1 Nx 1 sub { dup dup Cur exch get exch Nxt exch\n\
get 5 index index Blank eq { pop pop Blank } { oneblank 4 index mul exch\n\
3 index mul add NyDiv div round cvi } ifelse Out 3 1 roll put } for /Y Y\n\
1 add def pop pop pop Out } bind def\n"

#define IMGPAR "\
/source currentfile /ASCII85Decode filter def /Width %d def /Height %d\n\
def /Imgmat [ %.4E %.4E %.4E %.4E %.4E %.4E] def grimip { /NxDiv 1 0\n\
Imgmat idtransform dup mul exch dup mul add sqrt ImgRes div ceiling cvi\n\
1 or def /NyDiv 0 1 Imgmat idtransform dup mul exch dup mul add sqrt\n\
ImgRes div ceiling cvi 1 or def } { /NxDiv 1 def /NyDiv 1 def } ifelse\n\
/Cx NxDiv 2 idiv def /Cy NyDiv 2 idiv def /InRow Width 2 add string def\n\
InRow 0 Blank put InRow Width 1 add Blank put /InData InRow 1 Width\n\
getinterval def /Nx Width NxDiv mul def /Ny Height NyDiv mul def /Cur Nx\n\
array def /Nxt Nx array def Nxt setblank /Out Nx string def /Y 0 def\n\
Imgmat [ NxDiv 0 0 NyDiv 0 0 ] Imgmat concatmatrix pop newpath %f %f\n\
moveto %f 0 rlineto 0 %f rlineto %f 0 rlineto closepath clip\n"
#<
