R/image_export.R

In scimesh: Headless Publication-Quality 3D Mesh Rendering Engine

#' Convert a rendered image to an RGBA array
#'
#' Converts the output of \code{render_mesh()} or \code{render_scene()}
#' into a 3-dimensional R array of dimensions (height x width x 4) with
#' RGBA channels.
#'
#' @param image An image list returned by \code{render_mesh()} or
#'   \code{render_scene()}.
#' @return A 3D array of dimensions (height, width, 4) with values in
#'   \code{[0, 1]}.
#'
#' @examples
#' mesh <- generate_cuboid(c(0, 0, 0), c(1, 1, 1))
#' img <- render_mesh(mesh$vertices, mesh$triangles)
#' arr <- image_to_array(img)
#' dim(arr)  # height x width x 4
#'
#' @export
image_to_array <- function(image) {
    if (!is.list(image) || is.null(image$pixels)) {
        stop("image must be a renderer output list with 'pixels' component")
    }
    vals <- as.numeric(image$pixels) / 255.0
    w <- image$width
    h <- image$height
    # C++ data is row-major RGBA interleaved: pixel(y,x) at (y*W+x)*4.
    # array(vals, dim=c(4,W,H)) matches this layout, then aperm to (H,W,4).
    arr <- array(vals, dim = c(4L, w, h))
    aperm(arr, c(3L, 2L, 1L))
}

#' Write a rendered image to a PNG file
#'
#' Writes the output of \code{render_mesh()} or \code{render_scene()}
#' to a PNG file using the built-in C++ PNG writer (stb_image_write).
#' No additional R packages are required.
#'
#' @param image An image list returned by \code{render_mesh()} or
#'   \code{render_scene()}.
#' @param filename Output PNG file path.
#'
#' @examples
#' mesh <- generate_cuboid(c(0, 0, 0), c(1, 1, 1))
#' img <- render_mesh(mesh$vertices, mesh$triangles)
#' tmp_file <- tempfile(fileext = ".png")
#' write_png(img, tmp_file)
#'
#' @return No return value; called for side effects.
#'
#' @export
write_png <- function(image, filename) {
    invisible(scimesh_write_png(image, filename))
}

#' Apply contrast adjustment to an image
#'
#' Applies a contrast stretch (S-curve) to the RGB channels of a
#' rendered image.  Formula: \code{(value - 0.5) * contrast + 0.5},
#' clamped to \code{[0, 1]}.  The default 1.0 means no change.
#' Values > 1.0 produce darker darks and lighter highlights.
#'
#' @param image An image list returned by \code{render_mesh()} or
#'   \code{render_scene()}.
#' @param contrast Contrast multiplier.  Default 1.0 (no change).
#'   Typical values: 1.1--1.2 for subtle S-curve, 1.5 for strong.
#' @return A new image list with contrast-adjusted pixel data.
#'
#' @examples
#' cube <- generate_cuboid(c(0, 0, 0), c(1, 1, 1))
#' img <- render_mesh(cube$vertices, cube$triangles)
#' img <- image_apply_contrast(img, contrast = 1.1)
#'
#'
#' @export
image_apply_contrast <- function(image, contrast = 1.0) {
    scimesh_image_apply_contrast(image, as.numeric(contrast))
}

#' Crop an image to a rectangular region
#'
#' @param image An image list returned by \code{render_mesh()} or similar.
#' @param x Left edge of the crop region (0-based pixel coordinate).
#' @param y Top edge of the crop region (0-based pixel coordinate).
#' @param w Crop width in pixels.
#' @param h Crop height in pixels.
#' @return A new image list with the cropped dimensions.
#'
#' @examples
#' cube <- generate_cuboid(c(0, 0, 0), c(1, 1, 1))
#' img <- render_mesh(cube$vertices, cube$triangles)
#' img <- image_crop(img, 100, 50, 400, 300)
#'
#' @export
image_crop <- function(image, x, y, w, h) {
    scimesh_image_crop(image, as.integer(x), as.integer(y),
                       as.integer(w), as.integer(h))
}

