inst/doc/stopmotion.R

In stopmotion: Build Stop Motion Animations from Image Sequences

## ----options------------------------------------------------------------------
#| eval: true
#| include: false
library(magick)
library(stopmotion)

stopmotion_verbosity(FALSE) # silence for the rest of the session
options(stopmotion.verbose = FALSE) # equivalent


## ----load---------------------------------------------------------------------
#| eval: true
dino_dir <- system.file("extdata", package = "stopmotion")
dino <- read(dir = dino_dir)
dino |> preview(fps = 2)


## ----frame-count--------------------------------------------------------------
#| eval: true
cat("Number of frames:", length(dino), "\n")
image_info(dino)[, c("width", "height", "filesize")]


## ----montage------------------------------------------------------------------
#| eval: true
#| fig-width: 7
#| fig-height: 2.5
montage(dino, tile = "10x1", geometry = "64x64+2+2")


## ----wiggle-------------------------------------------------------------------
#| eval: true
dino_w <- wiggle(dino, degrees = 2, frames = 1:3)
cat("Total frames after wiggle():", length(dino_w), "\n")


## ----dup-frames---------------------------------------------------------------
#| eval: true
dino2 <- duplicate(dino, frames = 5:6, style = "looped")
cat("Frames after duplicate():", length(dino2), "\n")


## ----border-------------------------------------------------------------------
#| eval: true
dino3 <- border(dino2, color = "red", geometry = "8x8", frames = 7:11)


## ----blur---------------------------------------------------------------------
#| eval: true
dino4 <- blur(dino3, radius = 3, sigma = 1.5, frames = 8:10)


## ----pipeline-----------------------------------------------------------------
#| eval: true
read(dir = system.file("extdata", package = "stopmotion")) |>
  wiggle(degrees = 2, frames = 1:3) |>             # hand-held shake
  duplicate(frames = 5:6, style = "looped") |>     # hold the charge
  border(color = "red", geometry = "8x8",
          frames = 7:11) |>                        # danger border
  blur(radius = 3, sigma = 1.5, frames = 8:10) |>  # energy blur
  preview(fps = 2)


## ----export-------------------------------------------------------------------
out <- tempfile(fileext = ".gif")
image_write_gif(dino_final, path = out, delay = 1 / 8)
message("Saved to: ", out)


## ----somersault-flop----------------------------------------------------------
#| eval: true
# Frames 1–2: mirror horizontally so the dino faces left (run-up)
dino_s <- flop(dino, frames = 1:2)


## ----somersault-rotate1-------------------------------------------------------
#| eval: true
# Frame 3: rotate 90° — leaning forward into the jump
dino_s <- rotate(dino_s, degrees = 90, frames = 3L)


## ----somersault-flip----------------------------------------------------------
#| eval: true
# Frame 4: flip vertically — upside-down at the apex of the somersault
dino_s <- flip(dino_s, frames = 4L)


## ----somersault-rotate2-------------------------------------------------------
#| eval: true
# Frame 5: rotate 270° — coming back around to land upright
dino_s <- rotate(dino_s, degrees = 270, frames = 5L)


## ----somersault-loop----------------------------------------------------------
#| eval: true
# Duplicate the spin frames so the dino does two full somersaults
dino_s <- duplicate(dino_s, frames = 1:5, style = "looped")
cat("Frames after duplication:", length(dino_s), "\n")


## ----somersault-pipeline------------------------------------------------------
#| eval: true
dino_somersault <- dino |>
  flop(frames = 1:2)               |>   # run-up: face left
  rotate(degrees = 90,  frames = 3L) |> # lean into the jump
  flip(frames = 4L)                |>   # upside-down apex
  rotate(degrees = 270, frames = 5L) |> # complete the circle
  duplicate(frames = 1:5, style = "looped") # loop it twice

montage(dino_somersault[1:10], tile = "10x1", geometry = "64x64+2+2")


## ----somersault-preview-------------------------------------------------------
#| eval: true
dino_somersault |> preview(fps = 2)


## ----splice-------------------------------------------------------------------
# Insert a custom "RAWR!" title card after frame 4
title_card <- image_blank(480, 480, color = "black") |>
  image_annotate("RAWR!", size = 80, color = "red", gravity = "Center")

dino_with_title <- splice(dino, insert = title_card, after = 4L)


## ----scale--------------------------------------------------------------------
dino_small <- scale(dino, geometry = "50%")


## ----crop---------------------------------------------------------------------
# Keep a 200×200 window centred on the head (adjust offsets to taste)
dino_face <- crop(dino, geometry = "200x200+140+60")


## ----centre-locator-----------------------------------------------------------
# Run once per editing session — requires an interactive graphics device.
# Display each frame, click the two landmarks, store the coordinates.
pts_list <- lapply(seq_along(dino), function(i) {
  plot(as.raster(dino[i])) # display frame i
  message("Frame ", i, ": click LEFT eye then RIGHT eye")
  p <- locator(2L) # two clicks; y is from the bottom edge
  data.frame(frame = i, x = p$x, y = p$y)
})
pts <- do.call(rbind, pts_list)


## ----centre-------------------------------------------------------------------
#| eval: true
# Introduce known translational drift.  Two widely-spaced control-point pairs
# both encoding the same displacement define a pure translation.
# Coordinates are in ImageMagick top-edge convention for image_distort.
dino_d <- c(
  dino[1],
  magick::image_distort(dino[2], "Affine",        # +5 right, +3 down
    c(100, 100, 105, 103,  380, 380, 385, 383)),
  magick::image_distort(dino[3], "Affine",        # −4 left, +2 down
    c(100, 100,  96, 102,  380, 380, 376, 382)),
  dino[4:10]
)

# Eye positions in the drifted sequence — y from the bottom edge (locator convention).
# Frame 1 reference (unchanged):       left (212, 271), right (272, 270).
# Frame 2 shifted (+5 right, +3 down): left (217, 268), right (277, 267).
# Frame 3 shifted (−4 left,  +2 down): left (208, 269), right (268, 268).
pts <- data.frame(
  frame = c(1L, 1L, 2L, 2L, 3L, 3L),
  x     = c(212, 272, 217, 277, 208, 268),
  y     = c(271, 270, 268, 267, 269, 268)
)

# Correct only the drifted frames; leave 4–10 untouched.
dino_stabilised <- centre(dino_d, points = pts, reference = 1L, frames = 2:3)


## ----centre-compare-----------------------------------------------------------
#| eval: true
montage(dino_d[1:3],          tile = "3x1", geometry = "128x128+2+2")
montage(dino_stabilised[1:3], tile = "3x1", geometry = "128x128+2+2")