# render widgets when app starts
# render some widgets directly and others delayed
initial.render.widgets = function(ps, n.direct=5) {
bis = which(ps$bdf$is.widget)
first = bis[1:min(n.direct,length(bis))]
other = setdiff(bis, first)
render.rtutor.widgets(ps=ps,bis=first)
if (length(other)>0) {
shinyDelayedRun(100, function(ps,other,...) {
render.rtutor.widgets(ps=ps, bis=other)
},ps=ps, other=other)
}
}
render.first.widgets = function(ps,n=2) {
if (length(bis)==0) return()
bis =
render.rtutor.widgets(ps=ps, bis=bis)
}
rtutor.parse.widget = function(bi, ps, opts=ps$opts) {
restore.point("rtutor.parse.widget")
bdf = ps$bdf; br = bdf[bi,];
type = br$type
# special treatment for chunks and awards
# in order not to change old code too much
if (type=="chunk") {
rtutor.parse.chunk(bi,ps,opts)
return()
} else if (type=="award") {
rtutor.parse.award(bi=bi, ps=ps)
return()
}
Wid = ps$Widgets[[type]]
args = parse.block.args(arg.str = br$arg.str)
if (!is.null(args$name)) ps$bdf$name[[bi]] = args$name
#use.clicker = !is.null(Wid[["clicker"]]) & isTRUE(opts$use.clicker)
# if (use.clicker & is.null(opts[["courseid"]])) {
# use.clicker = FALSE
# cat("\nClicker cannot be used since no 'courseid' is specified in the settings.")
# }
# if (use.clicker & is.null(opts[["clicker.dir"]])) {
# use.clicker = FALSE
# cat("\nClicker cannot be used since no 'clicker.dir' is specified in the settings.")
# }
# if (use.clicker) {
# library(RTutorClicker)
# wid = call.fun(Wid$clicker$parse.fun,
# block.txt = ps$txt[br$start:br$end],
# inner.txt = ps$txt[(br$start+1):(br$end-1)],
# id = paste0(type,"__",bi),
# args = args,
# type = type,
# bdf=bdf,
# bi = bi,
# ps = ps
# )
# wid$type = type
# wid$use.clicker = TRUE
# wid$task.id = wid$id
#
# ps$bdf$is.container[[bi]] = TRUE
# set.container.div.and.output(bi,ps)
# } else {
wid = do.call(Wid$parse.fun, list(
block.txt = ps$txt[br$start:br$end],
inner.txt = ps$txt[(br$start+1):(br$end-1)],
id = paste0(type,"__",bi),
args = args,
type = type,
bdf=bdf,
bi = bi,
ps = ps
))
wid$type = type
wid$use.clicker = FALSE
wid$task.id = wid$id
if (!is.null(Wid$ui.fun)) {
# the widget will be put inside a container
ps$bdf$is.container[[bi]] = TRUE
set.container.div.and.output(bi,ps)
}
if (isTRUE(Wid$is.task)) {
ps$bdf$is.task[[bi]] = Wid$is.task
wid$task.ind = sum(ps$bdf$is.task[1:bi])
create.bi.task.env.info(bi=bi,ps=ps,need.task.env = isTRUE(Wid$need.task.env),change.task.env = isTRUE(Wid$change.task.env),args=list(optional = TRUE),presolve.task = opts$presolve, opts=opts)
}
# }
ps$bdf$obj[[bi]] = list(wid=wid)
if (!isTRUE(opts$rtutor)) {
ps$bdf$ui[[bi]] = first.non.null(wid[["armd.ui"]],wid[["ui"]])
}
return()
}
# will be called from parse.armd
rtutor.init.widgets = function(ps) {
bdf = ps$bdf
restore.point("rtutor.init.widgets")
n = NROW(ps$bdf)
ps$bdf = mutate(bdf,
is.task = FALSE,task.ind = 0,
task.line = NA_character_,
task.in = vector("list", n),
task.listeners = vector("list",n),
# These arguments deal with task.envs
need.task.env = FALSE,
change.task.env = FALSE,
presolve.task = ps$opts$presolve
)
bdf = ps$bdf
widgets = na.omit(unique(bdf$type[bdf$is.widget]))
# currently still
# special treatment for chunks and awards
widgets = setdiff(widgets,c("chunk","award"))
Widgets = lapply(widgets, function(widget) {
pkg = get.bt(widget,ps)$package
call = parse(text=paste0(pkg,":::rtutor.widget.",widget,"()"))
Widget = eval(call)
})
names(Widgets) = widgets
ps$Widgets=Widgets
ps$env = new.env(parent=ps$init.env)
}
render.rtutor.widgets = function(ps, init.handlers=TRUE,bis = which(ps$bdf$is.widget)) {
restore.point("render.rtutor.widgets")
for (bi in bis) {
render.rtutor.widget(ps=ps, bi=bi, init.handlers=init.handlers)
}
}
render.rtutor.widget = function(ps, bi, ts=NULL, init.handlers=TRUE, dset=TRUE, opts=ps$opts) {
restore.point("render.rtutor.widget")
type = ps$bdf$type[[bi]]
# special treatment for chunks and awards
# in order not to change old code too much
if (type=="chunk") {
render.rtutor.task.chunk(ps=ps,bi=bi)
return()
} else if (type=="award") {
show.award(award.bi = bi, ps=ps)
return()
}
cat("\n******************************************")
cat("\nrender.interactive.widget")
wid = ps$bdf$obj[[bi]]$wid
type = ps$bdf$type[[bi]]
Wid = ps$Widgets[[type]]
output.id = ps$bdf$output.id[[bi]]
if (is.null(ts))
ts = get.ts(bi=bi)
ui = do.call(Wid$ui.fun,list(ts=ts, wid=wid))
setUI(output.id, ui)
if (dset)
dsetUI(output.id, ui)
if (init.handlers & !is.null(Wid$init.handlers))
do.call(Wid$init.handlers, list(wid=wid,ts=ts,bi=bi, opts=opts))
# use.clicker = isTRUE(wid$use.clicker)
# # render clicker widget
# if (use.clicker) {
# library(RTutorClicker)
# ui = clicker.server.ui.fun(wid=wid, Wid=Wid)
# setUI(output.id, ui)
# if (dset)
# dsetUI(output.id, ui)
#
# if (init.handlers)
# clicker.server.init.handlers(wid=wid, Wid=Wid)
#
# } else {
# if (is.null(ts))
# ts = get.ts(bi=bi)
# ui = Wid$ui.fun(ts=ts)
#
# setUI(output.id, ui)
# if (dset)
# dsetUI(output.id, ui)
#
# if (init.handlers)
# Wid$init.handlers(wid=wid,ts=ts,bi=bi, opts=opts)
# }
cat("end render.rtutor.widget")
}
update.widget = function(id, bi = which(ps$bdf$id==id),ps=get.ps(),...) {
restore.point("update.widget")
cat("\n++++++++++++++++++++++++++++++++++++++++++")
cat("\nupdate.widget")
Wid = get.Widget(bi=bi)
wid = get.widget(bi=bi)
if (!is.null(Wid[["update"]]))
do.call(Wid$update, list(wid=wid,bi=bi,...))
render.rtutor.widget(bi=bi, ps=ps, init.handlers = FALSE)
}
get.widget = function(bi, ps=get.ps()) {
ps$bdf$obj[[bi]]$wid
}
make.widgets.list = function(widgets="quiz") {
li = lapply(widgets, function(widget) {
fun = paste0("rtutor.widget.",widget)
do.call(fun,list())
})
names(li) = widgets
li
}
get.Widget = function(type=ps$bdf$type[[bi]],bi=NULL, ps=get.ps()) {
ps$Widgets[[type]]
}
check.Widget = function(Wid) {
restore.point("check.Widget")
}
check.Widget.function = function(fun.name, type="") {
for (fun in fun.name) {
if (is.null(Wid[[fun]])) {
stop(paste0("The widget ", type, " has not defined the function ", fun))
}
}
}
check.Widget.field = function(fields, type="") {
for (field in fields) {
if (is.null(Wid[[field]])) {
stop(paste0("The widget ", type, " has not defined the required field ", field))
}
}
}
get.yaml.block.args = function(bi,ps) {
restore.point("get.yaml.block.args")
args = parse.block.args(arg.str = ps$bdf$arg.str[[bi]])
yaml = get.bi.ps.str(bi,ps)
if (!is.null(yaml)) {
yaml.arg = yaml.load(paste0(yaml,collapse="\n"))
args[names(yaml.arg)] = yaml.arg
}
args
}
dsetUI = function(...) {
shinyEvents::dsetUI(...)
shinyEvents::setUI(...)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.