R/page_ui.R

In skranz/gtreeWebExp: Specify and run simple, unincentivized web experiments based on a gtree game

page.ns = function(name) {
	NS(paste0("page-",stage.name,"-",player))
}

make.ep.page.ui = function(ep=get.ep()) {
  restore.point("make.ep.page.ui")
  play = ep$play
  page.name = ep.page.name(ep)

  page.rmd = load.page.rmd(game = ep.game(ep),page.name = page.name, stage=ep.stage(ep))

	ep$page.values = c(play$hist, list(.player = ep$human, .play=play, .vg=game$vg))


	# will only be temporary assigned
	ns = NS(paste0("page-",page.name))
	cr = compile.rmd(text=page.rmd, out.type = "shiny",envir = ep$page.values,blocks = "render")
  ui = render.compiled.rmd(cr,envir=ep$page.values,use.commonmark=FALSE)
	ui
}


submitStartPageBtn = function(label="Press to start",ep=get.ep(),...) {

	page.name = ep.page.name(ep)
	ns = NS(paste0("page-",page.name))
	id = paste0(ns("submitPageBtn"))

	buttonHandler(id, ep.start.btn.click)
	try( dsetUI(ns("msg"),""),silent = TRUE)
	as.character(
		tagList(
			uiOutput(ns("msg")),
			smallButton(id,label)
		)
	)
}

submitEndPageBtn = function(label="Press to start",ep=get.ep(),...) {
	page.name = ep.page.name(ep)
	ns = NS(paste0("page-",page.name))
	id = paste0(ns("submitPageBtn"))

	buttonHandler(id, ep.end.btn.click)
	dsetUI(ns("msg"),"", app=app)
	as.character(
		tagList(
			uiOutput(ns("msg")),
			smallButton(id,label)
		)
	)
}

ep.start.btn.click = function(ep=get.ep(),...) {

}

ep.end.btn.click = function(ep=get.ep(),...) {

}


submitPageBtn = function(label="Press to continue",ep=get.ep(),...) {
	restore.point("submitPageBtn")
	stage = ep.stage(ep=ep)

	page.name = ep.page.name(ep)
	ns = NS(paste0("page-",page.name))
	id = paste0(ns("submitPageBtn"))

	actions = stage$actions

	# which actions use strategy method
	use.sm = unlist(sapply(actions, function(action) !is.null(action$domain.var)))
	if (is.null(use.sm)) use.sm = logical(0)

	action.ids = unlist(sapply(names(actions[!use.sm]),get.action.input.id, USE.NAMES = FALSE))

	# get ids of all strategy method fields
	li = lapply(actions[use.sm], function(action) {
		postfix = paste.matrix.cols(action$domain.vals,sep="_")
		get.action.input.id(name=paste0(action$name,"_",postfix),ep=ep)
	})
	names(li) = NULL
	sm.ids = unlist(li)

	app = getApp()

	buttonHandler(id, ep.submit.btn.click, stage.name = stage$name, action.ids=action.ids,sm.ids=sm.ids, app = app)

	dsetUI(ns("msg"),"", app=app)
	as.character(
		tagList(
			uiOutput(ns("msg")),
			smallButton(id,label, form.ids = c(ep$submit.ids, action.ids,sm.ids))
		)
	)
}


actionField = function(name,label=NULL,choiceLabels=NULL, inputType="auto",ep=get.ep(),player=ep$human,action.name = name, ...) {
	vg = ep$vg
	stage = ep.stage(ep)
	action = stage$actions[[action.name]]
	if (identical(choiceLabels,""))
		choiceLabels = NULL
	restore.point("actionField")

	if (!is.null(label)) {
		label = replace.whiskers(label, ep$page.values,whisker.start = "<<", whisker.end = ">>")
	}

	id = get.action.input.id(name=name)
  choices = eval.or.return(action$set, ep$page.values)

	if (inputType=="auto") {
    if (length(choices)<=12){
      inputType="radio"
    } else {
      inputType="selectize"
    }
	}
  #inputType = "selectize"

  if (!is.null(choiceLabels)) {
    choices = as.list(choices)
    names(choices) = choiceLabels
  }
  if (inputType=="radio") {
    ui = radioButtons(inputId = id,label = label,choices = choices, selected=NA)
  } else if (inputType=="rowRadio") {
    ui = rowRadioButtons(inputId = id,label = "",choices = choices, selected=NA)
  } else {
  	choices = c(list(""),as.list(choices))
    ui = selectizeInput(inputId = id,label = label,choices = choices, selected=NA)
  }

  html = as.character(ui)
	html
}


get.action.input.id = function(name) {
	id = paste0("action-",name)
	names(id) = name
	id
}