mirror of https://git.sr.ht/~hrbrmstr/widgetcard
14 changed files with 760 additions and 23 deletions
@ -1,4 +1,8 @@ |
|||
# Generated by roxygen2: do not edit by hand |
|||
|
|||
import(httr) |
|||
importFrom(jsonlite,fromJSON) |
|||
export(card_widget) |
|||
export(gg_preview) |
|||
import(htmltools) |
|||
import(htmlwidgets) |
|||
import(widgetframe) |
|||
importFrom(ggplot2,ggsave) |
|||
|
|||
@ -0,0 +1,27 @@ |
|||
#' Generate a Twitter Player card preview image from a ggplot2 plot |
|||
#' |
|||
#' Takes arguments similar to [ggplot2::ggsave()] and creates a temporary |
|||
#' plot file (png) to be used as input to [card_widget()]. |
|||
#' |
|||
#' @param gg ggplot2 plot object |
|||
#' @param width,height width and height of the preview image. See References for guidelines |
|||
#' @return path to the preview image tempfile |
|||
#' @references |
|||
#' - <https://developer.twitter.com/en/docs/tweets/optimize-with-cards/overview/player-card.html> |
|||
#' - <https://sproutsocial.com/insights/social-media-image-sizes-guide/#twitter> |
|||
#' @export |
|||
gg_preview <- function(gg, width=350/72, height=196/72, dpi="retina") { |
|||
|
|||
preview <- tempfile(fileext = ".png") |
|||
|
|||
ggsave( |
|||
filename = preview, |
|||
plot = gg, |
|||
width = 350/72, # ~72pts/inch |
|||
height = 196/72, |
|||
dpi = "retina" |
|||
) |
|||
|
|||
preview |
|||
|
|||
} |
|||
@ -0,0 +1,290 @@ |
|||
# Bits copied from https://github.com/ramnathv/htmlwidgets/ to avoid ::: |
|||
|
|||
.globals <- new.env(parent = emptyenv()) |
|||
|
|||
# Copied from shiny 0.14.2 |
|||
toJSON2 <- function( |
|||
x, ..., dataframe = "columns", null = "null", na = "null", auto_unbox = TRUE, |
|||
digits = getOption("shiny.json.digits", 16), use_signif = TRUE, force = TRUE, |
|||
POSIXt = "ISO8601", UTC = TRUE, rownames = FALSE, keep_vec_names = TRUE, |
|||
strict_atomic = TRUE |
|||
) { |
|||
if (strict_atomic) x <- I(x) |
|||
jsonlite::toJSON( |
|||
x, dataframe = dataframe, null = null, na = na, auto_unbox = auto_unbox, |
|||
digits = digits, use_signif = use_signif, force = force, POSIXt = POSIXt, |
|||
UTC = UTC, rownames = rownames, keep_vec_names = keep_vec_names, |
|||
json_verbatim = TRUE, ... |
|||
) |
|||
} |
|||
|
|||
if (requireNamespace('shiny') && packageVersion('shiny') >= '0.12.0') local({ |
|||
tryCatch({ |
|||
toJSON <- getFromNamespace('toJSON', 'shiny') |
|||
args2 <- formals(toJSON2) |
|||
args1 <- formals(toJSON) |
|||
if (!identical(args1, args2)) { |
|||
warning('Check shiny:::toJSON and make sure htmlwidgets:::toJSON is in sync') |
|||
} |
|||
}) |
|||
}) |
|||
|
|||
toJSON <- function(x) { |
|||
if (!is.list(x) || !('x' %in% names(x))) return(toJSON2(x)) |
|||
func <- attr(x$x, 'TOJSON_FUNC', exact = TRUE) |
|||
args <- attr(x$x, 'TOJSON_ARGS', exact = TRUE) |
|||
if (length(args) == 0) args <- getOption('htmlwidgets.TOJSON_ARGS') |
|||
if (!is.function(func)) func <- toJSON2 |
|||
res <- if (length(args) == 0) func(x) else do.call(func, c(list(x = x), args)) |
|||
# make sure shiny:::toJSON() does not encode it again |
|||
structure(res, class = 'json') |
|||
} |
|||
|
|||
`%||%` <- function(x, y){ |
|||
if (is.null(x)) y else x |
|||
} |
|||
|
|||
prop <- function(x, path) { |
|||
tryCatch({ |
|||
for (i in strsplit(path, "$", fixed = TRUE)[[1]]) { |
|||
if (is.null(x)) |
|||
return(NULL) |
|||
x <- x[[i]] |
|||
} |
|||
return(x) |
|||
}, error = function(e) { |
|||
return(NULL) |
|||
}) |
|||
} |
|||
|
|||
any_prop <- function(scopes, path) { |
|||
for (scope in scopes) { |
|||
result <- prop(scope, path) |
|||
if (!is.null(result)) |
|||
return(result) |
|||
} |
|||
return(NULL) |
|||
} |
|||
|
|||
|
|||
# Creates a list of keys whose values need to be evaluated on the client-side. |
|||
# |
|||
# It works by transforming \code{list(foo = list(1, list(bar = |
|||
# I('function(){}')), 2))} to \code{list("foo.2.bar")}. Later on the JS side, we |
|||
# will split foo.2.bar to ['foo', '2', 'bar'] and evaluate the JSON object |
|||
# member. Note '2' (character) should have been 2 (integer) but it does not seem |
|||
# to matter in JS: x[2] is the same as x['2'] when all child members of x are |
|||
# unnamed, and ('2' in x) will be true even if x is an array without names. This |
|||
# is a little hackish. |
|||
# |
|||
# @param list a list in which the elements that should be evaluated as |
|||
# JavaScript are to be identified |
|||
# @author Yihui Xie |
|||
JSEvals <- function(list) { |
|||
# the `%||% list()` part is necessary as of R 3.4.0 (April 2017) -- if `evals` |
|||
# is NULL then `I(evals)` results in a warning in R 3.4.0. This is circumvented |
|||
# if we let `evals` be equal to `list()` in those cases |
|||
evals <- names(which(unlist(shouldEval(list)))) %||% list() |
|||
I(evals) # need I() to prevent toJSON() from converting it to scalar |
|||
} |
|||
|
|||
#' JSON elements that are character with the class JS_EVAL will be evaluated |
|||
#' |
|||
#' @noRd |
|||
#' @keywords internal |
|||
shouldEval <- function(options) { |
|||
if (is.list(options)) { |
|||
if ((n <- length(options)) == 0) return(FALSE) |
|||
# use numeric indices as names (remember JS indexes from 0, hence -1 here) |
|||
if (is.null(names(options))) |
|||
names(options) <- seq_len(n) - 1L |
|||
# Escape '\' and '.' by prefixing them with '\'. This allows us to tell the |
|||
# difference between periods as separators and periods that are part of the |
|||
# name itself. |
|||
names(options) <- gsub("([\\.])", "\\\\\\1", names(options)) |
|||
nms <- names(options) |
|||
if (length(nms) != n || any(nms == '')) |
|||
stop("'options' must be a fully named list, or have no names (NULL)") |
|||
lapply(options, shouldEval) |
|||
} else { |
|||
is.character(options) && inherits(options, 'JS_EVAL') |
|||
} |
|||
} |
|||
# JSEvals(list(list(foo.bar=JS("hi"), baz.qux="bye"))) == "0.foo\\.bar" |
|||
|
|||
resolveSizing <- function(x, sp, standalone, knitrOptions = NULL) { |
|||
if (isTRUE(standalone)) { |
|||
userSized <- !is.null(x$width) || !is.null(x$height) |
|||
viewerScopes <- list(sp$viewer, sp) |
|||
browserScopes <- list(sp$browser, sp) |
|||
# Precompute the width, height, padding, and fill for each scenario. |
|||
return(list( |
|||
runtime = list( |
|||
viewer = list( |
|||
width = x$width %||% any_prop(viewerScopes, "defaultWidth") %||% DEFAULT_WIDTH_VIEWER, |
|||
height = x$height %||% any_prop(viewerScopes, "defaultHeight") %||% DEFAULT_HEIGHT_VIEWER, |
|||
padding = any_prop(viewerScopes, "padding") %||% DEFAULT_PADDING_VIEWER, |
|||
fill = !userSized && any_prop(viewerScopes, "fill") %||% TRUE |
|||
), |
|||
browser = list( |
|||
width = x$width %||% any_prop(browserScopes, "defaultWidth") %||% DEFAULT_WIDTH, |
|||
height = x$height %||% any_prop(browserScopes, "defaultHeight") %||% DEFAULT_HEIGHT, |
|||
padding = any_prop(browserScopes, "padding") %||% DEFAULT_PADDING, |
|||
fill = !userSized && any_prop(browserScopes, "fill") %||% FALSE |
|||
) |
|||
), |
|||
width = x$width %||% prop(sp, "defaultWidth") %||% DEFAULT_WIDTH, |
|||
height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT |
|||
)) |
|||
} else if (!is.null(knitrOptions)) { |
|||
knitrScopes <- list(sp$knitr, sp) |
|||
isFigure <- any_prop(knitrScopes, "figure") |
|||
figWidth <- if (isFigure) knitrOptions$out.width.px else NULL |
|||
figHeight <- if (isFigure) knitrOptions$out.height.px else NULL |
|||
# Compute the width and height |
|||
return(list( |
|||
width = x$width %||% figWidth %||% any_prop(knitrScopes, "defaultWidth") %||% DEFAULT_WIDTH, |
|||
height = x$height %||% figHeight %||% any_prop(knitrScopes, "defaultHeight") %||% DEFAULT_HEIGHT |
|||
)) |
|||
} else { |
|||
# Some non-knitr, non-print scenario. |
|||
# Just resolve the width/height vs. defaultWidth/defaultHeight |
|||
return(list( |
|||
width = x$width %||% prop(sp, "defaultWidth") %||% DEFAULT_WIDTH, |
|||
height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT |
|||
)) |
|||
} |
|||
} |
|||
|
|||
toHTML <- function(x, standalone = FALSE, knitrOptions = NULL) { |
|||
|
|||
sizeInfo <- resolveSizing(x, x$sizingPolicy, standalone = standalone, knitrOptions = knitrOptions) |
|||
|
|||
if (!is.null(x$elementId)) |
|||
id <- x$elementId |
|||
else |
|||
id <- paste("htmlwidget", createWidgetId(), sep="-") |
|||
|
|||
w <- validateCssUnit(sizeInfo$width) |
|||
h <- validateCssUnit(sizeInfo$height) |
|||
|
|||
# create a style attribute for the width and height |
|||
style <- paste( |
|||
"width:", w, ";", |
|||
"height:", h, ";", |
|||
sep = "") |
|||
|
|||
x$id <- id |
|||
|
|||
container <- if (isTRUE(standalone)) { |
|||
function(x) { |
|||
div(id="htmlwidget_container", x) |
|||
} |
|||
} else { |
|||
identity |
|||
} |
|||
|
|||
html <- htmltools::tagList( |
|||
container( |
|||
htmltools::tagList( |
|||
x$prepend, |
|||
widget_html( |
|||
name = class(x)[1], |
|||
package = attr(x, "package"), |
|||
id = id, |
|||
style = style, |
|||
class = paste(class(x)[1], "html-widget"), |
|||
width = sizeInfo$width, |
|||
height = sizeInfo$height |
|||
), |
|||
x$append |
|||
) |
|||
), |
|||
widget_data(x, id), |
|||
if (!is.null(sizeInfo$runtime)) { |
|||
tags$script(type="application/htmlwidget-sizing", `data-for` = id, |
|||
toJSON(sizeInfo$runtime) |
|||
) |
|||
} |
|||
) |
|||
html <- htmltools::attachDependencies(html, |
|||
c(widget_dependencies(class(x)[1], attr(x, 'package')), |
|||
x$dependencies) |
|||
) |
|||
|
|||
htmltools::browsable(html) |
|||
|
|||
} |
|||
|
|||
# create a new unique widget id |
|||
createWidgetId <- function(bytes = 10) { |
|||
|
|||
# Note what the system's random seed is before we start, so we can restore it after |
|||
sysSeed <- .GlobalEnv$.Random.seed |
|||
# Replace system seed with our own seed |
|||
if (!is.null(.globals$idSeed)) { |
|||
.GlobalEnv$.Random.seed <- .globals$idSeed |
|||
} |
|||
on.exit({ |
|||
# Change our own seed to match the current seed |
|||
.globals$idSeed <- .GlobalEnv$.Random.seed |
|||
# Restore the system seed--we were never here |
|||
if(!is.null(sysSeed)) |
|||
.GlobalEnv$.Random.seed <- sysSeed |
|||
else |
|||
rm(".Random.seed", envir = .GlobalEnv) |
|||
}) |
|||
|
|||
paste( |
|||
format(as.hexmode(sample(256, bytes, replace = TRUE)-1), width=2), |
|||
collapse = "") |
|||
} |
|||
|
|||
widget_html <- function(name, package, id, style, class, inline = FALSE, ...){ |
|||
|
|||
# attempt to lookup custom html function for widget |
|||
fn <- tryCatch(get(paste0(name, "_html"), |
|||
asNamespace(package), |
|||
inherits = FALSE), |
|||
error = function(e) NULL) |
|||
|
|||
# call the custom function if we have one, otherwise create a div |
|||
if (is.function(fn)) { |
|||
fn(id = id, style = style, class = class, ...) |
|||
} else if (inline) { |
|||
tags$span(id = id, style = style, class = class) |
|||
} else { |
|||
tags$div(id = id, style = style, class = class) |
|||
} |
|||
} |
|||
|
|||
widget_data <- function(x, id, ...){ |
|||
# It's illegal for </script> to appear inside of a script tag, even if it's |
|||
# inside a quoted string. Fortunately we know that in JSON, the only place |
|||
# the '<' character can appear is inside a quoted string, where a Unicode |
|||
# escape has the same effect, without confusing the browser's parser. The |
|||
# repro for the bug this gsub fixes is to have the string "</script>" appear |
|||
# anywhere in the data/metadata of a widget--you will get a syntax error |
|||
# instead of a properly rendered widget. |
|||
# |
|||
# Another issue is that if </body></html> appears inside a quoted string, |
|||
# then when pandoc coverts it with --self-contained, the escaping gets messed |
|||
# up. There may be other patterns that trigger this behavior, so to be safe |
|||
# we can replace all instances of "</" with "\\u003c/". |
|||
payload <- toJSON(createPayload(x)) |
|||
payload <- gsub("</", "\\u003c/", payload, fixed = TRUE) |
|||
tags$script(type = "application/json", `data-for` = id, HTML(payload)) |
|||
} |
|||
|
|||
createPayload <- function(instance){ |
|||
if (!is.null(instance$preRenderHook)){ |
|||
instance <- instance$preRenderHook(instance) |
|||
instance$preRenderHook <- NULL |
|||
} |
|||
x <- .subset2(instance, "x") |
|||
list(x = x, evals = JSEvals(x), jsHooks = instance$jsHooks) |
|||
} |
|||
|
|||
widget_dependencies <- function(name, package){ |
|||
getDependency(name, package) |
|||
} |
|||
@ -0,0 +1,152 @@ |
|||
#' Turn an htmlwidget into a web deployable, interactive Twitter card |
|||
#' |
|||
#' Provide a preview image and a widget, plus Twitter Player card metadata and get pack |
|||
#' a packaged up, ready-to-deploy archive to deploy and used on Twitter. |
|||
#' |
|||
#' You can use [Twitter's Validator](https://cards-dev.twitter.com/validator) to ensure |
|||
#' your creation is usable before trying it in a tweet. |
|||
#' |
|||
#' @param widget an `htmlwidget` |
|||
#' @param output_dir the path to save the card-able widget to. If the directory does |
|||
#' not exist it will be created for you (recursively). The value will be |
|||
#' [path.expand()]ed. |
|||
#' @param name_prefix the name-prefix for the widget's `.html` file and `preview_img` file. |
|||
#' @param preview_img the path to the local preview image for the card-able widget. This |
|||
#' file must exist and will be copied over to the deployable directory and renamed |
|||
#' (see `name_prefix` above). Follow the guidelines |
|||
#' [here](https://sproutsocial.com/insights/social-media-image-sizes-guide/#twitter) |
|||
#' regarding image sizes. |
|||
#' @param html_title the title for the `htmlwidget` HTML file's `<title>` tag. |
|||
#' @param card_twitter_handle Your twitter handle _including_ the `@@`. |
|||
#' @param card_title,card_description The title and description that will be displayed in the tweet |
|||
#' @param card_image_url_prefix Prefix URL for where you will be copying the preview image to. |
|||
#' Generally, this wil be the same as `card_player_url_prefix` but you can specify |
|||
#' another URL prefix if storing images on a separate server or separate directory. |
|||
#' @param card_player_url_prefix Prefix URL for where you will be copying the `htmlwidget` |
|||
#' HTML and supporting javascript libraries to. Generally, this wil be the same as |
|||
#' `card_image_url_prefix` but you can specify another URL prefix if storing images |
|||
#' on a separate server or separate directory. |
|||
#' @param card_player_width,card_player_height the width and height for the player window in-tweet. |
|||
#' These default to 480x480 and you should review the References section for |
|||
#' links to guidelines for Twitter preferred image sizes. |
|||
#' @param background `htmlwidget` background coloe. Defaults to `white`. Can be a hashed-prefixed |
|||
#' hex value (if so, will be converted to `rgba()` spec) |
|||
#' @param bundle_type either `tgz` for a gzip'd/tar archive or `zip` for a ZIP archive. The |
|||
#' directory named `name_prefix` will be placed into the archive. |
|||
#' @return the `path.expand()`ed path to the `bundle_type`. The archive name will be `name_prefix` |
|||
#' plus the `bundle_type` extension. |
|||
#' @note You can and should use [Twitter's Validator](https://cards-dev.twitter.com/validator) |
|||
#' to ensure your creation is usable before trying it in a tweet. |
|||
#' @references |
|||
#' - <https://developer.twitter.com/en/docs/tweets/optimize-with-cards/overview/player-card.html> |
|||
#' - <https://sproutsocial.com/insights/social-media-image-sizes-guide/#twitter> |
|||
#' - <https://github.com/twitterdev/cards-player-samples> |
|||
#' @export |
|||
card_widget <- function(widget, |
|||
output_dir = ulid::ulid_generate(), |
|||
name_prefix = "wdgtcrd", |
|||
preview_img, |
|||
html_title = class(widget)[[1]], |
|||
card_twitter_handle = "", |
|||
card_title = title[[1]], |
|||
card_description = "", |
|||
card_image_url_prefix = "", |
|||
card_player_url_prefix = "", |
|||
card_player_width = 480, |
|||
card_player_height = 480, |
|||
background = "white", |
|||
bundle_type = c("tgz", "zip")) { |
|||
|
|||
bundle_type <- match.arg(bundle_type[[1]], c("tgz", "zip")) |
|||
|
|||
# convert background to rgba spec if hex |
|||
|
|||
if (grepl("^#", background[[1]], perl = TRUE)) { |
|||
bgcol <- grDevices::col2rgb(background[[1]], alpha = TRUE) |
|||
background <- sprintf( |
|||
"rgba(%d,%d,%d,%f)", |
|||
bgcol[1, 1], bgcol[2, 1], bgcol[3, 1], (bgcol[4, 1] / 255) |
|||
) |
|||
} |
|||
|
|||
# setup output |
|||
|
|||
output_dir <- path.expand(output_dir[[1]]) |
|||
preview_img <- path.expand(preview_img[[1]]) |
|||
|
|||
stopifnot(file.exists(preview_img)) # can't find preview img |
|||
|
|||
if (!dir.exists(output_dir)) dir.create(output_dir, recursive=TRUE) |
|||
|
|||
file.copy( |
|||
from = preview_img, |
|||
to = file.path( |
|||
output_dir, |
|||
sprintf("%s.%s", name_prefix, tools::file_ext(preview_img)) |
|||
) |
|||
) |
|||
|
|||
toHTML( |
|||
x = widgetframe::frameableWidget(widget), |
|||
standalone = FALSE |
|||
) -> widget_html |
|||
|
|||
libdir <- paste(tools::file_path_sans_ext(basename(name_prefix)), "_files", sep = "") |
|||
|
|||
card_image_url_prefix <- sub("/$", "", card_image_url_prefix) |
|||
card_player_url_prefix <- sub("/$", "", card_player_url_prefix) |
|||
|
|||
file.path( |
|||
card_image_url_prefix, |
|||
sprintf("%s.%s", name_prefix, tools::file_ext(preview_img)) |
|||
) -> card_image_url |
|||
|
|||
file.path( |
|||
card_player_url_prefix, sprintf("%s.html", name_prefix) |
|||
) -> card_player_url |
|||
|
|||
htmltools::tagList( |
|||
htmltools::tags$head( |
|||
htmltools::tags$title(html_title), |
|||
htmltools::tags$meta(name = "twitter:card", content = "player"), |
|||
htmltools::tags$meta(name = "twitter:site", content = card_twitter_handle), |
|||
htmltools::tags$meta(name = "twitter:title", content = card_title), |
|||
htmltools::tags$meta(name = "twitter:description", content = card_description), |
|||
htmltools::tags$meta(name = "twitter:image", content = card_image_url), |
|||
htmltools::tags$meta(name = "twitter:player", content = card_player_url), |
|||
htmltools::tags$meta(name = "twitter:player:width", content = card_player_width), |
|||
htmltools::tags$meta(name = "twitter:player:height", content = card_player_height) |
|||
), |
|||
widget_html |
|||
) -> widget_html |
|||
|
|||
htmltools::save_html( |
|||
html = widget_html, |
|||
file = file.path(output_dir, sprintf("%s.html", name_prefix)), |
|||
libdir = libdir, |
|||
background = background |
|||
) |
|||
|
|||
cd <- getwd() |
|||
on.exit(setwd(cd), add=TRUE) |
|||
|
|||
setwd(sprintf("%s/..", output_dir)) |
|||
|
|||
if (bundle_type == "tgz") { |
|||
arc_name <- sprintf("%s.tgz", output_dir) |
|||
utils::tar( |
|||
tarfile = arc_name, |
|||
files = name_prefix, |
|||
compression = "gzip" |
|||
) |
|||
} else { |
|||
arc_name <- sprintf("%s.zip", output_dir) |
|||
utils::zip( |
|||
zipfile = arc_name, |
|||
files = name_prefix |
|||
) |
|||
} |
|||
|
|||
arc_name |
|||
|
|||
} |
|||
@ -1,12 +1,13 @@ |
|||
#' ... |
|||
#' |
|||
#' Tools to Enable Easier Content Embedding in Tweets |
|||
#' |
|||
#' - URL: <https://gitlab.com/hrbrmstr/widgetcard> |
|||
#' - BugReports: <https://gitlab.com/hrbrmstr/widgetcard/issues> |
|||
#' |
|||
#' |
|||
#' @md |
|||
#' @name widgetcard |
|||
#' @keywords internal |
|||
#' @docType package |
|||
#' @author Bob Rudis (bob@@rud.is) |
|||
#' @import httr |
|||
#' @importFrom jsonlite fromJSON |
|||
#' @import htmltools htmlwidgets widgetframe |
|||
#' @importFrom ggplot2 ggsave |
|||
NULL |
|||
|
|||
@ -0,0 +1,77 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/widget-card.R |
|||
\name{card_widget} |
|||
\alias{card_widget} |
|||
\title{Turn an htmlwidget into a web deployable, interactive Twitter card} |
|||
\usage{ |
|||
card_widget(widget, output_dir = ulid::ulid_generate(), |
|||
name_prefix = "wdgtcrd", preview_img, |
|||
html_title = class(widget)[[1]], card_twitter_handle = "", |
|||
card_title = title[[1]], card_description = "", |
|||
card_image_url_prefix = "", card_player_url_prefix = "", |
|||
card_player_width = 480, card_player_height = 480, |
|||
background = "white", bundle_type = c("tgz", "zip")) |
|||
} |
|||
\arguments{ |
|||
\item{widget}{an \code{htmlwidget}} |
|||
|
|||
\item{output_dir}{the path to save the card-able widget to. If the directory does |
|||
not exist it will be created for you (recursively). The value will be |
|||
\code{\link[=path.expand]{path.expand()}}ed.} |
|||
|
|||
\item{name_prefix}{the name-prefix for the widget's \code{.html} file and \code{preview_img} file.} |
|||
|
|||
\item{preview_img}{the path to the local preview image for the card-able widget. This |
|||
file must exist and will be copied over to the deployable directory and renamed |
|||
(see \code{name_prefix} above). Follow the guidelines |
|||
\href{https://sproutsocial.com/insights/social-media-image-sizes-guide/#twitter}{here} |
|||
regarding image sizes.} |
|||
|
|||
\item{html_title}{the title for the \code{htmlwidget} HTML file's \code{<title>} tag.} |
|||
|
|||
\item{card_twitter_handle}{Your twitter handle \emph{including} the \code{@}.} |
|||
|
|||
\item{card_title, card_description}{The title and description that will be displayed in the tweet} |
|||
|
|||
\item{card_image_url_prefix}{Prefix URL for where you will be copying the preview image to. |
|||
Generally, this wil be the same as \code{card_player_url_prefix} but you can specify |
|||
another URL prefix if storing images on a separate server or separate directory.} |
|||
|
|||
\item{card_player_url_prefix}{Prefix URL for where you will be copying the \code{htmlwidget} |
|||
HTML and supporting javascript libraries to. Generally, this wil be the same as |
|||
\code{card_image_url_prefix} but you can specify another URL prefix if storing images |
|||
on a separate server or separate directory.} |
|||
|
|||
\item{card_player_width, card_player_height}{the width and height for the player window in-tweet. |
|||
These default to 480x480 and you should review the References section for |
|||
links to guidelines for Twitter preferred image sizes.} |
|||
|
|||
\item{background}{\code{htmlwidget} background coloe. Defaults to \code{white}. Can be a hashed-prefixed |
|||
hex value (if so, will be converted to \code{rgba()} spec)} |
|||
|
|||
\item{bundle_type}{either \code{tgz} for a gzip'd/tar archive or \code{zip} for a ZIP archive. The |
|||
directory named \code{name_prefix} will be placed into the archive.} |
|||
} |
|||
\value{ |
|||
the \code{path.expand()}ed path to the \code{bundle_type}. The archive name will be \code{name_prefix} |
|||
plus the \code{bundle_type} extension. |
|||
} |
|||
\description{ |
|||
Provide a preview image and a widget, plus Twitter Player card metadata and get pack |
|||
a packaged up, ready-to-deploy archive to deploy and used on Twitter. |
|||
} |
|||
\details{ |
|||
You can use \href{https://cards-dev.twitter.com/validator}{Twitter's Validator} to ensure |
|||
your creation is usable before trying it in a tweet. |
|||
} |
|||
\note{ |
|||
You can and should use \href{https://cards-dev.twitter.com/validator}{Twitter's Validator} |
|||
to ensure your creation is usable before trying it in a tweet. |
|||
} |
|||
\references{ |
|||
\itemize{ |
|||
\item \url{https://developer.twitter.com/en/docs/tweets/optimize-with-cards/overview/player-card.html} |
|||
\item \url{https://sproutsocial.com/insights/social-media-image-sizes-guide/#twitter} |
|||
\item \url{https://github.com/twitterdev/cards-player-samples} |
|||
} |
|||
} |
|||
@ -0,0 +1,26 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/gg-preview.R |
|||
\name{gg_preview} |
|||
\alias{gg_preview} |
|||
\title{Generate a Twitter Player card preview image from a ggplot2 plot} |
|||
\usage{ |
|||
gg_preview(gg, width = 350/72, height = 196/72, dpi = "retina") |
|||
} |
|||
\arguments{ |
|||
\item{gg}{ggplot2 plot object} |
|||
|
|||
\item{width, height}{width and height of the preview image. See References for guidelines} |
|||
} |
|||
\value{ |
|||
path to the preview image tempfile |
|||
} |
|||
\description{ |
|||
Takes arguments similar to \code{\link[ggplot2:ggsave]{ggplot2::ggsave()}} and creates a temporary |
|||
plot file (png) to be used as input to \code{\link[=card_widget]{card_widget()}}. |
|||
} |
|||
\references{ |
|||
\itemize{ |
|||
\item \url{https://developer.twitter.com/en/docs/tweets/optimize-with-cards/overview/player-card.html} |
|||
\item \url{https://sproutsocial.com/insights/social-media-image-sizes-guide/#twitter} |
|||
} |
|||
} |
|||
@ -0,0 +1,2 @@ |
|||
*.html |
|||
*.R |
|||
@ -0,0 +1,142 @@ |
|||
--- |
|||
title: "Creating Interactive Twitter Player Cards" |
|||
author: "Bob Rudis" |
|||
date: "`r Sys.Date()`" |
|||
output: rmarkdown::html_vignette |
|||
vignette: > |
|||
%\VignetteIndexEntry{Creating Interactive Twitter Player Cards} |
|||
%\VignetteEncoding{UTF-8} |
|||
%\VignetteEngine{knitr::rmarkdown} |
|||
editor_options: |
|||
chunk_output_type: console |
|||
--- |
|||
|
|||
```{r setup, include = FALSE} |
|||
knitr::opts_chunk$set( |
|||
collapse = TRUE, |
|||
comment = "##" |
|||
) |
|||
``` |
|||
|
|||
Twitter supports [player cards](https://developer.twitter.com/en/docs/tweets/optimize-with-cards/overview/player-card.html) which means you can use R-generated `htmlwidgets` as fully |
|||
interactrive pieces in Tweets. You don't absolutely need this package to make these cards, but |
|||
hopefully this removes much of the friction. Here's an example workflow. |
|||
|
|||
First, make a plot! |
|||
|
|||
```{r fake-libs, eval=FALSE} |
|||
library(ssh) |
|||
library(plotly) |
|||
library(ggplot2) |
|||
library(widgetcard) |
|||
|
|||
ggplot(mtcars, aes(wt, mpg)) + |
|||
geom_point() -> gg |
|||
|
|||
gg |
|||
``` |
|||
```{r real-libs, echo=FALSE, eval=TRUE, message=FALSE, warning=FALSE} |
|||
library(plotly) |
|||
library(ggplot2) |
|||
library(widgetcard) |
|||
|
|||
ggplot(mtcars, aes(wt, mpg)) + |
|||
geom_point() -> gg |
|||
|
|||
gg |
|||
``` |
|||
|
|||
Now, we create a local preview image for the plot we just made since we need one for the card: |
|||
|
|||
```{r preview, eval=FALSE} |
|||
preview <- gg_preview(gg) |
|||
``` |
|||
|
|||
NOTE that you can use _any_ image you want. This streamlines the process for plotly plots |
|||
created from ggplot2 plots. |
|||
|
|||
Now, we convert our ggplot2 object to a plotly object and create the Twitter Player card. |
|||
Note that Twitter really doesn't like standalone widgets being used as Twitter Player card |
|||
links due to their heavyweight size. Therefore, `card_widget()` creats a non-standalone |
|||
widget but bundles everything up into a single directory and deployable archive. |
|||
|
|||
```{r card-it, eval=FALSE} |
|||
ggplotly(gg) %>% |
|||
card_widget( |
|||
output_dir = "~/widgets/tc", |
|||
name_prefix = "tc", |
|||
preview_img = preview, |
|||
html_title = "A way better title", |
|||
card_twitter_handle = "@hrbrmstr", |
|||
card_title = "Basic ggplot2 example", |
|||
card_description = "This is a sample caRd demonstrating card_widget()", |
|||
card_image_url_prefix = "https://rud.is/vis/tc/", |
|||
card_player_url_prefix = "https://rud.is/vis/tc/", |
|||
card_player_width = 480, |
|||
card_player_height = 480 |
|||
) -> arch_fil |
|||
``` |
|||
|
|||
Here's what the resulting directory structure looks like: |
|||
|
|||
``` |
|||
tc |
|||
├── tc.html |
|||
├── tc.png |
|||
└── tc_files |
|||
├── crosstalk-1.0.0 |
|||
│ ├── css |
|||
│ │ └── crosstalk.css |
|||
│ └── js |
|||
│ ├── crosstalk.js |
|||
│ ├── crosstalk.js.map |
|||
│ ├── crosstalk.min.js |
|||
│ └── crosstalk.min.js.map |
|||
├── htmlwidgets-1.3 |
|||
│ └── htmlwidgets.js |
|||
├── jquery-1.11.3 |
|||
│ ├── jquery-AUTHORS.txt |
|||
│ ├── jquery.js |
|||
│ ├── jquery.min.js |
|||
│ └── jquery.min.map |
|||
├── plotly-binding-4.8.0 |
|||
│ └── plotly.js |
|||
├── plotly-htmlwidgets-css-1.39.2 |
|||
│ └── plotly-htmlwidgets.css |
|||
├── plotly-main-1.39.2 |
|||
│ └── plotly-latest.min.js |
|||
├── pymjs-1.3.2 |
|||
│ ├── pym.v1.js |
|||
│ └── pym.v1.min.js |
|||
└── typedarray-0.1 |
|||
└── typedarray.min.js |
|||
``` |
|||
|
|||
(There's also a `tc.tgz` at the same level as the `tc` directory.) |
|||
|
|||
The widget is `iframe`d using `widgetframe` and then saved out using `htmlwidgets::saveWidget()`. |
|||
|
|||
Now, for deploying this to a web server, one could use a method like this to `scp` the |
|||
deployable archive: |
|||
|
|||
```{r deploy, eval=FALSE} |
|||
sess <- ssh_connect(Sys.getenv("SSH_HOST")) |
|||
|
|||
invisible(scp_upload( |
|||
sess, files = arch_fil, Sys.getenv("REMOTE_VIS_DIR"), verbose = FALSE |
|||
)) |
|||
|
|||
ssh_exec_wait( |
|||
sess, |
|||
command = c( |
|||
sprintf("cd %s", Sys.getenv("REMOTE_VIS_DIR")), |
|||
sprintf("tar -xzf %s", basename(arch_fil)) |
|||
) |
|||
) |
|||
``` |
|||
|
|||
Alternatively, you can use other workflows to transfer and expand the archive _or_ copy |
|||
output to your static blog host. |
|||
|
|||
Don't forget to use Twitter's [validator](https://cards-dev.twitter.com/validator) to make sure |
|||
your interactive player widget works before posting it in a Tweet! |
|||
Loading…
Reference in new issue