thomasp85 / farver
Showing 4 of 7 files from the diff.
Newly tracked file
R/native.R created.
Other files ignored by Codecov
NAMESPACE has changed.
NEWS.md has changed.

@@ -41,6 +41,8 @@
Loading
41 41
SEXP encode_channel_c(SEXP codes, SEXP channel, SEXP value, SEXP space, SEXP op, SEXP white, SEXP na);
42 42
SEXP decode_channel_c(SEXP codes, SEXP channel, SEXP space, SEXP white, SEXP na);
43 43
SEXP load_colour_names_c(SEXP name, SEXP value);
44 +
SEXP encode_native_c(SEXP color);
45 +
SEXP decode_native_c(SEXP native);
44 46
45 47
template <typename Space>
46 48
inline void modify_channel(Space&, double value, int channel, int op);

@@ -5,6 +5,8 @@
Loading
5 5
#include <string>
6 6
#include <cctype>
7 7
8 +
#include <R_ext/GraphicsEngine.h>
9 +
8 10
static char hex8[] = "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F707172737475767778797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9FA0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEFF0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF";
9 11
static char buffer[] = "#000000";
10 12
static char buffera[] = "#00000000";
@@ -1071,3 +1073,85 @@
Loading
1071 1073
  // never happens
1072 1074
  return R_NilValue;
1073 1075
}
1076 +
1077 +
SEXP encode_native_c(SEXP color) {
1078 +
  int n = Rf_length(color);
1079 +
  ColourMap& named_colours = get_named_colours();
1080 +
  SEXP natives = PROTECT(Rf_allocVector(INTSXP, n));
1081 +
  int* natives_p = INTEGER(natives);
1082 +
  
1083 +
  int nchar;
1084 +
  bool has_alpha;
1085 +
  for (int i = 0; i < n; ++i) {
1086 +
    SEXP code = STRING_ELT(color, i);
1087 +
    if (code == R_NaString || strcmp("NA", CHAR(code)) == 0) {
1088 +
      natives_p[i] = NA_INTEGER;
1089 +
    }
1090 +
    const char* col = Rf_translateCharUTF8(code);
1091 +
    if (col[0] == '#') {
1092 +
      nchar = strlen(col);
1093 +
      has_alpha = nchar == 9;
1094 +
      if (!has_alpha && nchar != 7) {
1095 +
        Rf_errorcall(R_NilValue, "Malformed colour string `%s`. Must contain either 6 or 8 hex values", col);
1096 +
      }
1097 +
      natives_p[i] = R_RGBA(
1098 +
        hex2int(col[1]) * 16 + hex2int(col[2]),
1099 +
        hex2int(col[3]) * 16 + hex2int(col[4]),
1100 +
        hex2int(col[5]) * 16 + hex2int(col[6]),
1101 +
        has_alpha ? hex2int(col[7]) * 16 + hex2int(col[8]) : 255
1102 +
      );
1103 +
    } else {
1104 +
      ColourMap::iterator it = named_colours.find(prepare_code(col));
1105 +
      if (it == named_colours.end()) {
1106 +
        Rf_errorcall(R_NilValue, "Unknown colour name: %s", col);
1107 +
        natives_p[i] = NA_INTEGER;
1108 +
      } else {
1109 +
        natives_p[i] = R_RGB(it->second.r, it->second.g, it->second.b);
1110 +
      }
1111 +
    }
1112 +
  }
1113 +
  
1114 +
  copy_names(color, natives);
1115 +
  UNPROTECT(1);
1116 +
  return natives;
1117 +
}
1118 +
1119 +
SEXP decode_native_c(SEXP native) {
1120 +
  int n = Rf_length(native);
1121 +
  SEXP codes = PROTECT(Rf_allocVector(STRSXP, n));
1122 +
  char* buf = buffera;
1123 +
  int* native_p = INTEGER(native);
1124 +
  int num;
1125 +
  
1126 +
  for (int i = 0; i < n; ++i) {
1127 +
    if (native_p[i] == R_NaInt) {
1128 +
      SET_STRING_ELT(codes, i, R_NaString);
1129 +
      continue;
1130 +
    }
1131 +
    num = R_RED(native_p[i]) * 2;
1132 +
    buf[1] = hex8[num];
1133 +
    buf[2] = hex8[num + 1];
1134 +
    
1135 +
    num = R_GREEN(native_p[i]) * 2;
1136 +
    buf[3] = hex8[num];
1137 +
    buf[4] = hex8[num + 1];
1138 +
    
1139 +
    num = R_BLUE(native_p[i]) * 2;
1140 +
    buf[5] = hex8[num];
1141 +
    buf[6] = hex8[num + 1];
1142 +
    
1143 +
    num = R_ALPHA(native_p[i]) * 2;
1144 +
    if (num == 510) { // opaque
1145 +
      buf[7] = '\0';
1146 +
    } else {
1147 +
      buf[7] = hex8[num];
1148 +
      buf[8] = hex8[num + 1];
1149 +
    }
1150 +
    
1151 +
    SET_STRING_ELT(codes, i, Rf_mkChar(buf));
1152 +
  }
1153 +
  
1154 +
  copy_names(native, codes);
1155 +
  UNPROTECT(1);
1156 +
  return codes;
1157 +
}

