initial import

.gitignore

@@ -0,0 +1 @@
+*~

DESCRIPTION

@@ -0,0 +1,13 @@
+Package: director
+Type: Package
+Title: Automate video demonstrations
+Version: 0.1
+Date: 2016-11-30
+Author: Paul Murrell
+Maintainer: Paul Murrell <paul@stat.auckland.ac.nz>
+Description: Provides R functions to automate the production of
+             demonstration videos with audio commentary, all based
+             on a single XML script.
+Imports: wmctrl, xdotool, ffmpeg, xml2, tuneR
+License: GPL-3
+SystemRequirements: espeak

NAMESPACE

@@ -0,0 +1,20 @@
+
+import("wmctrl")
+import("xdotool")
+import("ffmpeg")
+
+importFrom("xml2",
+           "read_xml",
+           "xml_find_first",
+           "xml_find_all",
+           "xml_attr",
+           "xml_text")
+
+importFrom("tuneR",
+           "Wave",
+           "readWave",
+           "writeWave",
+           "prepComb",
+           "bind")
+
+export("shootVideo")

R/audio.R

@@ -0,0 +1,54 @@
+
+## Record all dialogue
+recordDialogue <- function(script, wd) {
+
+    ## Create audio files
+    shots <- script$shots
+    infiles <- file.path(wd,
+                         paste0("shot-", shots[, "shotLabel"], "-audio.txt"))
+    outfiles <- file.path(wd,
+                          paste0("shot-", shots[, "shotLabel"], "-audio.wav"))
+    for (i in 1:nrow(shots)) {
+        writeLines(shots[i, "dialogue"], infiles[i])
+        system(paste("espeak -s 125 -v en -w", outfiles[i], "-f", infiles[i]))
+        ## ALL shots will be combined with something else at some point
+        ## so prep them now
+        wav <- readWave(outfiles[i])
+        writeWave(prepComb(wav, where="end"), outfiles[i])
+    }
+
+    ## Return paths to audio files
+    outfiles
+}
+
+audioLength <- function(wav) {
+    length(wav@left)/wav@samp.rate
+}
+
+audioDuration <- function(audioFiles) {
+    sapply(audioFiles,
+           function(x) {
+               wav <- readWave(x)
+               audioLength(wav)
+           })
+}
+
+padAudio <- function(audioFiles, audioDurations, shotDurations) {
+    paddedAudioFiles <- gsub("[.]wav$", "-padded.wav", audioFiles)
+    for (i in seq_along(audioFiles)) {
+        audioWav <- readWave(audioFiles[i])
+        ## NOTE that all audio was prepared for combining
+        ## when it was recorded
+        if (shotDurations[i] > audioDurations[i]) {
+            difference <- shotDurations[i] - audioDurations[i]
+            silence <- Wave(rep(0, difference*audioWav@samp.rate), 
+                            samp.rate=audioWav@samp.rate,
+                            bit=audioWav@bit)
+            paddedAudio <- bind(audioWav, silence)
+        } else {
+            paddedAudio <- audioWav
+        }
+        writeWave(paddedAudio, paddedAudioFiles[i])
+    }
+    paddedAudioFiles
+}

R/code.R

@@ -0,0 +1,89 @@
+
+lineDuration <- function(line, delay) {
+    nspaces <- sum(gregexpr("\\s", line, perl=TRUE)[[1]] > -1)
+    (nchar(line) - nspaces)*delay/1000
+}
+
+chunkDuration <- function(chunk, keydelay, linedelay) {
+    lines <- strsplit(chunk, "\n")[[1]]
+    if (length(lines)) {
+        sum(sapply(lines, lineDuration, keydelay)) +
+            linedelay/1000*(length(lines) - 1)
+    } else {
+        0
+    }
+}
+
+codeDuration <- function(script) {
+    shots <- script$shots
+    echo <- as.logical(shots[, "echo"])
+    code <- shots[, "code"]
+    keydelays <- as.numeric(shots[, "keydelay"])
+    linedelays <- as.numeric(shots[, "linedelay"])
+    durations <- mapply(chunkDuration, code, keydelays, linedelays)
+    ifelse(echo, durations, 0)
+}
+
+getLocationWindow <- function(loc, locations) {
+    index <- locations[, "label"] == loc
+    if (!any(index)) {
+        NA
+    } else {
+        locations[index, "windowID"]
+    }
+}
+
+recordAction <- function(script, locations, durations, wd) {
+
+    ## Create video files
+    shots <- script$shots
+    outfiles <- file.path(wd,
+                          paste0("shot-", shots[, "shotLabel"],
+                                 "-code-video.webm"))
+
+    for (i in 1:nrow(shots)) {
+        ## Start recording
+        w <- shots[i, "width"]
+        if (is.na(w)) {
+            w <- script$stage$width
+        }
+        h <- shots[i, "height"]
+        if (is.na(h)) {
+            h <- script$stage$height
+        }
+        ffmpeg(screenInput(w=as.numeric(w), h=as.numeric(h),
+                           duration=durations[i]), 
+               fileOutput(outfiles[i], vcodec="VP8"),
+               overwrite=TRUE, wait=FALSE)
+
+        ## Record time shot starts
+        start <- proc.time()[3]
+
+        ## Focus relevant window
+        loc <- shots[i, "location"]
+        if (!is.na(loc)) {
+            focusWindow(getLocationWindow(loc, locations))
+        }
+
+        ## "type" code in window
+        if (as.logical(shots[i, "echo"])) {
+            lines <- strsplit(shots[i, "code"], "\n")[[1]]
+            for (j in seq_along(lines)) {
+                typestring(paste0(lines[j], "\n"),
+                           delay=as.numeric(shots[i, "keydelay"]))
+                Sys.sleep(as.numeric(shots[i, "linedelay"])/1000)
+            }
+        } else {
+            ## (or just evaluate it if echo is FALSE)
+            source(textConnection(shots[i, "code"]), new.env())
+        }
+
+        ## Pause if necessary until end of shot
+        while (proc.time()[3] - start < durations[i]) {
+            Sys.sleep(.1)
+        }
+    }
+
+    ## Return paths to video files
+    outfiles
+}

