add raster box

R/RcppExports.R

@@ -21,6 +21,10 @@ bl_make_text_box <- function(label, gp, voff_pt = 0) {
     .Call(`_gridtext_bl_make_text_box`, label, gp, voff_pt)
 }
 
+bl_make_raster_box <- function(image, width_pt, height_pt, width_policy = "fixed", height_policy = "fixed", interpolate = TRUE, gp = NULL) {
+    .Call(`_gridtext_bl_make_raster_box`, image, width_pt, height_pt, width_policy, height_policy, interpolate, gp)
+}
+
 bl_make_vbox <- function(nodes, width_pt = 0, hjust = 0, vjust = 1, width_policy = "native") {
     .Call(`_gridtext_bl_make_vbox`, nodes, width_pt, hjust, vjust, width_policy)
 }
@@ -97,8 +101,8 @@ text_grob <- function(label, x_pt = 0L, y_pt = 0L, gp = NULL, name = NULL) {
     .Call(`_gridtext_text_grob`, label, x_pt, y_pt, gp, name)
 }
 
-raster_grob <- function(image, x_pt = 0L, y_pt = 0L, width_pt = 0L, height_pt = 0L, interpolate = TRUE, name = NULL) {
-    .Call(`_gridtext_raster_grob`, image, x_pt, y_pt, width_pt, height_pt, interpolate, name)
+raster_grob <- function(image, x_pt = 0L, y_pt = 0L, width_pt = 0L, height_pt = 0L, interpolate = TRUE, gp = NULL, name = NULL) {
+    .Call(`_gridtext_raster_grob`, image, x_pt, y_pt, width_pt, height_pt, interpolate, gp, name)
 }
 
 rect_grob <- function(x_pt = 0L, y_pt = 0L, width_pt = 0L, height_pt = 0L, gp = NULL, name = NULL) {

src/RcppExports.cpp

@@ -75,6 +75,23 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// bl_make_raster_box
+XPtr<BoxPtr<GridRenderer> > bl_make_raster_box(RObject image, double width_pt, double height_pt, String width_policy, String height_policy, bool interpolate, List gp);
+RcppExport SEXP _gridtext_bl_make_raster_box(SEXP imageSEXP, SEXP width_ptSEXP, SEXP height_ptSEXP, SEXP width_policySEXP, SEXP height_policySEXP, SEXP interpolateSEXP, SEXP gpSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< RObject >::type image(imageSEXP);
+    Rcpp::traits::input_parameter< double >::type width_pt(width_ptSEXP);
+    Rcpp::traits::input_parameter< double >::type height_pt(height_ptSEXP);
+    Rcpp::traits::input_parameter< String >::type width_policy(width_policySEXP);
+    Rcpp::traits::input_parameter< String >::type height_policy(height_policySEXP);
+    Rcpp::traits::input_parameter< bool >::type interpolate(interpolateSEXP);
+    Rcpp::traits::input_parameter< List >::type gp(gpSEXP);
+    rcpp_result_gen = Rcpp::wrap(bl_make_raster_box(image, width_pt, height_pt, width_policy, height_policy, interpolate, gp));
+    return rcpp_result_gen;
+END_RCPP
+}
 // bl_make_vbox
 XPtr<BoxPtr<GridRenderer> > bl_make_vbox(XPtr<BoxList<GridRenderer> > nodes, double width_pt, double hjust, double vjust, String width_policy);
 RcppExport SEXP _gridtext_bl_make_vbox(SEXP nodesSEXP, SEXP width_ptSEXP, SEXP hjustSEXP, SEXP vjustSEXP, SEXP width_policySEXP) {
@@ -309,8 +326,8 @@ BEGIN_RCPP
 END_RCPP
 }
 // raster_grob
-List raster_grob(RObject image, NumericVector x_pt, NumericVector y_pt, NumericVector width_pt, NumericVector height_pt, LogicalVector interpolate, RObject name);
-RcppExport SEXP _gridtext_raster_grob(SEXP imageSEXP, SEXP x_ptSEXP, SEXP y_ptSEXP, SEXP width_ptSEXP, SEXP height_ptSEXP, SEXP interpolateSEXP, SEXP nameSEXP) {
+List raster_grob(RObject image, NumericVector x_pt, NumericVector y_pt, NumericVector width_pt, NumericVector height_pt, LogicalVector interpolate, RObject gp, RObject name);
+RcppExport SEXP _gridtext_raster_grob(SEXP imageSEXP, SEXP x_ptSEXP, SEXP y_ptSEXP, SEXP width_ptSEXP, SEXP height_ptSEXP, SEXP interpolateSEXP, SEXP gpSEXP, SEXP nameSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
@@ -320,8 +337,9 @@ BEGIN_RCPP
     Rcpp::traits::input_parameter< NumericVector >::type width_pt(width_ptSEXP);
     Rcpp::traits::input_parameter< NumericVector >::type height_pt(height_ptSEXP);
     Rcpp::traits::input_parameter< LogicalVector >::type interpolate(interpolateSEXP);
+    Rcpp::traits::input_parameter< RObject >::type gp(gpSEXP);
     Rcpp::traits::input_parameter< RObject >::type name(nameSEXP);
-    rcpp_result_gen = Rcpp::wrap(raster_grob(image, x_pt, y_pt, width_pt, height_pt, interpolate, name));
+    rcpp_result_gen = Rcpp::wrap(raster_grob(image, x_pt, y_pt, width_pt, height_pt, interpolate, gp, name));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -395,6 +413,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_gridtext_bl_make_par_box", (DL_FUNC) &_gridtext_bl_make_par_box, 3},
     {"_gridtext_bl_make_rect_box", (DL_FUNC) &_gridtext_bl_make_rect_box, 11},
     {"_gridtext_bl_make_text_box", (DL_FUNC) &_gridtext_bl_make_text_box, 3},
+    {"_gridtext_bl_make_raster_box", (DL_FUNC) &_gridtext_bl_make_raster_box, 7},
     {"_gridtext_bl_make_vbox", (DL_FUNC) &_gridtext_bl_make_vbox, 5},
     {"_gridtext_bl_make_node_list", (DL_FUNC) &_gridtext_bl_make_node_list, 1},
     {"_gridtext_bl_box_width", (DL_FUNC) &_gridtext_bl_box_width, 1},
@@ -414,7 +433,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_gridtext_unit_pt", (DL_FUNC) &_gridtext_unit_pt, 1},
     {"_gridtext_gpar_empty", (DL_FUNC) &_gridtext_gpar_empty, 0},
     {"_gridtext_text_grob", (DL_FUNC) &_gridtext_text_grob, 5},
-    {"_gridtext_raster_grob", (DL_FUNC) &_gridtext_raster_grob, 7},
+    {"_gridtext_raster_grob", (DL_FUNC) &_gridtext_raster_grob, 8},
     {"_gridtext_rect_grob", (DL_FUNC) &_gridtext_rect_grob, 6},
     {"_gridtext_roundrect_grob", (DL_FUNC) &_gridtext_roundrect_grob, 7},
     {"_gridtext_set_grob_coords", (DL_FUNC) &_gridtext_set_grob_coords, 3},

src/bl-r-bindings.cpp

@@ -4,6 +4,7 @@ using namespace Rcpp;
 #include "layout.h"
 #include "null-box.h"
 #include "par-box.h"
+#include "raster-box.h"
 #include "rect-box.h"
 #include "text-box.h"
 #include "vbox.h"
@@ -98,6 +99,27 @@ XPtr<BoxPtr<GridRenderer> > bl_make_text_box(String label, List gp, double voff_
   return p;
 }
 
+
+//RasterBox(RObject image, Length width, Length height, const typename Renderer::GraphicsContext &gp,
+//          SizePolicy width_policy = SizePolicy::fixed, SizePolicy height_policy = SizePolicy::fixed,
+//          bool interpolate = true) :
+
+// [[Rcpp::export]]
+XPtr<BoxPtr<GridRenderer> > bl_make_raster_box(RObject image, double width_pt, double height_pt,
+                                               String width_policy = "fixed", String height_policy = "fixed",
+                                               bool interpolate = true, List gp = R_NilValue) {
+  SizePolicy w_policy = convert_size_policy(width_policy);
+  SizePolicy h_policy = convert_size_policy(height_policy);
+
+  XPtr<BoxPtr<GridRenderer> > p(new BoxPtr<GridRenderer>(new RasterBox<GridRenderer>(
+      image, width_pt, height_pt, gp, w_policy, h_policy, interpolate)));
+
+  StringVector cl = {"bl_raster_box", "bl_box", "bl_node"};
+  p.attr("class") = cl;
+
+  return p;
+}
+
 // [[Rcpp::export]]
 XPtr<BoxPtr<GridRenderer> > bl_make_vbox(XPtr<BoxList<GridRenderer> > nodes, double width_pt = 0,
                                          double hjust = 0, double vjust = 1, String width_policy = "native") {

src/grid-renderer.h

@@ -52,12 +52,13 @@ class GridRenderer {
     m_grobs.push_back(text_grob(CharacterVector(label), NumericVector(1, x), NumericVector(1, y), gp));
   }
 
-  void raster(RObject image, Length x, Length y, Length width, Length height, bool interpolate = true) {
+  void raster(RObject image, Length x, Length y, Length width, Length height, bool interpolate = true,
+              const GraphicsContext &gp = R_NilValue) {
     if (!image.isNULL()) {
       m_grobs.push_back(
         raster_grob(
           image, NumericVector(1, x), NumericVector(1, y),
-          NumericVector(1, width), NumericVector(1, height), LogicalVector(1, interpolate)
+          NumericVector(1, width), NumericVector(1, height), LogicalVector(1, interpolate, gp)
         )
       );
     }

src/grid.cpp

@@ -62,7 +62,7 @@ List text_grob(CharacterVector label, NumericVector x_pt, NumericVector y_pt, RO
 }
 
 List raster_grob(RObject image, NumericVector x_pt, NumericVector y_pt, NumericVector width_pt, NumericVector height_pt,
-                 LogicalVector interpolate, RObject name) {
+                 LogicalVector interpolate, RObject gp, RObject name) {
   if (x_pt.size() != 1 || y_pt.size() != 1 || width_pt.size() != 1 || height_pt.size() != 1) {
     stop("Function raster_grob() is not vectorized.\n");
   }
@@ -92,7 +92,7 @@ List raster_grob(RObject image, NumericVector x_pt, NumericVector y_pt, NumericV
     _["width"] = unit_pt(width_pt), _["height"] = unit_pt(height_pt),
     _["just"] = "centre", _["hjust"] = 0., _["vjust"] = 0.,
     _["interpolate"] = interpolate,
-    _["name"] = name, _["gp"] = R_NilValue, _["vp"] = R_NilValue
+    _["name"] = name, _["gp"] = gp, _["vp"] = R_NilValue
   );
 
   Rcpp::StringVector cl(3);

src/grid.h

@@ -33,7 +33,7 @@ List text_grob(CharacterVector label, NumericVector x_pt = 0, NumericVector y_pt
 // replacement for rasterGrop(image, x_pt, y_pt, width_pt, height_pt, gp = gpar(), hjust = 0, vjust = 0, default.units = "pt", interpolate = TRUE, name = NULL)
 // [[Rcpp::export]]
 List raster_grob(RObject image, NumericVector x_pt = 0, NumericVector y_pt = 0, NumericVector width_pt = 0, NumericVector height_pt = 0,
-                 LogicalVector interpolate = true, RObject name = R_NilValue);
+                 LogicalVector interpolate = true, RObject gp = R_NilValue, RObject name = R_NilValue);
 
 // replacement for rectGrop(x_pt, y_pt, width_pt, height_pt, gp = gpar(), hjust = 0, vjust = 0, default.units = "pt", name = NULL)
 // [[Rcpp::export]]

src/raster-box.h

@@ -0,0 +1,58 @@
+#ifndef RASTER_BOX_H
+#define RASTER_BOX_H
+
+#include <Rcpp.h>
+using namespace Rcpp;
+
+#include <iostream>
+
+#include "layout.h"
+
+// A box holding a single image
+template <class Renderer>
+class RasterBox : public Box<Renderer> {
+private:
+  RObject m_image;
+  typename Renderer::GraphicsContext m_gp;
+  Length m_width, m_height;
+  SizePolicy m_width_policy, m_height_policy;
+  // position of the box in enclosing box
+  // the box reference point is the leftmost point of the baseline.
+  Length m_x, m_y;
+  bool m_interpolate;
+
+public:
+  RasterBox(RObject image, Length width, Length height, const typename Renderer::GraphicsContext &gp,
+            SizePolicy width_policy = SizePolicy::fixed, SizePolicy height_policy = SizePolicy::fixed,
+            bool interpolate = true) :
+    m_image(image), m_gp(gp), m_width(width), m_height(height),
+    m_width_policy(width_policy), m_height_policy(height_policy),
+    m_x(0), m_y(0), m_interpolate(interpolate) {
+  }
+  ~RasterBox() {};
+
+  Length width() { return m_width; }
+  Length ascent() { return m_height; }
+  Length descent() { return 0; }
+  Length voff() { return 0; }
+
+  // nothing to be done for a raster box
+  void calc_layout(Length, Length) {}
+
+  // place box in internal coordinates used in enclosing box
+  void place(Length x, Length y) {
+    m_x = x;
+    m_y = y;
+  }
+
+  // render into absolute coordinates, using the reference coordinates
+  // from the enclosing box
+  void render(Renderer &r, Length xref, Length yref) {
+    Length x = m_x + xref;
+    Length y = m_y + yref;
+
+    r.raster(m_image, x, y, m_width, m_height, m_interpolate, m_gp);
+  }
+};
+
+#endif

tests/testthat/test-grid-constructors.R

@@ -90,19 +90,19 @@ test_that("raster_grob", {
   image <- matrix(0:1, ncol = 5, nrow = 4)
 
   expect_identical(
-    raster_grob(image, 10, 20, 50, 40, name = "abc"),
+    raster_grob(image, 10, 20, 50, 40, gp = gpar(), name = "abc"),
     rasterGrob(
       image,
       x = unit(10, "pt"), y = unit(20, "pt"),
       width = unit(50, "pt"), height = unit(40, "pt"),
       hjust = 0, vjust = 0,
       interpolate = TRUE,
-      gp = NULL,
+      gp = gpar(),
       name = "abc"
     )
   )
 
-  # interpolate is set as requested
+  # interpolate is set as requested, gp default is NULL
   expect_identical(
     raster_grob(image, 10, 20, 50, 40, interpolate = FALSE, name = "abc"),
     rasterGrob(