A Toy HTML Layout Engine in R
To render a web page from HTML you will need a number of components:
a way to parse the HTML text, a way to parse and apply the CSS,
a layout engine to combine the HTML and CSS to figure out where everything
goes on the page, and an actual way of rendering the layout.
The R components
{xml2} is used to parse the HTML text into structured representation in R
{cssparser} is used to parse the CSS text into structured representation in R
','
{grid} is used to render the layout as frame objects
{gridtext} is used to render styled text blocks
The code in this vignette performs the layout of elements
Technical Bit
The layout engine in this vignette is obviously a complete hack.
The web page layout is a nested sequence of `grid::frameGrob()` objects,
with a few dodgy heuristics on whether the current frame is a sequence of
row elements or column elements
Other than "p" and "div" tags, everything else is either ignored or
hacked to behave like a "p" tag.
If you look
closely at the code, you\'ll find that "img" tags are just rendered via a
hard-coded rasterGrob()
','
'))
```
```{r}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Apply the final calcualted style as inline styles on each element in the
# HTML document
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
html <- cssparser::css_apply_inline(html, css)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Also calculate a named list of styles, where the name is the 'xpath' to
# a given node
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
xpstyle <- cssparser::css_apply(html, css)
```
```{r}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Convert all headers ( tags
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
hs <- xml2::xml_find_all(html, xpath = "//h1 | //h2 | //h3 | //h4")
for (h in hs) {
xml2::xml_name(h) <- 'p'
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Convert all 'a' link tags in html to 'p'
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
alinks <- xml2::xml_find_all(html, xpath = "//a")
for (alink in alinks) {
xml2::xml_name(alink) <- 'p'
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Find the width of a given HTML node
#'
#' @param x html node (in a document read in with {xml2})
#'
#' @return the calculated 'width' of this node (determined using its xpath)
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
get_width <- function(x) {
xpath <- xml2::xml_path(x)
style <- xpstyle[[xpath]]
style[['width']]
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Recursively convert an HTML node to grob objects
#'
#' @param node HTML documet node. Usually called with root node of document
#'
#' @return grob
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
node_to_grob <- function(node) {
xpath <- xml2::xml_path(node)
tag <- xml2::xml_name(node)
if (tag %in% c('div', 'body')) {
grobs <- lapply(xml2::xml_children(node), node_to_grob)
widths <- vapply(xml2::xml_children(node), function(node) {
cssparser::css_string_as_pixels(get_width(node))
}, numeric(1))
if (any(widths > 0)) {
units <- ifelse(widths == 0, 'null', ifelse(widths <= 1, 'npc', 'px'))
widths[widths == 0] <- 1
widths <- unit(widths, units)
hsplit(grobs, widths = widths, name = xpath)
} else {
heights <- vapply(grobs, function(grob) {
h <- grid::grobHeight(grob)
as.numeric(grid::convertHeight(h, 'in'))
}, numeric(1))
units <- ifelse(heights > 0, 'pt', 'null')
heights <- heights * 96 * 1.2
heights[heights == 0] <- 1
heights <- unit(heights, units)
vsplit(grobs, heights = heights)
}
} else if (tag == 'p') {
gridtext::textbox_grob(as.character(node), name = xpath)
} else if (tag == 'img') {
# Hard-coded cheat
img <- jpeg::readJPEG(system.file("img", "Rlogo.jpg", package="jpeg"))
grid::rasterGrob(img, interpolate = TRUE, width=unit(3, 'cm'))
} else {
message("Skipping tag: ", tag)
grid::nullGrob(name = xpath)
}
}
```
```{r output.width=12, output.height=10, fig.height=10, fig.width=12}
node <- xml2::xml_find_first(html, 'body')
g <- node_to_grob(node)
grid.newpage()
grid.draw(g)
```