R/director.R

@@ -0,0 +1,26 @@
+
+shootVideo <- function(filename,
+                       wd=paste0(gsub("[.]xml$", "", filename), "-video"),
+                       clean=FALSE) {
+
+    if (clean) {
+        ## Clear working directory
+        if (dir.exists(wd)) {
+            unlink(wd, recursive=TRUE, force=TRUE)
+        }
+    }
+    if (!dir.exists(wd)) {
+        dir.create(wd)
+    }
+
+    script <- readScript(filename)
+    audioFiles <- recordDialogue(script, wd)
+    audioLength <- audioDuration(audioFiles)
+    codeLength <- codeDuration(script)
+    shotLength <- calculateTiming(script, audioLength, codeLength)
+    locations <- setStage(script$stage)
+    paddedAudioFiles <- padAudio(audioFiles, audioLength, shotLength)
+    videoFiles <- recordAction(script, locations, shotLength, wd)
+    exitStage(locations)
+    muxAudioVideo(script, paddedAudioFiles, videoFiles, wd)
+}

R/read.R

@@ -0,0 +1,93 @@
+
+## Assumes 'x' is one or more xml_nodes
+getAttrs <- function(x, attr, nomatch=1:length(x)) {
+    attrs <- xml_attr(x, attr)
+    nas <- is.na(attrs)
+    if (any(nas)) {
+        if (!is.na(nomatch) && nomatch == "fail") {
+            stop(paste0("Missing required attribute '", attr, "'"))
+        }
+        if (length(nomatch) < length(x)) {
+            nomatch <- rep(nomatch, length.out=length(x))
+        }
+    }
+    attrs[nas] <- nomatch[nas]
+    attrs
+}
+
+readStage <- function(stage) {
+    if (inherits(stage, "xml_missing")) {
+        stop("No stage upon which to play")
+    }
+    stagex <- xml_attr(stage, "x")
+    stagey <- xml_attr(stage, "y")
+    stagew <- xml_attr(stage, "width")
+    stageh <- xml_attr(stage, "height")
+    locations <- xml_find_all(stage, "location")
+    label <- getAttrs(locations, "id")
+    program <- getAttrs(locations, "program", nomatch="fail")
+    x <- getAttrs(locations, "x", nomatch=0)
+    y <- getAttrs(locations, "y", nomatch=0)
+    w <- getAttrs(locations, "width", nomatch=600)
+    h <- getAttrs(locations, "height", nomatch=400)
+    if (is.na(stagex)) {
+        stagex <- min(as.numeric(x))
+    }
+    if (is.na(stagey)) {
+        stagey <- min(as.numeric(y))
+    }
+    if (is.na(stagew)) {
+        stagew <- max(as.numeric(x) + as.numeric(w))
+    }
+    if (is.na(stageh)) {
+        stageh <- max(as.numeric(y) + as.numeric(h))
+    }
+    list(x=stagex, y=stagey, width=stagew, height=stageh,
+         set=cbind(label, program, x, y, w, h, windowID=NA))
+}
+
+readCode <- function(action) {
+    code <- sapply(action, xml_text)
+    code[is.na(code)] <- ""
+    ## Shrink all blank lines to nothing
+    sapply(strsplit(code, "\n"),
+           function(x) {
+               paste(gsub("^\\s+$", "", x, perl=TRUE), collapse="\n")
+           })
+}
+
+readScenes <- function(scenes) {
+    shots <- xml_find_all(scenes, "shot")
+    NS <- length(shots)
+    dialogue <- sapply(lapply(shots, xml_find_first, "dialogue"), xml_text)
+    dialogue[is.na(dialogue)] <- ""
+    action <- xml_find_first(shots, "action")
+    code <- readCode(action)
+    shotLabel <- getAttrs(shots, "id")
+    width <- getAttrs(shots, "width", nomatch=NA)
+    height <- getAttrs(shots, "height", nomatch=NA)
+    location <- getAttrs(shots, "location", nomatch=NA)
+    echo <- getAttrs(action, "echo", nomatch="TRUE")
+    labels <- getAttrs(shots, "id")
+    duration <- getAttrs(shots, "duration", nomatch=NA)
+    keydelay <- getAttrs(action, "keydelay", nomatch=100)
+    linedelay <- getAttrs(action, "linedelay", nomatch=100)
+    sceneLabel <- unlist(mapply(
+        function(x, i) {
+            s <- xml_find_all(x, "shot")
+            ns <- length(s)
+            id <- xml_attr(x, "id")
+            if (is.na(id)) id <- i
+            rep(id, ns)
+        },
+        scenes, 1:length(scenes)))
+    cbind(sceneLabel, shotLabel, code, dialogue,
+          location, width, height, duration, keydelay, linedelay, echo)
+}
+
+readScript <- function(filename, label=gsub("[.]xml", "", filename)) {
+    xml <- read_xml(filename)
+    stage <- readStage(xml_find_first(xml, "/script/stage"))
+    shots <- readScenes(xml_find_all(xml, "/script/scene"))
+    list(label=label, stage=stage, shots=shots)
+}

