## ----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")