#' Merge two images side by side or stacked
#'
#' Merges another image into this one at the specified edge.
#' For left/right merging, the heights must match. For top/bottom, the
#' widths must match.
#'
#' @param image An image list.
#' @param other Another image list.
#' @param direction One of \code{"left"}, \code{"right"}, \code{"top"}, \code{"bottom"}.
#' @return A new image list with the merged dimensions.
#'
#' @examples
#' cube <- generate_cuboid(c(0, 0, 0), c(1, 1, 1))
#' sphere <- generate_sphere(c(0, 0, 0), radius = 0.5)
#' left  <- render_mesh(sphere$vertices, sphere$triangles)
#' right <- render_mesh(cube$vertices, cube$triangles)
#' merged <- image_merge(left, right, "right")
#'
#' @export
image_merge <- function(image, other, direction) {
    direction <- match.arg(direction, c("left", "right", "top", "bottom"))
    scimesh_image_merge(image, other, direction)
}

#' Grow an image by adding padding
#'
#' Expands the canvas by adding pixel rows/columns filled with a
#' background colour.
#'
#' @param image An image list.
#' @param top Number of pixel rows to add above.
#' @param bottom Number of pixel rows to add below.
#' @param left Number of pixel columns to add to the left.
#' @param right Number of pixel columns to add to the right.
#' @param background Numeric vector of length 4 with RGBA values in
#'   \code{[0, 1]}.
#' @return A new image list with the expanded dimensions.
#'
#' @examples
#' cube <- generate_cuboid(c(0, 0, 0), c(1, 1, 1))
#' img <- render_mesh(cube$vertices, cube$triangles)
#' img <- image_grow(img, 10, 10, 20, 20, c(1, 1, 1, 1))
#'
#' @export
image_grow <- function(image, top, bottom, left, right, background) {
    if (!is.numeric(background) || length(background) != 4) {
        stop("background must be a numeric vector of length 4 (RGBA)")
    }
    scimesh_image_grow(image, as.integer(top), as.integer(bottom),
                       as.integer(left), as.integer(right), background)
}

#' Rotate an image by 90 degrees
#'
#' @param image An image list.
#' @param clockwise Logical, if \code{TRUE} (default) rotates clockwise,
#'   otherwise counter-clockwise.
#' @return A new image list with width and height swapped.
#'
#' @export
image_rotate_90 <- function(image, clockwise = TRUE) {
    scimesh_image_rotate_90(image, isTRUE(clockwise))
}

#' Scale an image (nearest-neighbour)
#'
#' Resizes the image to the given dimensions using nearest-neighbour
#' interpolation.
#'
#' @param image An image list.
#' @param new_width Target width in pixels.
#' @param new_height Target height in pixels.
#' @return A new image list with the new dimensions.
#'
#' @export
image_scale <- function(image, new_width, new_height) {
    scimesh_image_scale(image, as.integer(new_width), as.integer(new_height))
}

#' Crop an image to its content bounding box
#'
#' Removes background-coloured margin from the specified edges of the
#' image. The first non-background pixel found on each edge defines the
#' crop boundary.
#'
#' @param image An image list.
#' @param direction One of \code{"left"}, \code{"right"},
#'   \code{"horizontal"} (both left and right), \code{"top"},
#'   \code{"bottom"}, \code{"vertical"} (both top and bottom), or
#'   \code{"all"} (all four sides).
#' @param background Numeric vector of length 4 with RGBA values in
#'   \code{[0, 1]} defining the background colour to crop away.
#' @return A new image list with cropped dimensions.
#'
#' @examples
#' cube <- generate_cuboid(c(0, 0, 0), c(1, 1, 1))
#' img <- render_mesh(cube$vertices, cube$triangles,
#'                    options = render_options(background_color = c(0, 0, 0, 0)))
#' img <- image_crop_to_content(img, "all", c(0, 0, 0, 0))
#'
#'
#' @export
image_crop_to_content <- function(image, direction, background) {
    direction <- match.arg(direction, c("left", "right", "horizontal",
                                        "top", "bottom", "vertical", "all"))
    if (!is.numeric(background) || length(background) != 4) {
        stop("background must be a numeric vector of length 4 (RGBA)")
    }
    scimesh_image_crop_to_content(image, direction, background)
}