/* @(#)Copyright (c), 1987, 1994 StatSci, Inc.  All rights reserved. */
static char whatssi[] = "@(#)skeleton.c version 3.23 created 2/10/94 ";
/* S device driver for simple graphics devices
	(pen plotters, simple crt's, etc.
*/

#include "S.h"
#include "device.h"

/* number of local state variables to be retained by device */
#define NLOCAL 5

/* definitions for the state variables */
#define outfile  ((FILE **)(cur_device->local_params))[0]
#define oldcolor ((float *)(cur_device->local_params))[1]
#define oldltype ((float *)(cur_device->local_params))[2]
#define oldrot   ((float *)(cur_device->local_params))[3]
#define oldsize  ((float *)(cur_device->local_params))[4]

/* defines that allow easy access of graphical parameters */
#define am(i)		(F77_COM(bgrp)[i-1])
#define ask      	(am(16))
#define Ltype		(am(8))
#define Color		(am(10))
#define Cex		(am(18))
#define notNew		(am(121))
extern float F77_COMDECL(bgrp)[];

/* declarations for routines in the device structure
	note that simple() is the only externally-called function
	all the rest are statics appearing in the device structure */
vector *simple(), *F77_NAME(bquxyz)(),
	*F77_NAME(bpntsz)(), *F77_NAME(blinsz)(), *F77_NAME(bpolyz)(),
	*F77_NAME(btextz)(), *F77_NAME(bsegsz)(), *F77_NAME(brdpnz)();
void F77_NAME(defltz)();
static vector  *wrap(), *flush(), *signalled(), *locbtextz(),
	*clear(), *hook(), *seek(), *point(), *line(), *getxy(),
	*activate() ;

/* structure that describes the device and its functions */
static device d_simple = {
			/* leave these alone */
	FALSE,				/* active flag */
	0,				/* index in list of devices */
	(DisplayListHead *)NULL,        /* ptr to displaylist head */
	(float *)NULL,			/* copy of parameter array */
	NLOCAL,				/* number of local parameters */
	(char *)NULL,			/* slot for the local parameters */
			/* functions performed by driver */
	{		/* <R> required <O> optional */
		simple,			/* initialize <R> */
		wrap,			/* wrap up <R> */
		flush,			/* flush <R> */
		signalled,		/* caught signal <R> */
			/* these functions deal with sequences of points,
				lines, segments, etc., and can be
				written specially for this device or 
				can be the parenthesized pre-defined
				functions that call lower-level seek,
				line, character, etc functions */
		F77_CALL(bpntsz),	/* points <R> (bpntsz) */
		F77_CALL(blinsz),	/* lines <R> (blinsz) */
		F77_CALL(bpolyz),	/* polygon <R> (bpolyz) */
		locbtextz,		/* text <R> (btextz) */
		F77_CALL(bsegsz),	/* segments <R> (bsegsz) */
		clear,			/* clear <R> */
		F77_CALL(brdpnz),	/* graphic input <R> (brdpnz) */
		NULL,			/* menu <O> */
		hook,			/* hook <O> */
			/* these low-level functions must be supplied only if
				bpntsz, blinsz, bsegsz, btextz, brdpnz are
				used above */
		seek,			/* seek <O> (low level) */
		point,			/* point <O> (low level) */
		line,			/* line <O> (low level) */
		NULL,			/* length of string <O> (ignore this) */
		getxy,			/* input <O> (low level) */
		NULL,                   /* image <O> */
		NULL,                   /* printgraph <O> */
		NULL,                   /* redraw <O> */
		NULL,                   /* brush <O> */
		NULL,                   /* spin <O> */
		NULL,                   /* switchmode <O> */
		activate,               /* <0> */
		/* 5 unused slots, for total of NPRIMITIVES=30 */
		NULL,                   /* unused */
		NULL,                   /* unused */
		NULL,                   /* unused */
		NULL,                   /* unused */
		NULL,                   /* unused */
	}
};


/* this is the device initialization function that is called
	from the device driver interpreted function using the .C function.
	For example, this function is called by
	
	simple <- function(ask = F, file = "")
	{
		graphics.off()
		z <- .C("simple",
			as.logical(ask),
			as.character(file))
		Device.Default("simple")
	}

*/

vector
*simple(a_ask,a_file)
long *a_ask;
char **a_file;
{
	device *d, *new_device();
	FILE *tmp_outfile;
	int i;

	if(**a_file){	/* no interaction allowed if output to file */
		tmp_outfile = fopen(*a_file,"w");
		if(tmp_outfile == NULL)
			PROBLEM "Cannot open file" RECOVER(S_void);
		*a_ask = 0;
		}
	else tmp_outfile = stdout;

	/* initialize device structure now that file is opened*/
	d = new_device(&d_simple, 0L);
	set_device(d->which);

	for(i=1; i<=39; i++)
		am(i) = 0.0;
	am(20) = 11.;	/* char size (x) in rasters */
	am(21) = 21.;	/* char size (y) in rasters */
	am(22) = 0.;	/* minimum x raster coordinate */
	am(23) = 1000.;	/* maximum x raster coordinate */
	am(24) = 0.;	/* minimum y raster coordinate */
	am(25) = 1000.;	/* maximum y raster coordinate */
	am(26) = 1./6.;	/* char addressing offset x */
	am(27) = .25;	/* char addressing offset y */
	am(28) = .001;	/* x raster size in inches */
	am(29) = .001;	/* y raster size in inches */
	am(30) = -2000;	/* arbitrary negative device number (device.h) */
	am(31) = 1;	/* allow char rotation */
	am(1)  = 2.;	/* allow char size change */

	ask = *a_ask;	/* initialize local variables */
	outfile = tmp_outfile;

	fprintf(outfile,"Initialization String\n");

	/* these values for the old parameter values ensure
		that the parameters will be set first time around */
	oldcolor = oldltype = oldrot = oldsize = -1;
	F77_CALL(defltz)();	/* set default values for other parms */
	notNew = 1;	/* force erase on first real plotting */
	{
		long tmp_true = 1L ;
		activate(&tmp_true, &cur_device->which) ;
	}
	return(S_void);
}

