In ablejec/animatoR: Support for Animated Graphics in Base R Graphics

knitr::opts_chunk$set(echo = FALSE,warning = FALSE)

library(animatoR)
library(animation)
library(knitr)
#knitr::opts_knit$set(animation.fun = hook_ffmpeg_html)
#knitr::opts_knit$set(animation.fun = hook_scianimator)
#knitr::opts_knit$set(animation.fun = hook_r2swf)

## preveri attribute
as.animator <- function(x,life=1){
 class(x) <- "animator"
 attr(x,"life") <- life
 return(x)
}

###
## plot method for class \code{animator}.
##
plot.animator <- function(x,life,...) {
if(missing(life)) life <- attr(x,"life")
animator(x,life=life,...)
}

getChunkopts<-function(what){
    if ((n.parents <- length(sys.parents())) >= 3) {
        for (i in seq_len(n.parents) - 1) {
#       cat(1,ls(envir = sys.frame(i)),"\n\n")
            if ("chunkopts" %in% ls(envir = sys.frame(i))) {
                chunkopts = get("chunkopts", envir = sys.frame(i))
                if (all(c("prefix.string", "label") %in% names(chunkopts))) {
                  img.name = paste(chunkopts$prefix.string, chunkopts$label,sep = "-")
#                 ani.options(img.fmt = file.path(outdir, paste(img.name,
#                    "%d.", file.ext, sep = "")))
                  in.sweave <<- TRUE
                  if(missing(what)) return(chunkopts) else return(chunkopts[what])
                  break
                }
            }
        }
    }
    return(NULL)
}

includeLatex <- function(title="",scale=0.5,poster="last",every=1,fps=25,from="",to="",
vspace="0pt",other=",controls"){
file <- paste(getChunkopts()[c("prefix.string","label")],collapse="-")
#cat("\n\\begin{frame}[fragile] ","\n")
#cat("\\frametitle{",title,"} ","\n")
#cat("\\begin{center} ","\n")
cat(" \\vspace{",vspace,"} ","\n",sep="")
cat("\\animategraphics[scale=",scale,
",poster=",poster,
",every=",every,
other,
"]{",fps,
"}{",file,
"}{",from,
"}{",to,
"} ","\n",sep="")
#cat("\\end{center} ","\n\n\n")
#cat("\\end{frame} ","\n\n")
}

##

#if(!interactive()) pdf(file="../doc/anim-slika.pdf")
oldpar <- par(mar=c(0,0,0,0))
n <- 21
x0 <- 5
y0 <- 5
x1 <- 5+runif(n,2,4)*c(sin(0:n*2*pi/n))
y1 <- 5+runif(n,2,4)*c(cos(0:n*2*pi/n))
#
plot(as.animator('
newplot(axes=FALSE)
#box()
tpoints(0,0,5,5,when=c(0,0.2,0,0.3),trace=TRUE,pch=21,cex=tcex(2,30,t),
bg=trgb("orange","red",t^0.1))
ttext(5,8,5,4,
text="Happy 4th of July!",when=c(0.5,1),cex=tcex(1,20,t),col=trgb("lightblue","blue",t))
## ttext(5,0,5,2,text="Happy 444th of July!", when=c(0.5,1),cex=tcex(1,20,t),col=trgb("red","blue",t,alpha1=1))
tsegments(x0,y0,x1,y1,when=c(0.2,0.3,0.2,0.3), col=1:n,lwd=(1:n)/2)
tpoints(x1,y1,jitter(x1,4),0.1,when=c(0.3,1),col=sample(1:n),cex=sample(tcex(1:n,0,t,when=c(0.3,1))),pch=8,lwd=(1:n)/2)
segments(0,0,10,0,col=4,lwd=10)
tsegments(0,0,10,0,col="skyblue",lwd=10)

ttext(10,0,10,.3,text="Andrej & animatoR",when=c(0.5,0.7,0.5,1),col=8,adj=1,cex=1)
'),life=6)
#ttext(5,10,5,5,"Happy 4th of July!",when=c(0.6,1))
par(oldpar)
#includeLatex(poster="none",scale=1,other=",autoplay")