| /* |
| * R : A Computer Language for Statistical Data Analysis |
| * Copyright (C) 2001-3 Paul Murrell |
| * 2003-2016 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/ |
| */ |
| |
| #include "grid.h" |
| #include <math.h> |
| #include <float.h> |
| #include <string.h> |
| |
| int isUnitArithmetic(SEXP ua) { |
| return inherits(ua, "unit.arithmetic"); |
| } |
| |
| int isUnitList(SEXP ul) { |
| return inherits(ul, "unit.list"); |
| } |
| |
| /* Function to build a single-value unit SEXP internally. |
| * Cannot build units requiring data as yet. |
| */ |
| SEXP unit(double value, int unit) |
| { |
| SEXP u, units, classname; |
| PROTECT(u = ScalarReal(value)); |
| PROTECT(units = ScalarInteger(unit)); |
| /* NOTE that we do not set the "unit" attribute */ |
| setAttrib(u, install("valid.unit"), units); |
| setAttrib(u, install("data"), R_NilValue); |
| PROTECT(classname = mkString("unit")); |
| classgets(u, classname); |
| UNPROTECT(3); |
| return u; |
| } |
| |
| /* Accessor functions for unit objects |
| */ |
| |
| /* |
| * This is an attempt to extract a single numeric value from |
| * a unit. This is ONLY designed for use on "simple" units |
| * (i.e., NOT unitLists or unitArithmetics) |
| */ |
| double unitValue(SEXP unit, int index) { |
| /* Recycle values if necessary (used in unit arithmetic) |
| */ |
| int n = LENGTH(unit); |
| return numeric(unit, index % n); |
| } |
| |
| int unitUnit(SEXP unit, int index) { |
| SEXP units = getAttrib(unit, install("valid.unit")); |
| /* Recycle units if necessary |
| */ |
| int n = LENGTH(units); |
| return INTEGER(units)[index % n]; |
| } |
| |
| SEXP unitData(SEXP unit, int index) { |
| SEXP result; |
| SEXP data = getAttrib(unit, install("data")); |
| if (isNull(data)) |
| result = R_NilValue; |
| else if(TYPEOF(data) == VECSXP) { |
| /* Recycle data if necessary |
| */ |
| int n = LENGTH(data); |
| result = VECTOR_ELT(data, index % n); |
| } else { |
| warning("unit attribute 'data' is of incorrect type"); |
| return R_NilValue; |
| } |
| return result; |
| } |
| |
| /* Accessor functions for unit arithmetic object |
| */ |
| const char* fName(SEXP ua) { |
| return CHAR(STRING_ELT(getListElement(ua, "fname"), 0)); |
| } |
| |
| SEXP arg1(SEXP ua) { |
| return getListElement(ua, "arg1"); |
| } |
| |
| SEXP arg2(SEXP ua) { |
| return getListElement(ua, "arg2"); |
| } |
| |
| int fNameMatch(SEXP ua, char *aString) { |
| return !strcmp(fName(ua), aString); |
| } |
| |
| int addOp(SEXP ua) { |
| return fNameMatch(ua, "+"); |
| } |
| |
| int minusOp(SEXP ua) { |
| return fNameMatch(ua, "-"); |
| } |
| |
| int timesOp(SEXP ua) { |
| return fNameMatch(ua, "*"); |
| } |
| |
| int fOp(SEXP ua) { |
| return addOp(ua) || minusOp(ua) || timesOp(ua); |
| } |
| |
| int minFunc(SEXP ua) { |
| return fNameMatch(ua, "min"); |
| } |
| |
| int maxFunc(SEXP ua) { |
| return fNameMatch(ua, "max"); |
| } |
| |
| int sumFunc(SEXP ua) { |
| return fNameMatch(ua, "sum"); |
| } |
| |
| /* Functions in lattice.c should use this to determine the length |
| * of a unit/unitArithmetic object rather than just LENGTH. |
| */ |
| int unitLength(SEXP u) |
| { |
| int result = 0; |
| if (isUnitList(u)) { |
| result = LENGTH(u); |
| } else if (isUnitArithmetic(u)) { |
| if (fOp(u)) { |
| if (timesOp(u)) { |
| /* |
| * arg1 is always the numeric vector |
| */ |
| int n1 = LENGTH(arg1(u)); |
| int n2 = unitLength(arg2(u)); |
| result = (n1 > n2) ? n1 : n2; |
| } else { /* must be "+" or "-" */ |
| int n1 = unitLength(arg1(u)); |
| int n2 = unitLength(arg2(u)); |
| result = (n1 > n2) ? n1 : n2; |
| } |
| } else { /* must be "min" or "max" or "sum" */ |
| result = 1; /* unitLength(arg1(u)); */ |
| } |
| } else if (inherits(u, "unit")) { /* a "plain" unit object */ |
| result = LENGTH(u); |
| } else { |
| error(_("object is not a unit, unit.list, or unitArithmetic object")); |
| } |
| return result; |
| } |
| |
| |
| /************************** |
| * Code for handling "null" units |
| ************************** |
| */ |
| |
| /* Global mode indicators: |
| * The value returned for a "null" unit depends on ... |
| * (i) whether layout is calling for evaluation of a "pure null" unit |
| * (in which case, the value of the "null" unit is returned) |
| * (ii) the sort of arithmetic that is being performed |
| * (in which case, an "identity" value is returned) |
| */ |
| |
| /* |
| * Evaluate a "null" _value_ dependent on the evaluation context |
| */ |
| static double evaluateNullUnit(double value, double thisCM, |
| int nullLayoutMode, int nullArithmeticMode) { |
| double result = value; |
| if (!nullLayoutMode) |
| switch (nullArithmeticMode) { |
| case L_plain: |
| case L_adding: |
| case L_subtracting: |
| case L_summing: |
| result = 0; |
| break; |
| case L_multiplying: |
| result = 0; |
| break; |
| case L_maximising: |
| result = 0; |
| break; |
| case L_minimising: |
| result = thisCM; |
| break; |
| } |
| return result; |
| } |
| |
| /* |
| * Evaluate a "null" _unit_ |
| * This is used by layout code to get a single "null" _value_ |
| * from a pureNullUnit (which may be a unitList or a unitArithmetic) |
| * |
| * This must ONLY be called on a unit which has passed the |
| * pureNullUnit test below. |
| */ |
| double pureNullUnitValue(SEXP unit, int index) |
| { |
| double result = 0; |
| if (isUnitArithmetic(unit)) { |
| int i; |
| if (addOp(unit)) { |
| result = pureNullUnitValue(arg1(unit), index) + |
| pureNullUnitValue(arg2(unit), index); |
| } |
| else if (minusOp(unit)) { |
| result = pureNullUnitValue(arg1(unit), index) - |
| pureNullUnitValue(arg2(unit), index); |
| } |
| else if (timesOp(unit)) { |
| result = REAL(arg1(unit))[index] * |
| pureNullUnitValue(arg2(unit), index); |
| } |
| else if (minFunc(unit)) { |
| int n = unitLength(arg1(unit)); |
| double temp = DBL_MAX; |
| result = pureNullUnitValue(arg1(unit), 0); |
| for (i=1; i<n; i++) { |
| temp = pureNullUnitValue(arg1(unit), i); |
| if (temp < result) |
| result = temp; |
| } |
| } |
| else if (maxFunc(unit)) { |
| int n = unitLength(arg1(unit)); |
| double temp = DBL_MIN; |
| result = pureNullUnitValue(arg1(unit), 0); |
| for (i=1; i<n; i++) { |
| temp = pureNullUnitValue(arg1(unit), i); |
| if (temp > result) |
| result = temp; |
| } |
| } |
| else if (sumFunc(unit)) { |
| int n = unitLength(arg1(unit)); |
| result = 0.0; |
| for (i=0; i<n; i++) { |
| result += pureNullUnitValue(arg1(unit), i); |
| } |
| } |
| else |
| error(_("unimplemented unit function")); |
| } else if (isUnitList(unit)) { |
| /* |
| * Recycle if necessary; it is up to the calling code |
| * to limit indices to unit length if desired |
| */ |
| int n = unitLength(unit); |
| result = pureNullUnitValue(VECTOR_ELT(unit, index % n), 0); |
| } else |
| result = unitValue(unit, index); |
| return result; |
| } |
| |
| int pureNullUnitArithmetic(SEXP unit, int index, pGEDevDesc dd); |
| |
| int pureNullUnit(SEXP unit, int index, pGEDevDesc dd) { |
| int result; |
| if (isUnitArithmetic(unit)) |
| result = pureNullUnitArithmetic(unit, index, dd); |
| else if (isUnitList(unit)) { |
| /* |
| * Recycle if necessary; it is up to the calling code |
| * to limit indices to unit length if desired |
| */ |
| int n = unitLength(unit); |
| result = pureNullUnit(VECTOR_ELT(unit, index % n), 0, dd); |
| } else { /* Just a plain unit */ |
| /* Special case: if "grobwidth" or "grobheight" unit |
| * and width/height(grob) is pure null |
| */ |
| if (unitUnit(unit, index) == L_GROBWIDTH) { |
| SEXP grob, updatedgrob, width; |
| SEXP widthPreFn, widthFn, widthPostFn, findGrobFn; |
| SEXP R_fcall0, R_fcall1, R_fcall2, R_fcall3; |
| SEXP savedgpar, savedgrob; |
| /* |
| * The data could be a gPath to a grob |
| * In this case, need to find the grob first, and in order |
| * to do that correctly, need to call pre/postDraw code |
| */ |
| PROTECT(grob = unitData(unit, index)); |
| PROTECT(savedgpar = gridStateElement(dd, GSS_GPAR)); |
| PROTECT(savedgrob = gridStateElement(dd, GSS_CURRGROB)); |
| PROTECT(widthPreFn = findFun(install("preDraw"), |
| R_gridEvalEnv)); |
| PROTECT(widthFn = findFun(install("width"), R_gridEvalEnv)); |
| PROTECT(widthPostFn = findFun(install("postDraw"), |
| R_gridEvalEnv)); |
| if (inherits(grob, "gPath")) { |
| if (isNull(savedgrob)) { |
| PROTECT(findGrobFn = findFun(install("findGrobinDL"), |
| R_gridEvalEnv)); |
| PROTECT(R_fcall0 = lang2(findGrobFn, |
| getListElement(grob, "name"))); |
| grob = eval(R_fcall0, R_gridEvalEnv); |
| } else { |
| PROTECT(findGrobFn =findFun(install("findGrobinChildren"), |
| R_gridEvalEnv)); |
| PROTECT(R_fcall0 = lang3(findGrobFn, |
| getListElement(grob, "name"), |
| getListElement(savedgrob, |
| "children"))); |
| grob = eval(R_fcall0, R_gridEvalEnv); |
| } |
| UNPROTECT(2); |
| } |
| PROTECT(R_fcall1 = lang2(widthPreFn, grob)); |
| PROTECT(updatedgrob = eval(R_fcall1, R_gridEvalEnv)); |
| PROTECT(R_fcall2 = lang2(widthFn, updatedgrob)); |
| PROTECT(width = eval(R_fcall2, R_gridEvalEnv)); |
| result = pureNullUnit(width, 0, dd); |
| PROTECT(R_fcall3 = lang2(widthPostFn, updatedgrob)); |
| eval(R_fcall3, R_gridEvalEnv); |
| setGridStateElement(dd, GSS_GPAR, savedgpar); |
| setGridStateElement(dd, GSS_CURRGROB, savedgrob); |
| UNPROTECT(11); |
| } else if (unitUnit(unit, index) == L_GROBHEIGHT) { |
| SEXP grob, updatedgrob, height; |
| SEXP heightPreFn, heightFn, heightPostFn, findGrobFn; |
| SEXP R_fcall0, R_fcall1, R_fcall2, R_fcall3; |
| SEXP savedgpar, savedgrob; |
| /* |
| * The data could be a gPath to a grob |
| * In this case, need to find the grob first, and in order |
| * to do that correctly, need to call pre/postDraw code |
| */ |
| PROTECT(grob = unitData(unit, index)); |
| PROTECT(savedgpar = gridStateElement(dd, GSS_GPAR)); |
| PROTECT(savedgrob = gridStateElement(dd, GSS_CURRGROB)); |
| PROTECT(heightPreFn = findFun(install("preDraw"), |
| R_gridEvalEnv)); |
| PROTECT(heightFn = findFun(install("height"), R_gridEvalEnv)); |
| PROTECT(heightPostFn = findFun(install("postDraw"), |
| R_gridEvalEnv)); |
| if (inherits(grob, "gPath")) { |
| if (isNull(savedgrob)) { |
| PROTECT(findGrobFn = findFun(install("findGrobinDL"), |
| R_gridEvalEnv)); |
| PROTECT(R_fcall0 = lang2(findGrobFn, |
| getListElement(grob, "name"))); |
| grob = eval(R_fcall0, R_gridEvalEnv); |
| } else { |
| PROTECT(findGrobFn =findFun(install("findGrobinChildren"), |
| R_gridEvalEnv)); |
| PROTECT(R_fcall0 = lang3(findGrobFn, |
| getListElement(grob, "name"), |
| getListElement(savedgrob, |
| "children"))); |
| grob = eval(R_fcall0, R_gridEvalEnv); |
| } |
| UNPROTECT(2); |
| } |
| PROTECT(R_fcall1 = lang2(heightPreFn, grob)); |
| PROTECT(updatedgrob = eval(R_fcall1, R_gridEvalEnv)); |
| PROTECT(R_fcall2 = lang2(heightFn, updatedgrob)); |
| PROTECT(height = eval(R_fcall2, R_gridEvalEnv)); |
| result = pureNullUnit(height, 0, dd); |
| PROTECT(R_fcall3 = lang2(heightPostFn, updatedgrob)); |
| eval(R_fcall3, R_gridEvalEnv); |
| setGridStateElement(dd, GSS_GPAR, savedgpar); |
| setGridStateElement(dd, GSS_CURRGROB, savedgrob); |
| UNPROTECT(11); |
| } else |
| result = unitUnit(unit, index) == L_NULL; |
| } |
| return result; |
| } |
| |
| int pureNullUnitArithmetic(SEXP unit, int index, pGEDevDesc dd) { |
| /* |
| * Initialised to shut up compiler |
| */ |
| int result = 0; |
| if (addOp(unit) || minusOp(unit)) { |
| result = pureNullUnit(arg1(unit), index, dd) && |
| pureNullUnit(arg2(unit), index, dd); |
| } |
| else if (timesOp(unit)) { |
| result = pureNullUnit(arg2(unit), index, dd); |
| } |
| else if (minFunc(unit) || maxFunc(unit) || sumFunc(unit)) { |
| int n = unitLength(arg1(unit)); |
| int i = 0; |
| result = 1; |
| while (result && i<n) { |
| result = result && pureNullUnit(arg1(unit), i, dd); |
| i += 1; |
| } |
| } |
| else |
| error(_("unimplemented unit function")); |
| return result; |
| } |
| |
| /************************** |
| * Code for handling "grobwidth" units |
| ************************** |
| */ |
| |
| /* NOTE: this code calls back to R code to perform |
| * set.gpar operations, which will impact on grid state variables |
| * BUT that's ok(ish) because we save and restore the relevant state |
| * variables in here so that the overall effect is NULL. |
| * |
| * FIXME: OTOH, the calls back to R Code may also perform |
| * viewport operations. Again, we restore state as much as possible, |
| * but this can "pollute" the viewport tree in some cases. |
| */ |
| |
| double evaluateGrobUnit(double value, SEXP grob, |
| double vpwidthCM, double vpheightCM, |
| int nullLMode, int nullAMode, |
| /* |
| * Evaluation type |
| * 0 = x, 1 = y, 2 = width, 3 = height |
| */ |
| int evalType, |
| pGEDevDesc dd) |
| { |
| double vpWidthCM, vpHeightCM; |
| double rotationAngle; |
| LViewportContext vpc; |
| R_GE_gcontext gc; |
| LTransform transform, savedTransform; |
| SEXP currentvp, currentgp; |
| SEXP preFn, postFn, findGrobFn; |
| SEXP evalFnx = R_NilValue, evalFny = R_NilValue; |
| SEXP R_fcall0, R_fcall1, R_fcall2x, R_fcall2y, R_fcall3; |
| SEXP savedgpar, savedgrob, updatedgrob; |
| SEXP unitx = R_NilValue, unity = R_NilValue; |
| double result = 0.0; |
| Rboolean protectedGrob = FALSE; |
| /* |
| * We are just doing calculations, not drawing, so |
| * we don't want anything recorded on the graphics engine DL |
| * |
| * FIXME: This should probably be done via a GraphicsEngine.h |
| * function call rather than directly playing with dd->recordGraphics |
| */ |
| Rboolean record = dd->recordGraphics; |
| dd->recordGraphics = FALSE; |
| /* |
| * Save the current viewport transform |
| * (use to convert location relative to current viewport) |
| */ |
| currentvp = gridStateElement(dd, GSS_VP); |
| getViewportTransform(currentvp, dd, |
| &vpWidthCM, &vpHeightCM, |
| savedTransform, &rotationAngle); |
| /* |
| * Save the current gpar state and restore it at the end |
| */ |
| PROTECT(savedgpar = gridStateElement(dd, GSS_GPAR)); |
| /* |
| * Save the current grob and restore it at the end |
| */ |
| PROTECT(savedgrob = gridStateElement(dd, GSS_CURRGROB)); |
| /* |
| * Set up for calling R functions |
| */ |
| PROTECT(preFn = findFun(install("preDraw"), R_gridEvalEnv)); |
| switch(evalType) { |
| case 0: |
| case 1: |
| PROTECT(evalFnx = findFun(install("xDetails"), R_gridEvalEnv)); |
| PROTECT(evalFny = findFun(install("yDetails"), R_gridEvalEnv)); |
| break; |
| case 2: |
| PROTECT(evalFnx = findFun(install("width"), R_gridEvalEnv)); |
| break; |
| case 3: |
| PROTECT(evalFny = findFun(install("height"), R_gridEvalEnv)); |
| break; |
| case 4: |
| PROTECT(evalFny = findFun(install("ascentDetails"), R_gridEvalEnv)); |
| break; |
| case 5: |
| PROTECT(evalFny = findFun(install("descentDetails"), R_gridEvalEnv)); |
| break; |
| } |
| PROTECT(postFn = findFun(install("postDraw"), R_gridEvalEnv)); |
| /* |
| * If grob is actually a gPath, use it to find an actual grob |
| */ |
| if (inherits(grob, "gPath")) { |
| /* |
| * If the current grob is NULL then we are at the top level |
| * and we search the display list, otherwise we search the |
| * children of the current grob |
| * |
| * NOTE: assume here that only gPath of depth == 1 are valid |
| */ |
| if (isNull(savedgrob)) { |
| PROTECT(findGrobFn = findFun(install("findGrobinDL"), |
| R_gridEvalEnv)); |
| PROTECT(R_fcall0 = lang2(findGrobFn, |
| getListElement(grob, "name"))); |
| PROTECT(grob = eval(R_fcall0, R_gridEvalEnv)); |
| } else { |
| PROTECT(findGrobFn = findFun(install("findGrobinChildren"), |
| R_gridEvalEnv)); |
| PROTECT(R_fcall0 = lang3(findGrobFn, |
| getListElement(grob, "name"), |
| getListElement(savedgrob, "children"))); |
| PROTECT(grob = eval(R_fcall0, R_gridEvalEnv)); |
| } |
| /* |
| * Flag to make sure we UNPROTECT these at the end |
| */ |
| protectedGrob = TRUE; |
| } |
| /* Call preDraw(grob) |
| */ |
| PROTECT(R_fcall1 = lang2(preFn, grob)); |
| PROTECT(updatedgrob = eval(R_fcall1, R_gridEvalEnv)); |
| /* |
| * The call to preDraw may have pushed viewports and/or |
| * enforced gpar settings, SO we need to re-establish the |
| * current viewport and gpar settings before evaluating the |
| * width unit. |
| * |
| * NOTE: we are really relying on the grid state to be coherent |
| * when we do stuff like this (i.e., not to have changed since |
| * we started evaluating the unit [other than the changes we may |
| * have deliberately made above by calling preDraw]). In other |
| * words we are relying on no other drawing occurring at the |
| * same time as we are doing this evaluation. In other other |
| * words, we are relying on there being only ONE process |
| * (i.e., NOT multi-threaded). |
| */ |
| currentvp = gridStateElement(dd, GSS_VP); |
| currentgp = gridStateElement(dd, GSS_GPAR); |
| getViewportTransform(currentvp, dd, |
| &vpWidthCM, &vpHeightCM, |
| transform, &rotationAngle); |
| fillViewportContextFromViewport(currentvp, &vpc); |
| /* Call whatever(grob) |
| * to get the unit representing the x/y/width/height |
| */ |
| switch (evalType) { |
| case 0: |
| case 1: |
| /* |
| * When evaluating grobX/grobY, the value of the unit |
| * is an angle that gets passed to xDetails/yDetails |
| */ |
| { |
| SEXP val; |
| PROTECT(val = ScalarReal(value)); |
| PROTECT(R_fcall2x = lang3(evalFnx, updatedgrob, val)); |
| PROTECT(unitx = eval(R_fcall2x, R_gridEvalEnv)); |
| PROTECT(R_fcall2y = lang3(evalFny, updatedgrob, val)); |
| PROTECT(unity = eval(R_fcall2y, R_gridEvalEnv)); |
| } |
| break; |
| case 2: |
| PROTECT(R_fcall2x = lang2(evalFnx, updatedgrob)); |
| PROTECT(unitx = eval(R_fcall2x, R_gridEvalEnv)); |
| break; |
| case 3: |
| case 4: |
| case 5: |
| PROTECT(R_fcall2y = lang2(evalFny, updatedgrob)); |
| PROTECT(unity = eval(R_fcall2y, R_gridEvalEnv)); |
| break; |
| } |
| /* |
| * Transform the unit |
| * NOTE: We transform into INCHES so can produce final answer in terms |
| * of NPC for original context |
| */ |
| /* Special case for "null" units |
| */ |
| gcontextFromgpar(currentgp, 0, &gc, dd); |
| switch(evalType) { |
| case 0: |
| case 1: |
| if (evalType && pureNullUnit(unity, 0, dd)) { |
| result = evaluateNullUnit(pureNullUnitValue(unity, 0), |
| vpWidthCM, |
| nullLMode, nullAMode); |
| } else if (pureNullUnit(unitx, 0, dd)) { |
| result = evaluateNullUnit(pureNullUnitValue(unitx, 0), |
| vpWidthCM, |
| nullLMode, nullAMode); |
| } else { |
| /* |
| * Transform to device (to allow for viewports in grob) |
| * then adjust relative to current viewport. |
| */ |
| double xx, yy; |
| LLocation lin, lout; |
| LTransform invt; |
| invTransform(savedTransform, invt); |
| transformLocn(unitx, unity, 0, |
| vpc, &gc, |
| vpWidthCM, vpHeightCM, dd, |
| transform, &xx, &yy); |
| location(xx, yy, lin); |
| trans(lin, invt, lout); |
| xx = locationX(lout); |
| yy = locationY(lout); |
| if (evalType) |
| result = yy; |
| else |
| result = xx; |
| } |
| break; |
| case 2: |
| if (pureNullUnit(unitx, 0, dd)) { |
| result = evaluateNullUnit(pureNullUnitValue(unitx, 0), |
| vpWidthCM, |
| nullLMode, nullAMode); |
| } else { |
| result = transformWidthtoINCHES(unitx, 0, vpc, &gc, |
| vpWidthCM, vpHeightCM, |
| dd); |
| } |
| break; |
| case 3: |
| case 4: |
| case 5: |
| if (pureNullUnit(unity, 0, dd)) { |
| result = evaluateNullUnit(pureNullUnitValue(unity, 0), |
| vpWidthCM, |
| nullLMode, nullAMode); |
| } else { |
| result = transformHeighttoINCHES(unity, 0, vpc, &gc, |
| vpWidthCM, vpHeightCM, |
| dd); |
| } |
| break; |
| } |
| /* Call postDraw(grob) |
| */ |
| PROTECT(R_fcall3 = lang2(postFn, updatedgrob)); |
| eval(R_fcall3, R_gridEvalEnv); |
| /* |
| * Restore the saved gpar state and grob |
| */ |
| setGridStateElement(dd, GSS_GPAR, savedgpar); |
| setGridStateElement(dd, GSS_CURRGROB, savedgrob); |
| if (protectedGrob) |
| UNPROTECT(3); |
| switch(evalType) { |
| case 0: |
| case 1: |
| UNPROTECT(14); |
| break; |
| case 2: |
| case 3: |
| case 4: |
| case 5: |
| UNPROTECT(10); |
| } |
| /* Return the transformed width |
| */ |
| /* |
| * If there is an error or user-interrupt in the above |
| * evaluation, dd->recordGraphics is set to TRUE |
| * on all graphics devices (see GEonExit(); called in errors.c) |
| */ |
| dd->recordGraphics = record; |
| return result; |
| } |
| |
| double evaluateGrobXUnit(double value, SEXP grob, |
| double vpheightCM, double vpwidthCM, |
| int nullLMode, int nullAMode, |
| pGEDevDesc dd) |
| { |
| return evaluateGrobUnit(value, grob, vpheightCM, vpwidthCM, |
| nullLMode, nullAMode, 0, dd); |
| } |
| |
| double evaluateGrobYUnit(double value, SEXP grob, |
| double vpheightCM, double vpwidthCM, |
| int nullLMode, int nullAMode, |
| pGEDevDesc dd) |
| { |
| return evaluateGrobUnit(value, grob, vpheightCM, vpwidthCM, |
| nullLMode, nullAMode, 1, dd); |
| } |
| |
| double evaluateGrobWidthUnit(SEXP grob, |
| double vpheightCM, double vpwidthCM, |
| int nullLMode, int nullAMode, |
| pGEDevDesc dd) |
| { |
| return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, |
| nullLMode, nullAMode, 2, dd); |
| } |
| |
| double evaluateGrobHeightUnit(SEXP grob, |
| double vpheightCM, double vpwidthCM, |
| int nullLMode, int nullAMode, |
| pGEDevDesc dd) |
| { |
| return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, |
| nullLMode, nullAMode, 3, dd); |
| } |
| |
| double evaluateGrobAscentUnit(SEXP grob, |
| double vpheightCM, double vpwidthCM, |
| int nullLMode, int nullAMode, |
| pGEDevDesc dd) |
| { |
| return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, |
| nullLMode, nullAMode, 4, dd); |
| } |
| |
| double evaluateGrobDescentUnit(SEXP grob, |
| double vpheightCM, double vpwidthCM, |
| int nullLMode, int nullAMode, |
| pGEDevDesc dd) |
| { |
| return evaluateGrobUnit(1, grob, vpheightCM, vpwidthCM, |
| nullLMode, nullAMode, 5, dd); |
| } |
| |
| /************************** |
| * TRANSFORMATIONS |
| ************************** |
| */ |
| |
| /* Map a value from arbitrary units to INCHES */ |
| |
| /* |
| * NULL units are a special case |
| * If L_nullLayoutMode = 1 then the value returned is a NULL unit value |
| * Otherwise it is an INCHES value |
| */ |
| double transform(double value, int unit, SEXP data, |
| double scalemin, double scalemax, |
| const pGEcontext gc, |
| double thisCM, double otherCM, |
| int nullLMode, int nullAMode, pGEDevDesc dd) |
| { |
| double asc, dsc, wid; |
| double result = value; |
| switch (unit) { |
| case L_NPC: |
| result = (result * thisCM)/2.54; /* 2.54 cm per inch */ |
| break; |
| case L_CM: |
| result = result/2.54; |
| break; |
| case L_INCHES: |
| break; |
| /* FIXME: The following two assume that the pointsize specified |
| * by the user is actually the pointsize provided by the |
| * device. This is NOT a safe assumption |
| * One possibility would be to do a call to GReset(), just so |
| * that mapping() gets called, just so that things like |
| * xNDCPerLine are up-to-date, THEN call GStrHeight("M") |
| * or somesuch. |
| */ |
| case L_CHAR: |
| case L_MYCHAR: /* FIXME: Remove this when I can */ |
| result = (result * gc->ps * gc->cex)/72; /* 72 points per inch */ |
| break; |
| case L_LINES: |
| case L_MYLINES: /* FIXME: Remove this when I can */ |
| result = (result * gc->ps * gc->cex * gc->lineheight)/72; |
| break; |
| case L_SNPC: |
| if (thisCM <= otherCM) |
| result = (result * thisCM)/2.54; |
| else |
| result = (result * otherCM)/2.54; |
| break; |
| case L_MM: |
| result = (result/10)/2.54; |
| break; |
| /* Maybe an opportunity for some constants below here (!) |
| */ |
| case L_POINTS: |
| result = result/72.27; |
| break; |
| case L_PICAS: |
| result = (result*12)/72.27; |
| break; |
| case L_BIGPOINTS: |
| result = result/72; |
| break; |
| case L_DIDA: |
| result = result/1157*1238/72.27; |
| break; |
| case L_CICERO: |
| result = result*12/1157*1238/72.27; |
| break; |
| case L_SCALEDPOINTS: |
| result = result/65536/72.27; |
| break; |
| case L_STRINGWIDTH: |
| case L_MYSTRINGWIDTH: /* FIXME: Remove this when I can */ |
| if (isExpression(data)) |
| result = result* |
| fromDeviceWidth(GEExpressionWidth(VECTOR_ELT(data, 0), gc, dd), |
| GE_INCHES, dd); |
| else |
| result = result* |
| fromDeviceWidth(GEStrWidth(CHAR(STRING_ELT(data, 0)), |
| getCharCE(STRING_ELT(data, 0)), |
| gc, dd), |
| GE_INCHES, dd); |
| break; |
| case L_STRINGHEIGHT: |
| case L_MYSTRINGHEIGHT: /* FIXME: Remove this when I can */ |
| if (isExpression(data)) |
| result = result* |
| fromDeviceHeight(GEExpressionHeight(VECTOR_ELT(data, 0), |
| gc, dd), |
| GE_INCHES, dd); |
| else |
| /* FIXME: what encoding is this? */ |
| result = result* |
| fromDeviceHeight(GEStrHeight(CHAR(STRING_ELT(data, 0)), -1, |
| gc, dd), |
| GE_INCHES, dd); |
| break; |
| case L_STRINGASCENT: |
| if (isExpression(data)) |
| GEExpressionMetric(VECTOR_ELT(data, 0), gc, |
| &asc, &dsc, &wid, |
| dd); |
| else |
| GEStrMetric(CHAR(STRING_ELT(data, 0)), |
| getCharCE(STRING_ELT(data, 0)), gc, |
| &asc, &dsc, &wid, |
| dd); |
| result = result*fromDeviceHeight(asc, GE_INCHES, dd); |
| break; |
| case L_STRINGDESCENT: |
| if (isExpression(data)) |
| GEExpressionMetric(VECTOR_ELT(data, 0), gc, |
| &asc, &dsc, &wid, |
| dd); |
| else |
| GEStrMetric(CHAR(STRING_ELT(data, 0)), |
| getCharCE(STRING_ELT(data, 0)), gc, |
| &asc, &dsc, &wid, |
| dd); |
| result = result*fromDeviceHeight(dsc, GE_INCHES, dd); |
| break; |
| case L_GROBX: |
| result = evaluateGrobXUnit(value, data, thisCM, otherCM, |
| nullLMode, nullAMode, dd); |
| break; |
| case L_GROBY: |
| result = evaluateGrobYUnit(value, data, otherCM, thisCM, |
| nullLMode, nullAMode, dd); |
| break; |
| case L_GROBWIDTH: |
| result = value*evaluateGrobWidthUnit(data, thisCM, otherCM, |
| nullLMode, nullAMode, dd); |
| break; |
| case L_GROBHEIGHT: |
| result = value*evaluateGrobHeightUnit(data, otherCM, thisCM, |
| nullLMode, nullAMode, dd); |
| break; |
| case L_GROBASCENT: |
| result = value*evaluateGrobAscentUnit(data, otherCM, thisCM, |
| nullLMode, nullAMode, dd); |
| break; |
| case L_GROBDESCENT: |
| result = value*evaluateGrobDescentUnit(data, otherCM, thisCM, |
| nullLMode, nullAMode, dd); |
| break; |
| case L_NULL: |
| result = evaluateNullUnit(result, thisCM, nullLMode, nullAMode); |
| break; |
| default: |
| error(_("invalid unit or unit not yet implemented")); |
| } |
| /* |
| * For physical units, scale the result by GSS_SCALE (a "zoom" factor) |
| */ |
| switch (unit) { |
| case L_INCHES: |
| case L_CM: |
| case L_MM: |
| case L_POINTS: |
| case L_PICAS: |
| case L_BIGPOINTS: |
| case L_DIDA: |
| case L_CICERO: |
| case L_SCALEDPOINTS: |
| result = result * REAL(gridStateElement(dd, GSS_SCALE))[0]; |
| break; |
| default: |
| /* |
| * No need to scale relative coordinates (NPC, NATIVE, NULL) |
| * CHAR and LINES already scaled because of scaling in gcontextFromGPar() |
| * Ditto STRINGWIDTH/HEIGHT |
| * GROBWIDTH/HEIGHT recurse into here so scaling already done |
| */ |
| break; |
| } |
| return result; |
| } |
| |
| /* FIXME: scales are only linear at the moment */ |
| double transformLocation(double location, int unit, SEXP data, |
| double scalemin, double scalemax, |
| const pGEcontext gc, |
| double thisCM, double otherCM, |
| int nullLMode, int nullAMode, pGEDevDesc dd) |
| { |
| double result = location; |
| switch (unit) { |
| case L_NATIVE: |
| /* It is invalid to create a viewport with identical limits on scale |
| * so we are protected from divide-by-zero |
| */ |
| result = ((result - scalemin)/(scalemax - scalemin))*thisCM/2.54; |
| break; |
| default: |
| result = transform(location, unit, data, scalemin, scalemax, |
| gc, thisCM, otherCM, nullLMode, nullAMode, dd); |
| } |
| return result; |
| } |
| |
| double transformXArithmetic(SEXP x, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd); |
| |
| double transformX(SEXP x, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, int nullAMode, pGEDevDesc dd) |
| { |
| double result; |
| int unit; |
| SEXP data; |
| if (isUnitArithmetic(x)) |
| result = transformXArithmetic(x, index, vpc, gc, |
| widthCM, heightCM, nullLMode, dd); |
| else if (isUnitList(x)) { |
| int n = unitLength(x); |
| result = transformX(VECTOR_ELT(x, index % n), 0, vpc, gc, |
| widthCM, heightCM, nullLMode, nullAMode, dd); |
| } else { /* Just a plain unit */ |
| int nullamode; |
| if (nullAMode == 0) |
| nullamode = L_plain; |
| else |
| nullamode = nullAMode; |
| result = unitValue(x, index); |
| unit = unitUnit(x, index); |
| PROTECT(data = unitData(x, index)); |
| result = transformLocation(result, unit, data, |
| vpc.xscalemin, vpc.xscalemax, gc, |
| widthCM, heightCM, |
| nullLMode, |
| nullamode, |
| dd); |
| UNPROTECT(1); |
| } |
| return result; |
| } |
| |
| double transformYArithmetic(SEXP y, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd); |
| |
| double transformY(SEXP y, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, int nullAMode, pGEDevDesc dd) |
| { |
| double result; |
| int unit; |
| SEXP data; |
| if (isUnitArithmetic(y)) |
| result = transformYArithmetic(y, index, vpc, gc, |
| widthCM, heightCM, nullLMode, dd); |
| else if (isUnitList(y)) { |
| int n = unitLength(y); |
| result = transformY(VECTOR_ELT(y, index % n), 0, vpc, gc, |
| widthCM, heightCM, nullLMode, nullAMode, dd); |
| } else { /* Just a unit object */ |
| int nullamode; |
| if (nullAMode == 0) |
| nullamode = L_plain; |
| else |
| nullamode = nullAMode; |
| result = unitValue(y, index); |
| unit = unitUnit(y, index); |
| PROTECT(data = unitData(y, index)); |
| result = transformLocation(result, unit, data, |
| vpc.yscalemin, vpc.yscalemax, gc, |
| heightCM, widthCM, |
| nullLMode, |
| nullamode, |
| dd); |
| UNPROTECT(1); |
| } |
| return result; |
| } |
| |
| double transformDimension(double dim, int unit, SEXP data, |
| double scalemin, double scalemax, |
| const pGEcontext gc, |
| double thisCM, double otherCM, |
| int nullLMode, int nullAMode, |
| pGEDevDesc dd) |
| { |
| double result = dim; |
| switch (unit) { |
| case L_NATIVE: |
| /* It is invalid to create a viewport with identical limits on scale |
| * so we are protected from divide-by-zero |
| */ |
| result = ((dim)/(scalemax - scalemin))*thisCM/2.54; |
| break; |
| default: |
| result = transform(dim, unit, data, scalemin, scalemax, gc, |
| thisCM, otherCM, nullLMode, nullAMode, dd); |
| } |
| return result; |
| } |
| |
| double transformWidthArithmetic(SEXP width, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd); |
| |
| double transformWidth(SEXP width, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, int nullAMode, pGEDevDesc dd) |
| { |
| double result; |
| int unit; |
| SEXP data; |
| if (isUnitArithmetic(width)) |
| result = transformWidthArithmetic(width, index, vpc, gc, |
| widthCM, heightCM, nullLMode, dd); |
| else if (isUnitList(width)) { |
| int n = unitLength(width); |
| result = transformWidth(VECTOR_ELT(width, index % n), 0, vpc, gc, |
| widthCM, heightCM, nullLMode, nullAMode, dd); |
| } else { /* Just a unit object */ |
| int nullamode; |
| if (nullAMode == 0) |
| nullamode = L_plain; |
| else |
| nullamode = nullAMode; |
| result = unitValue(width, index); |
| unit = unitUnit(width, index); |
| PROTECT(data = unitData(width, index)); |
| result = transformDimension(result, unit, data, |
| vpc.xscalemin, vpc.xscalemax, gc, |
| widthCM, heightCM, |
| nullLMode, |
| nullamode, |
| dd); |
| UNPROTECT(1); |
| } |
| return result; |
| } |
| |
| double transformHeightArithmetic(SEXP height, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd); |
| |
| double transformHeight(SEXP height, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, int nullAMode, pGEDevDesc dd) |
| { |
| double result; |
| int unit; |
| SEXP data; |
| if (isUnitArithmetic(height)) |
| result = transformHeightArithmetic(height, index, vpc, gc, |
| widthCM, heightCM, nullLMode, dd); |
| else if (isUnitList(height)) { |
| int n = unitLength(height); |
| result = transformHeight(VECTOR_ELT(height, index % n), 0, vpc, gc, |
| widthCM, heightCM, nullLMode, nullAMode, dd); |
| } else { /* Just a unit object */ |
| int nullamode; |
| if (nullAMode == 0) |
| nullamode = L_plain; |
| else |
| nullamode = nullAMode; |
| result = unitValue(height, index); |
| unit = unitUnit(height, index); |
| PROTECT(data = unitData(height, index)); |
| result = transformDimension(result, unit, data, |
| vpc.yscalemin, vpc.yscalemax, gc, |
| heightCM, widthCM, |
| nullLMode, |
| nullamode, |
| dd); |
| UNPROTECT(1); |
| } |
| return result; |
| } |
| |
| double transformXArithmetic(SEXP x, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd) |
| { |
| int i; |
| double result = 0; |
| if (addOp(x)) { |
| result = transformX(arg1(x), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd) + |
| transformX(arg2(x), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd); |
| } |
| else if (minusOp(x)) { |
| result = transformX(arg1(x), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd) - |
| transformX(arg2(x), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd); |
| } |
| else if (timesOp(x)) { |
| result = REAL(arg1(x))[index % LENGTH(arg1(x))] * |
| transformX(arg2(x), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_multiplying, dd); |
| } |
| else if (minFunc(x)) { |
| int n = unitLength(arg1(x)); |
| double temp = DBL_MAX; |
| result = transformX(arg1(x), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformX(arg1(x), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| if (temp < result) |
| result = temp; |
| } |
| } |
| else if (maxFunc(x)) { |
| int n = unitLength(arg1(x)); |
| double temp = DBL_MIN; |
| result = transformX(arg1(x), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformX(arg1(x), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| if (temp > result) |
| result = temp; |
| } |
| } |
| else if (sumFunc(x)) { |
| int n = unitLength(arg1(x)); |
| result = 0.0; |
| for (i=0; i<n; i++) { |
| result += transformX(arg1(x), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_summing, dd); |
| } |
| } |
| else |
| error(_("unimplemented unit function")); |
| return result; |
| } |
| |
| double transformYArithmetic(SEXP y, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd) |
| { |
| int i; |
| double result = 0; |
| if (addOp(y)) { |
| result = transformY(arg1(y), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd) + |
| transformY(arg2(y), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd); |
| } |
| else if (minusOp(y)) { |
| result = transformY(arg1(y), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd) - |
| transformY(arg2(y), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd); |
| } |
| else if (timesOp(y)) { |
| result = REAL(arg1(y))[index % LENGTH(arg1(y))] * |
| transformY(arg2(y), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_multiplying, dd); |
| } |
| else if (minFunc(y)) { |
| int n = unitLength(arg1(y)); |
| double temp = DBL_MAX; |
| result = transformY(arg1(y), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformY(arg1(y), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| if (temp < result) |
| result = temp; |
| } |
| } |
| else if (maxFunc(y)) { |
| int n = unitLength(arg1(y)); |
| double temp = DBL_MIN; |
| result = transformY(arg1(y), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformY(arg1(y), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| if (temp > result) |
| result = temp; |
| } |
| } |
| else if (sumFunc(y)) { |
| int n = unitLength(arg1(y)); |
| result = 0.0; |
| for (i=0; i<n; i++) { |
| result += transformY(arg1(y), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_summing, dd); |
| } |
| } |
| else |
| error(_("unimplemented unit function")); |
| return result; |
| } |
| |
| double transformWidthArithmetic(SEXP width, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd) |
| { |
| int i; |
| double result = 0; |
| if (addOp(width)) { |
| result = transformWidth(arg1(width), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd) + |
| transformWidth(arg2(width), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd); |
| } |
| else if (minusOp(width)) { |
| result = transformWidth(arg1(width), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd) - |
| transformWidth(arg2(width), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd); |
| } |
| else if (timesOp(width)) { |
| result = REAL(arg1(width))[index % LENGTH(arg1(width))] * |
| transformWidth(arg2(width), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_multiplying, dd); |
| } |
| else if (minFunc(width)) { |
| int n = unitLength(arg1(width)); |
| double temp = DBL_MAX; |
| result = transformWidth(arg1(width), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformWidth(arg1(width), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| if (temp < result) |
| result = temp; |
| } |
| } |
| else if (maxFunc(width)) { |
| int n = unitLength(arg1(width)); |
| double temp = DBL_MIN; |
| result = transformWidth(arg1(width), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformWidth(arg1(width), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| if (temp > result) |
| result = temp; |
| } |
| } |
| else if (sumFunc(width)) { |
| int n = unitLength(arg1(width)); |
| result = 0.0; |
| for (i=0; i<n; i++) { |
| result += transformWidth(arg1(width), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_summing, dd); |
| } |
| } |
| else |
| error(_("unimplemented unit function")); |
| return result; |
| } |
| |
| double transformHeightArithmetic(SEXP height, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| int nullLMode, pGEDevDesc dd) |
| { |
| int i; |
| double result = 0; |
| if (addOp(height)) { |
| result = transformHeight(arg1(height), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd) + |
| transformHeight(arg2(height), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_adding, |
| dd); |
| } |
| else if (minusOp(height)) { |
| result = transformHeight(arg1(height), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd) - |
| transformHeight(arg2(height), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_subtracting, |
| dd); |
| } |
| else if (timesOp(height)) { |
| result = REAL(arg1(height))[index % LENGTH(arg1(height))] * |
| transformHeight(arg2(height), index, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_multiplying, dd); |
| } |
| else if (minFunc(height)) { |
| int n = unitLength(arg1(height)); |
| double temp = DBL_MAX; |
| result = transformHeight(arg1(height), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformHeight(arg1(height), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_minimising, |
| dd); |
| if (temp < result) |
| result = temp; |
| } |
| } |
| else if (maxFunc(height)) { |
| int n = unitLength(arg1(height)); |
| double temp = DBL_MIN; |
| result = transformHeight(arg1(height), 0, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| for (i=1; i<n; i++) { |
| temp = transformHeight(arg1(height), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_maximising, |
| dd); |
| if (temp > result) |
| result = temp; |
| } |
| } |
| else if (sumFunc(height)) { |
| int n = unitLength(arg1(height)); |
| result = 0.0; |
| for (i=0; i<n; i++) { |
| result += transformHeight(arg1(height), i, vpc, gc, |
| widthCM, heightCM, |
| nullLMode, L_summing, dd); |
| } |
| } |
| else |
| error(_("unimplemented unit function")); |
| return result; |
| } |
| |
| /* Code for transforming a location in INCHES using a transformation matrix. |
| * We work in INCHES so that rotations can be incorporated within the |
| * transformation matrix (i.e., the units are the same in both x- and |
| * y-directions). |
| * INCHES rather than CM because the R graphics engine only has INCHES. |
| */ |
| |
| /* The original transform[X | Y | Width | Height] functions |
| * were written to transform to NPC. Rather than muck with them, |
| * I am just wrappering them to get the new transformation to INCHES |
| * In other words, the reason for the apparent inefficiency here |
| * is historical. |
| */ |
| |
| /* It is even more inefficient-looking now because I ended up mucking |
| * with transform() to return INCHES (to fix bug if width/heightCM == 0) |
| * and by then there was too much code that called transformXtoINCHES |
| * to be bothered changing calls to it |
| */ |
| |
| /* The difference between transform*toINCHES and transformLocn/Dimn |
| * is that the former are just converting from one coordinate system |
| * to INCHES; the latter are converting from INCHES relative to |
| * the parent to INCHES relative to the device. |
| */ |
| double transformXtoINCHES(SEXP x, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| pGEDevDesc dd) |
| { |
| return transformX(x, index, vpc, gc, |
| widthCM, heightCM, 0, 0, dd); |
| } |
| |
| double transformYtoINCHES(SEXP y, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| pGEDevDesc dd) |
| { |
| return transformY(y, index, vpc, gc, |
| widthCM, heightCM, 0, 0, dd); |
| } |
| |
| void transformLocn(SEXP x, SEXP y, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| pGEDevDesc dd, |
| LTransform t, |
| double *xx, double *yy) |
| { |
| LLocation lin, lout; |
| /* x and y are unit objects (i.e., values in any old coordinate |
| * system) so the first step is to convert them both to CM |
| */ |
| *xx = transformXtoINCHES(x, index, vpc, gc, |
| widthCM, heightCM, dd); |
| *yy = transformYtoINCHES(y, index, vpc, gc, |
| widthCM, heightCM, dd); |
| location(*xx, *yy, lin); |
| trans(lin, t, lout); |
| *xx = locationX(lout); |
| *yy = locationY(lout); |
| } |
| |
| double transformWidthtoINCHES(SEXP w, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| pGEDevDesc dd) |
| { |
| return transformWidth(w, index, vpc, gc, |
| widthCM, heightCM, 0, 0, dd); |
| } |
| |
| double transformHeighttoINCHES(SEXP h, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| pGEDevDesc dd) |
| { |
| return transformHeight(h, index, vpc, gc, |
| widthCM, heightCM, 0, 0, dd); |
| } |
| |
| void transformDimn(SEXP w, SEXP h, int index, |
| LViewportContext vpc, |
| const pGEcontext gc, |
| double widthCM, double heightCM, |
| pGEDevDesc dd, |
| double rotationAngle, |
| double *ww, double *hh) |
| { |
| LLocation din, dout; |
| LTransform r; |
| *ww = transformWidthtoINCHES(w, index, vpc, gc, |
| widthCM, heightCM, dd); |
| *hh = transformHeighttoINCHES(h, index, vpc, gc, |
| widthCM, heightCM, dd); |
| location(*ww, *hh, din); |
| rotation(rotationAngle, r); |
| trans(din, r, dout); |
| *ww = locationX(dout); |
| *hh = locationY(dout); |
| } |
| |
| /* |
| * **************************** |
| * Inverse Transformations |
| * **************************** |
| */ |
| |
| /* |
| * Take a value in inches within the viewport and convert to some |
| * other coordinate system |
| */ |
| |
| double transformFromINCHES(double value, int unit, |
| const pGEcontext gc, |
| double thisCM, double otherCM, |
| pGEDevDesc dd) |
| { |
| /* |
| * Convert to NPC |
| */ |
| double result = value; |
| switch (unit) { |
| case L_NPC: |
| result = result/(thisCM/2.54); |
| break; |
| case L_CM: |
| result = result*2.54; |
| break; |
| case L_INCHES: |
| break; |
| /* FIXME: The following two assume that the pointsize specified |
| * by the user is actually the pointsize provided by the |
| * device. This is NOT a safe assumption |
| * One possibility would be to do a call to GReset(), just so |
| * that mapping() gets called, just so that things like |
| * xNDCPerLine are up-to-date, THEN call GStrHeight("M") |
| * or somesuch. |
| */ |
| case L_CHAR: |
| result = (result*72)/(gc->ps*gc->cex); |
| break; |
| case L_LINES: |
| result = (result*72)/(gc->ps*gc->cex*gc->lineheight); |
| break; |
| case L_MM: |
| result = result*2.54*10; |
| break; |
| /* Maybe an opportunity for some constants below here (!) |
| */ |
| case L_POINTS: |
| result = result*72.27; |
| break; |
| case L_PICAS: |
| result = result/12*72.27; |
| break; |
| case L_BIGPOINTS: |
| result = result*72; |
| break; |
| case L_DIDA: |
| result = result/1238*1157*72.27; |
| break; |
| case L_CICERO: |
| result = result/1238*1157*72.27/12; |
| break; |
| case L_SCALEDPOINTS: |
| result = result*65536*72.27; |
| break; |
| /* |
| * I'm not sure the remaining ones makes any sense. |
| * For simplicity, these are just forbidden for now. |
| */ |
| case L_SNPC: |
| case L_MYCHAR: |
| case L_MYLINES: |
| case L_STRINGWIDTH: |
| case L_MYSTRINGWIDTH: |
| case L_STRINGHEIGHT: |
| case L_MYSTRINGHEIGHT: |
| case L_GROBX: |
| case L_GROBY: |
| case L_GROBWIDTH: |
| case L_GROBHEIGHT: |
| case L_NULL: |
| default: |
| error(_("invalid unit or unit not yet implemented")); |
| } |
| /* |
| * For physical units, reverse the scale by GSS_SCALE (a "zoom" factor) |
| */ |
| switch (unit) { |
| case L_INCHES: |
| case L_CM: |
| case L_MM: |
| case L_POINTS: |
| case L_PICAS: |
| case L_BIGPOINTS: |
| case L_DIDA: |
| case L_CICERO: |
| case L_SCALEDPOINTS: |
| result = result / REAL(gridStateElement(dd, GSS_SCALE))[0]; |
| break; |
| default: |
| /* |
| * No need to scale relative coordinates (NPC, NATIVE, NULL) |
| * All other units forbidden anyway |
| */ |
| break; |
| } |
| return result; |
| } |
| |
| /* |
| * This corresponds to transform[X|Y]toINCHES() because |
| * it works only within the current viewport, BUT |
| * it is much simpler because it is supplied with a |
| * double value in INCHES (rather than a unit object in |
| * an arbitrary unit). |
| * |
| * For conceptual symmetry, it should probably return a |
| * unit object, but it only returns a double value. |
| * The construction of a unit object with the appropriate |
| * unit must be performed by the calling function (or higher). |
| * This is probably easiest done right up in R code. |
| */ |
| double transformXYFromINCHES(double location, int unit, |
| double scalemin, double scalemax, |
| const pGEcontext gc, |
| double thisCM, double otherCM, |
| pGEDevDesc dd) |
| { |
| double result = location; |
| /* Special case if "thisCM == 0": |
| * If converting FROM relative unit, result will already be zero |
| * so leave it there. |
| * If converting FROM absolute unit that is zero, ditto. |
| * Otherwise (converting FROM non-zero absolute unit), |
| * converting to relative unit is an error. |
| */ |
| if ((unit == L_NATIVE || unit == L_NPC) && |
| thisCM < 1e-6) { |
| if (result != 0) |
| error(_("Viewport has zero dimension(s)")); |
| } else { |
| switch (unit) { |
| case L_NATIVE: |
| result = scalemin + (result/(thisCM/2.54))*(scalemax - scalemin); |
| break; |
| default: |
| result = transformFromINCHES(location, unit, gc, |
| thisCM, otherCM, dd); |
| } |
| } |
| return result; |
| } |
| |
| double transformWidthHeightFromINCHES(double dimension, int unit, |
| double scalemin, double scalemax, |
| const pGEcontext gc, |
| double thisCM, double otherCM, |
| pGEDevDesc dd) |
| { |
| double result = dimension; |
| /* Special case if "thisCM == 0": |
| * If converting FROM relative unit, result will already be zero |
| * so leave it there. |
| * If converting FROM absolute unit that is zero, ditto. |
| * Otherwise (converting FROM non-zero absolute unit), |
| * converting to relative unit is an error. |
| */ |
| if ((unit == L_NATIVE || unit == L_NPC) && |
| thisCM < 1e-6) { |
| if (result != 0) |
| error(_("Viewport has zero dimension(s)")); |
| } else { |
| switch (unit) { |
| case L_NATIVE: |
| result = (result/(thisCM/2.54))*(scalemax - scalemin); |
| break; |
| default: |
| result = transformFromINCHES(dimension, unit, gc, |
| thisCM, otherCM, dd); |
| } |
| } |
| return result; |
| } |
| |
| /* |
| * Special case conversion from relative unit to relative unit, |
| * only used when relevant widthCM or heightCM is zero, so |
| * we cannot transform thru INCHES (or we get divide-by-zero) |
| * |
| * Protected from divide-by-zero here because viewport with |
| * identical scale limits is disallowed. |
| */ |
| double transformXYtoNPC(double x, int from, double min, double max) |
| { |
| double result = x; |
| switch (from) { |
| case L_NPC: |
| break; |
| case L_NATIVE: |
| result = (x - min)/(max - min); |
| break; |
| default: |
| error(_("Unsupported unit conversion")); |
| } |
| return(result); |
| } |
| |
| double transformWHtoNPC(double x, int from, double min, double max) |
| { |
| double result = x; |
| switch (from) { |
| case L_NPC: |
| break; |
| case L_NATIVE: |
| result = x/(max - min); |
| break; |
| default: |
| error(_("Unsupported unit conversion")); |
| } |
| return(result); |
| } |
| |
| double transformXYfromNPC(double x, int to, double min, double max) |
| { |
| double result = x; |
| switch (to) { |
| case L_NPC: |
| break; |
| case L_NATIVE: |
| result = min + x*(max - min); |
| break; |
| default: |
| error(_("Unsupported unit conversion")); |
| } |
| return(result); |
| } |
| |
| double transformWHfromNPC(double x, int to, double min, double max) |
| { |
| double result = x; |
| switch (to) { |
| case L_NPC: |
| break; |
| case L_NATIVE: |
| result = x*(max - min); |
| break; |
| default: |
| error(_("Unsupported unit conversion")); |
| } |
| return(result); |
| } |
| |
| /* Attempt to make validating units faster |
| */ |
| typedef struct { |
| char *name; |
| int code; |
| } UnitTab; |
| |
| /* NOTE this table must match the order in grid.h |
| */ |
| static UnitTab UnitTable[] = { |
| { "npc", 0 }, |
| { "cm", 1 }, |
| { "inches", 2 }, |
| { "lines", 3 }, |
| { "native", 4 }, |
| { "null", 5 }, |
| { "snpc", 6 }, |
| { "mm", 7 }, |
| { "points", 8 }, |
| { "picas", 9 }, |
| { "bigpts", 10 }, |
| { "dida", 11 }, |
| { "cicero", 12 }, |
| { "scaledpts", 13 }, |
| { "strwidth", 14 }, |
| { "strheight", 15 }, |
| { "strascent", 16 }, |
| { "strdescent", 17 }, |
| |
| { "char", 18 }, |
| { "grobx", 19 }, |
| { "groby", 20 }, |
| { "grobwidth", 21 }, |
| { "grobheight", 22 }, |
| { "grobascent", 23 }, |
| { "grobdescent", 24 }, |
| |
| { "mylines", 103 }, |
| { "mychar", 104 }, |
| { "mystrwidth", 105 }, |
| { "mystrheight", 106 }, |
| |
| /* |
| * Some pseudonyms |
| */ |
| { "centimetre", 1001 }, |
| { "centimetres", 1001 }, |
| { "centimeter", 1001 }, |
| { "centimeters", 1001 }, |
| { "in", 1002 }, |
| { "inch", 1002 }, |
| { "line", 1003 }, |
| { "millimetre", 1007 }, |
| { "millimetres", 1007 }, |
| { "millimeter", 1007 }, |
| { "millimeters", 1007 }, |
| { "point", 1008 }, |
| { "pt", 1008 }, |
| |
| { NULL, -1 } |
| }; |
| |
| int convertUnit(SEXP unit, int index) |
| { |
| int i = 0; |
| int result = 0; |
| int found = 0; |
| while (result >= 0 && !found) { |
| if (UnitTable[i].name == NULL) |
| result = -1; |
| else { |
| found = !strcmp(CHAR(STRING_ELT(unit, index)), UnitTable[i].name); |
| if (found) { |
| result = UnitTable[i].code; |
| /* resolve pseudonyms */ |
| if (result > 1000) { |
| result = result - 1000; |
| } |
| } |
| } |
| i += 1; |
| } |
| if (result < 0) |
| error(_("Invalid unit")); |
| return result; |
| } |
| |
| SEXP validUnits(SEXP units) |
| { |
| int i; |
| int n = LENGTH(units); |
| SEXP answer = R_NilValue; |
| if (n > 0) { |
| if (isString(units)) { |
| PROTECT(answer = allocVector(INTSXP, n)); |
| for (i = 0; i<n; i++) |
| INTEGER(answer)[i] = convertUnit(units, i); |
| UNPROTECT(1); |
| } else { |
| error(_("'units' must be character")); |
| } |
| } else { |
| error(_("'units' must be of length > 0")); |
| } |
| return answer; |
| } |