/* this function is called to wrap up execution */
static vector *
wrap()
{
	fprintf(outfile,"Wrap up execution\n");
	if(outfile != stdout) fclose(outfile);
	else fflush(outfile) ;
	outfile = NULL;
	return(S_void);
}


/* function executed when the device receives a signal (like an interrupt)
	its purpose is to make sure the device is reset to a consistent
	state when interrupted */
static vector *signalled()
{
	fprintf(outfile,"Signal Received\n");
	return(S_void);
}

static vector *
locbtextz(x, y, buf, n, pos)
float *x, *y, *pos;
unsigned char buf[];
long *n;
#ifdef NOEXTRAS /*(*/
{       long lbuf=*n; return(F77_CALL(btextz)(x,y,buf,lbuf,n,pos)); }
#else /*)(*/
{       return(F77_CALL(btextz)(x,y,buf,n,pos)); }
#endif /*)*/

/* draw a line segment */
static vector *line(x,y)
long *x,*y;
{
	fprintf(outfile,"Line To %ld,%ld\n",*x,*y);
	return(S_void);
}

/* put out a single character at current position */
static vector *point(ich,crot)
char *ich; float *crot;
{
	/* change rotation angle if needed */
	if(*crot != oldrot){
		fprintf(outfile,"New Rotation angle %g\n",*crot);
		oldrot = *crot;
		}

	/* change character size if needed */
	if(Cex != oldsize){
		fprintf(outfile,"New Size %g\n",Cex);
		oldsize = Cex;
		}

	fprintf(outfile,"Character '%c'\n",*ich);
	return(S_void);
}

/* position the device at x,y coords
	this is also the place to check color and line style changes */

static vector *seek(x,y)
long *x,*y;
{
	if(Color != oldcolor){
		fprintf(outfile,"New Color %g\n",Color);
		oldcolor = Color;
		}

	if(oldltype != Ltype){
		fprintf(outfile,"New Line Type %g\n",Ltype);
		oldltype = Ltype;
		}

	fprintf(outfile,"Move to %ld, %ld\n",*x,*y);
	return(S_void);
}

/* clear the graphic area */
static vector *clear()
{
	if(ask && outfile==stdout){
		fprintf(stderr,"GO? ");
		fflush(stderr);
		while( getc(stdin)!='\n' ) ;	/* ignore reply */
		}
	fprintf(outfile,"Clear the Screen\n");
	return(S_void);
}


/* called to make sure device is flushed and ready to accept
	text as well as graphic output */
static vector *flush()
{
	fprintf(outfile,"Flush\n");
	fflush(outfile);
	return(S_void);
}


/* read an x-y pair from the device, flag indicates whether
	read was successful or not (a negative value indicates
	no point given and generally terminates higher-level reads)
*/
static vector *getxy(x,y,flag)
long *x,*y,*flag;
{
	if(outfile!=stdout){
		/* non-interactive, should read from terminal */
		F77_CALL(bquxyz)(x,y,flag);
		return(S_void);
		}
	fprintf(outfile,"Ready to read x-y pair\n");
	/* optional: if(*flag) immediate return of current mouse position */
	/* the code here should fill up x and y and
		set flag to 0 for success, -1 for failure */
	*x = 100.; *y = 100.; *flag = 0;
	return(S_void);
}

static vector *hook(type, x, n, y, m)
long *type, *n, *m;
float x[], y[];
{
	switch((int)*type) {
	case HOOK_setcolor:
		{
		int ndef = *n / 4, i;
		float *N = x, *H = N+ndef, *L = H+ndef, *S = L+ndef;
		printf("New color definitions:\n");
		for(i = 0; i < ndef; i++)
			printf("\t%g: %g %g %g\n", *N++, *H++, *L++, *S++);
		break;
		}
	default:
		printf("unknown hook type: %d\n", *type);
	}
	return(S_void);
}

static vector *
activate(flag, which)
long *flag ;
long *which ;
{
	/*
	 * activate will be called in 2 awkward situations -- before
	 * the initialization procedure has opened the output file and
	 * after the wrapup procedure has closed it.  In the both cases
	 * it cannot do much.  In the first case it could tell the
	 * device what its device number is (external devices do not
	 * know it otherwise) and the initialize procedure should recall
	 * it when everything is set up for drawing.  In the latter
	 * case, it should do nothing at all (it will be told that the
	 * device is about to lose its active status right after wrap
	 * is called).
	 */
	if (!outfile) {
		fprintf(stderr, "(activate : outfile not set, will do nothing)\n") ;
		fflush(stderr) ;
		return S_void ;
	}
	if (*which != cur_device->which) {
		fprintf(stderr, "Internal error: *which (%ld) != cur_dev->which(%ld)\n",
			*which, cur_device->which) ;
		fflush(stderr) ;
		return S_void ;
	}
	if (*flag) {
		fprintf(outfile, "Device %ld just became the active device\n", *which) ;
		if (outfile != stdout)
			fprintf(stderr, "Device %ld just became the active device\n", *which) ;
	} else {
		fprintf(outfile, "Device %ld is about to be deactivated\n", *which) ;
		if (outfile != stdout)
			fprintf(stderr, "Device %ld is about to be deactivated\n", *which) ;
	}
	fflush(outfile) ;
	if (outfile != stdout)
		fflush(stderr) ;
	return S_void ;
}