R/stage.R

@@ -0,0 +1,25 @@
+
+## Set the stage (open and position windows)
+
+setStage <- function(stage) {
+    showDesktop()
+    set <- stage$set
+    windowID <- apply(set, 1,
+                      function(x) {
+                          wid <- openWindow(x["program"])
+                          ## Sys.sleep(1)
+                          removeWindowState(wid, "maximized_horz")
+                          removeWindowState(wid, "maximized_vert")
+                          positionWindow(wid, x["x"], x["y"], x["w"], x["h"])
+                          wid
+                      })
+    cbind(label=set[, "label"], windowID)
+}
+
+
+exitStage <- function(locations) {
+    apply(locations, 1,
+          function(x) {
+              closeWindow(x["windowID"])
+          })
+}

R/timing.R

@@ -0,0 +1,7 @@
+
+calculateTiming <- function(script, audioDuration, codeDuration) {
+    duration <- as.numeric(script$shots[, "duration"])
+    ifelse(is.na(duration),
+           pmax(audioDuration, codeDuration),
+           duration)
+}

R/video.R

@@ -0,0 +1,46 @@
+
+combineSceneAudio <- function(label, audioFiles, wd) {
+    wavs <- lapply(audioFiles, readWave)
+    outfile <- file.path(wd, paste0("scene-", label, "-audio.wav"))
+    writeWave(Reduce(bind, wavs), outfile)
+    outfile
+}
+
+combineSceneVideo <- function(label, videoFiles, wd) {
+    outfile <- file.path(wd, paste0("scene-", label, "-video.webm"))
+    ffmpeg(concatInput(videoFiles),
+           fileOutput(outfile, vcodec="copy"),
+           overwrite=TRUE)
+    outfile
+}
+
+muxScene <- function(label, audioFiles, videoFiles, wd) {
+    audio <- combineSceneAudio(label, audioFiles, wd)
+    video <- combineSceneVideo(label, videoFiles, wd)
+    inputs <- lapply(c(audio, video), fileInput)
+    outfile <- file.path(wd, paste0("scene-", label, "-movie.webm"))
+    ffmpeg(inputs,
+           fileOutput(outfile, vcodec="copy", acodec="libvorbis"),
+           overwrite=TRUE)
+    outfile    
+}
+
+muxAudioVideo <- function(script, audioFiles, videoFiles, wd) {
+
+    ## Mux individual scenes
+    sceneLabels <- script$shots[, "sceneLabel"]
+    sceneNames <- unique(sceneLabels)
+    sceneAudio <- split(audioFiles, sceneLabels)[sceneNames]
+    sceneVideo <- split(videoFiles, sceneLabels)[sceneNames]
+    scenes <- mapply(muxScene, sceneNames, sceneAudio, sceneVideo,
+                     MoreArgs=list(wd=wd), SIMPLIFY=TRUE)
+
+    ## Combine all scenes into main feature
+    feature <- file.path(wd, paste0(script$label, "-movie.webm"))
+    ffmpeg(concatInput(scenes),
+           fileOutput(feature, vcodec="copy", acodec="copy"),
+           overwrite=TRUE)
+
+    list(feature=feature, scenes=scenes)
+}
+