/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1997-2012  The R Core Team
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, a copy is available at
 *  https://www.R-project.org/Licenses/
 */

    double x;
    int ix = 0;
    char cx = '\0';

/* Graphical parameters which are treated identically by
 * par( <nam> = <value> )  and	highlevel  plotfun (..., <nam> = <value> ).
 *
 * This is #included both from Specify() and Specify2() into ./par.c
 *			       ~~~~~~~~~     ~~~~~~~~~~      =======
*/
    if (streql(what, "adj")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	BoundsCheck(x, 0.0, 1.0, what);
	R_DEV__(adj) = x;
    }
    else if (streql(what, "ann")) {
	lengthCheck(what, value, 1);	ix = asLogical(value);
	R_DEV__(ann) = (ix != 0);/* NA |-> TRUE */
    }
    else if (streql(what, "bg")) {
	/* in par() this means the plot region, inline it means filled points */
#ifdef FOR_PAR
	lengthCheck(what, value, 1);
#else
	if (!isVector(value) || LENGTH(value) < 1) par_error(what);
#endif
	R_DEV__(bg) = RGBpar3(value, 0, dpptr(dd)->bg);
#ifdef FOR_PAR
	R_DEV__(new) = FALSE;
#endif
    }
    else if (streql(what, "bty")) {
	lengthCheck(what, value, 1);
	if (!isString(value))
	    par_error(what);
	cx = CHAR(STRING_ELT(value, 0))[0];
	switch (cx) {
	case 'o': case 'O':
	case 'l': case 'L':
	case '7':
	case 'c': case 'C': case '[':
	case ']':
	case 'u': case 'U':
	case 'n':
	    R_DEV__(bty) = cx;
	    break;
	default:
	    par_error(what);
	}
    }

    else if (streql(what, "cex")) {
#ifdef FOR_PAR
	lengthCheck(what, value, 1);
/* else: cex can be a vector of length > 1, so pick off first value
   (as e.g. pch always did) */
#endif
	x = asReal(value);
	posRealCheck(x, what);
#ifdef FOR_PAR
	R_DEV__(cex) = 1.0;
	R_DEV__(cexbase) = x;
#else
	R_DEV__(cex) = x; // not setting cexbase here
#endif
    }
    else if (streql(what, "cex.main")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	posRealCheck(x, what);
	R_DEV__(cexmain) = x;
    }
    else if (streql(what, "cex.lab")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	posRealCheck(x, what);
	R_DEV__(cexlab) = x;
    }
    else if (streql(what, "cex.sub")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	posRealCheck(x, what);
	R_DEV__(cexsub) = x;
    }
    else if (streql(what, "cex.axis")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	posRealCheck(x, what);
	R_DEV__(cexaxis) = x;
    }
    else if (streql(what, "col")) {
#ifdef FOR_PAR
	lengthCheck(what, value, 1);
#else
	if (!isVector(value) || LENGTH(value) < 1) par_error(what);
#endif
	R_DEV__(col) = RGBpar3(value, 0, dpptr(dd)->bg);
    }
    else if (streql(what, "col.main")) {
	lengthCheck(what, value, 1);
	R_DEV__(colmain) = RGBpar3(value, 0, dpptr(dd)->bg);
    }
    else if (streql(what, "col.lab")) {
	lengthCheck(what, value, 1);
	R_DEV__(collab) = RGBpar3(value, 0, dpptr(dd)->bg);
    }
    else if (streql(what, "col.sub")) {
	lengthCheck(what, value, 1);
	R_DEV__(colsub) = RGBpar3(value, 0, dpptr(dd)->bg);
    }
    else if (streql(what, "col.axis")) {
	lengthCheck(what, value, 1);
	R_DEV__(colaxis) = RGBpar3(value, 0, dpptr(dd)->bg);
    }
    else if (streql(what, "crt")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	naRealCheck(x, what);
	R_DEV__(crt) = x;
    }
    else if (streql(what, "err")) {
	lengthCheck(what, value, 1);	ix = asInteger(value);
	if (ix == 0 || ix == -1)
	    R_DEV__(err) = ix;
	else par_error(what);
    }
     else if (streql(what, "family")) {
	const char *ss;
	value = coerceVector(value, STRSXP);
        if (STRING_ELT(value, 0) == NA_STRING) {
            SET_STRING_ELT(value, 0, R_BlankString);
        }
	lengthCheck(what, value, 1);
	const void *vmax = vmaxget();
	ss = translateChar(STRING_ELT(value, 0));
	if(strlen(ss) > 200)
	    error(_("graphical parameter 'family' has a maximum length of 200 bytes"));
#ifdef FOR_PAR
	strncpy(dpptr(dd)->family, ss, 200);
	dpptr(dd)->family[200] = '\0';
#endif
	strncpy(gpptr(dd)->family, ss, 200);
	gpptr(dd)->family[200] = '\0';
	vmaxset(vmax);
    }
    else if (streql(what, "fg")) {
	lengthCheck(what, value, 1);
	ix = RGBpar3(value, 0, dpptr(dd)->bg);
#ifdef FOR_PAR
	/* par(fg=) sets BOTH "fg" and "col" */
	R_DEV__(col) = ix;
#endif
	R_DEV__(fg) = ix;
     }
     else if (streql(what, "font")) {
	lengthCheck(what, value, 1);	ix = asInteger(value);
	posIntCheck(ix, what);
	R_DEV__(font) = ix;
    }
    else if (streql(what, "font.main")) {
	lengthCheck(what, value, 1);	ix = asInteger(value);
	posIntCheck(ix, what);
	R_DEV__(fontmain) = ix;
    }
    else if (streql(what, "font.lab")) {
	lengthCheck(what, value, 1);	ix = asInteger(value);
	posIntCheck(ix, what);
	R_DEV__(fontlab) = ix;
    }
    else if (streql(what, "font.sub")) {
	lengthCheck(what, value, 1);	ix = asInteger(value);
	posIntCheck(ix, what);
	R_DEV__(fontsub) = ix;
    }
    else if (streql(what, "font.axis")) {
	lengthCheck(what, value, 1);	ix = asInteger(value);
	posIntCheck(ix, what);
	R_DEV__(fontaxis) = ix;
    }
    else if (streql(what, "lab")) {
	value = coerceVector(value, INTSXP);
	lengthCheck(what, value, 3);
	posIntCheck   (INTEGER(value)[0], what);
	posIntCheck   (INTEGER(value)[1], what);
	nonnegIntCheck(INTEGER(value)[2], what);
	R_DEV__(lab[0]) = INTEGER(value)[0];
	R_DEV__(lab[1]) = INTEGER(value)[1];
	R_DEV__(lab[2]) = INTEGER(value)[2];
    }
    else if (streql(what, "las")) {
	lengthCheck(what, value, 1);	ix = asInteger(value);
	if (0 <= ix && ix <= 3)
	    R_DEV__(las) = ix;
	else par_error(what);
    }
    else if (streql(what, "lend")) {
	lengthCheck(what, value, 1);
	R_DEV__(lend) = GE_LENDpar(value, 0);
    }
    else if (streql(what, "ljoin")) {
	lengthCheck(what, value, 1);
	R_DEV__(ljoin) = GE_LJOINpar(value, 0);
    }
    else if (streql(what, "lmitre")) {
	lengthCheck(what, value, 1);
	x = asReal(value);
	posRealCheck(x, what);
	if (x < 1)
	    par_error(what);
	R_DEV__(lmitre) = x;
    }
    else if (streql(what, "lty")) {
#ifdef FOR_PAR
	lengthCheck(what, value, 1);
#else
	if (!isVector(value) || LENGTH(value) < 1) par_error(what);
#endif
	R_DEV__(lty) = GE_LTYpar(value, 0);
    }
    else if (streql(what, "lwd")) {
#ifdef FOR_PAR
	lengthCheck(what, value, 1);
#else
	if (!isVector(value) || LENGTH(value) < 1) par_error(what);
#endif
	x = asReal(value);
	posRealCheck(x, what);
	R_DEV__(lwd) = x;
    }
    else if (streql(what, "mgp")) {
	PROTECT(value = coerceVector(value, REALSXP));
	lengthCheck(what, value, 3);
	/* Since 1.6.x: Allow negative (S-compatibly): */
	naRealCheck(REAL(value)[0], what);
	naRealCheck(REAL(value)[1], what);
	naRealCheck(REAL(value)[2], what);
	if(REAL(value)[0] * REAL(value)[1] < 0 ||
	   REAL(value)[0] * REAL(value)[2] < 0)
	    warning("`mgp[1:3]' are of differing sign");
	R_DEV__(mgp[0]) = REAL(value)[0];
	R_DEV__(mgp[1]) = REAL(value)[1];
	R_DEV__(mgp[2]) = REAL(value)[2];
	UNPROTECT(1);
    }
    else if (streql(what, "mkh")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	posRealCheck(x, what);
	R_DEV__(mkh) = x;
    }
    else if (streql(what, "pch")) {
#ifdef FOR_PAR
	lengthCheck(what, value, 1);
#else
	if (!isVector(value) || LENGTH(value) < 1) par_error(what);
#endif
	if (isString(value)) {
	    ix = GEstring_to_pch(STRING_ELT(value, 0));
	} else if (isNumeric(value)) {
	    ix = asInteger(value);
	} else par_error(what);
	if(ix == NA_INTEGER) par_error(what);
	R_DEV__(pch) = ix;
    }
    else if (streql(what, "smo")) {
	/* FIXME: not real */
	lengthCheck(what, value, 1);	x = asReal(value);
	nonnegRealCheck(x, what);
	R_DEV__(smo) = (int) x;
    }
    else if (streql(what, "srt")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	naRealCheck(x, what);
	R_DEV__(srt) = x;
    }

    /* NOTE: tck and tcl must be treated in parallel; if one is NA,
     *	the other must be non-NA.  If tcl is NA, then setting tck to NA
     *	will reset tck to its initial default value.  See also graphics.c. */
    else if (streql(what, "tck")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	R_DEV__(tck) = x;
	if (R_FINITE(x))
	    R_DEV__(tcl) = NA_REAL;
	else if(!R_FINITE(dpptr(dd)->tcl))
	    R_DEV__(tcl) = -0.5;
    }
    else if (streql(what, "tcl")) {
	lengthCheck(what, value, 1);	x = asReal(value);
	R_DEV__(tcl) = x;
	if (R_FINITE(x))
	    R_DEV__(tck) = NA_REAL;
	else if (!R_FINITE(dpptr(dd)->tck))
	    R_DEV__(tck) = -0.01; /* S Default -- was 0.02 till R 1.5.x */
    }
    else if (streql(what, "xaxp")) {
	value = coerceVector(value, REALSXP);
	lengthCheck(what, value, 3);
	naRealCheck(REAL(value)[0], what);
	naRealCheck(REAL(value)[1], what);
	if ((R_DEV__(xlog)))
	    logAxpCheck((int) (REAL(value)[2]), what);
	else
	    posIntCheck((int) (REAL(value)[2]), what);
	R_DEV__(xaxp[0]) = REAL(value)[0];
	R_DEV__(xaxp[1]) = REAL(value)[1];
	R_DEV__(xaxp[2]) = (int)(REAL(value)[2]);
    }
    else if (streql(what, "xaxs")) {
	if (!isString(value) || LENGTH(value) < 1)
	    par_error(what);
	cx = CHAR(STRING_ELT(value, 0))[0];
	if (cx == 's' || cx == 'e' || cx == 'i' || cx == 'r' || cx == 'd')
	    R_DEV__(xaxs) = cx;
	else par_error(what);
    }
    else if (streql(what, "xaxt")) {
	if (!isString(value) || LENGTH(value) < 1)
	    par_error(what);
	cx = CHAR(STRING_ELT(value, 0))[0];
	if (cx == 's' || cx == 'l' || cx == 't' || cx == 'n')
	    R_DEV__(xaxt) = cx;
	else par_error(what);
    }
    else if (streql(what, "xpd")) {
	lengthCheck(what, value, 1);
	ix = asInteger(value);
	if (ix == NA_INTEGER)
	    R_DEV__(xpd) = 2;
	else
	    R_DEV__(xpd) = (ix != 0);
    }
    else if (streql(what, "yaxp")) {
	value = coerceVector(value, REALSXP);
	lengthCheck(what, value, 3);
	naRealCheck(REAL(value)[0], what);
	naRealCheck(REAL(value)[1], what);
	if ((R_DEV__(ylog)))
	    logAxpCheck((int) (REAL(value)[2]), what);
	else
	    posIntCheck((int) (REAL(value)[2]), what);
	R_DEV__(yaxp[0]) = REAL(value)[0];
	R_DEV__(yaxp[1]) = REAL(value)[1];
	R_DEV__(yaxp[2]) = (int) (REAL(value)[2]);
    }
    else if (streql(what, "yaxs")) {
	if (!isString(value) || LENGTH(value) < 1)
	    par_error(what);
	cx = CHAR(STRING_ELT(value, 0))[0];
	if (cx == 's' || cx == 'e' || cx == 'i' || cx == 'r' || cx == 'd')
	    R_DEV__(yaxs) = cx;
	else par_error(what);
    }
    else if (streql(what, "yaxt")) {
	if (!isString(value) || LENGTH(value) < 1)
	    par_error(what);
	cx = CHAR(STRING_ELT(value, 0))[0];
	if (cx == 's' || cx == 'l' || cx == 't' || cx == 'n')
	    R_DEV__(yaxt) = cx;
	else par_error(what);
    }