@@ -0,0 +1,53 @@
Loading
1 +
#' Convert to and from the R native colour representation
2 +
#' 
3 +
#' Colours in R are internally encoded as integers when they are passed around
4 +
#' to graphics devices. The encoding splits the 32 bytes in the integer between
5 +
#' red, green, blue, and alpha, so that each get 8 bytes, equivalent to 256 
6 +
#' values. It is very seldom that an R user is subjected to this representation,
7 +
#' but it is present in the `nativeRaster` format which can be obtained from 
8 +
#' e.g. capturing the content of a graphic device (using `dev.cap()`) or reading
9 +
#' in PNG files using `png::readPNG(native = TRUE)`. It is very rare that you 
10 +
#' might need to convert back and forth between this format, but it is provided
11 +
#' here for completeness.
12 +
#' 
13 +
#' @param colour For `encode_native` either a vector of hex-encoded 
14 +
#' colours/colour names or a matrix encoding colours in any of the supported 
15 +
#' colour spaces. If the  latter, the colours will be encoded to a hex string 
16 +
#' using [encode_colour()] first. For `decode_native` it is a vector of 
17 +
#' integers.
18 +
#' @param ... Arguments passed on to [encode_colour()]
19 +
#' 
20 +
#' @return `encode_native()` returns an integer vector and `decode_native()`
21 +
#' returns a character vector, both matching the length of the input.
22 +
#' 
23 +
#' @export
24 +
#' @name native-encoding
25 +
#' @rdname native_encoding
26 +
#' 
27 +
#' @examples 
28 +
#' 
29 +
#' # Get native representation of navyblue and #228B22
30 +
#' native_col <- encode_native(c('navyblue', '#228B22'))
31 +
#' native_col
32 +
#' 
33 +
#' # Convert back
34 +
#' decode_native(native_col)
35 +
#' 
36 +
encode_native <- function(colour, ...) {
37 +
  if (!is.character(colour)) {
38 +
    colour <- encode_colour(colour, ...)
39 +
  }
40 +
  encode_native_c(colour)
41 +
}
42 +
#' @rdname native_encoding
43 +
#' @export
44 +
decode_native <- function(colour) {
45 +
  decode_native_c(colour)
46 +
} 
47 +
48 +
encode_native_c <- function(colour) {
49 +
  .Call('encode_native_c', colour, PACKAGE = 'farver')
50 +
}
51 +
decode_native_c <- function(colour) {
52 +
  .Call('decode_native_c', as.integer(colour), PACKAGE = 'farver')
53 +
}

@@ -20,6 +20,8 @@
Loading
20 20
  {"encode_channel_c", (DL_FUNC) &encode_channel_c, 7},
21 21
  {"decode_channel_c", (DL_FUNC) &decode_channel_c, 5},
22 22
  {"load_colour_names_c", (DL_FUNC) &load_colour_names_c, 2},
23 +
  {"encode_native_c", (DL_FUNC) &encode_native_c, 1},
24 +
  {"decode_native_c", (DL_FUNC) &decode_native_c, 1},
23 25
  {NULL, NULL, 0}
24 26
};
25 27
Files Coverage
R 55.37%
src 53.37%
Project Totals (17 files) 53.47%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
        informational: true
10
    patch:
11
      default:
12
        target: auto
13
        threshold: 1%
14
        informational: true
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading