Added widget_style function plus readme and unit tests

.Rbuildignore

@@ -1,2 +1,4 @@
+^README\.Rmd$
+^LICENSE\.md$
 ^.*\.Rproj$
 ^\.Rproj\.user$

DESCRIPTION

@@ -8,7 +8,10 @@ Authors@R: c(
 Description: Functions for easily creating interactive web pages using RMarkdown that students can use in self-assessment.
 Depends: R (>= 3.1.2)
 Imports:
-    jsonlite
-License: MIT
+    jsonlite,
+    rmarkdown
+License: MIT + file LICENSE
 LazyData: true
 RoxygenNote: 6.1.1
+Suggests: 
+    testthat

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2019
+COPYRIGHT HOLDER: Dale Barr and Lisa DeBruine

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2019 Dale Barr and Lisa DeBruine
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -8,3 +8,4 @@ export(strip_lzero)
 export(torf)
 export(unhide)
 export(webex_default)
+export(widget_style)

R/webex_fns.R

@@ -26,7 +26,7 @@ fitb <- function(answer, width = calculated_width,
   }
 
   # if width not set, calculate it from max length answer, up to limit of 100
-  calculated_width <- min(100, max(purrr::map_int(answer, nchar)))
+  calculated_width <- min(100, max(nchar(answer)))
 
   answers <- jsonlite::toJSON(as.character(answer))
   paste0("<input class='solveme",
@@ -89,6 +89,21 @@ unhide <- function() {
   paste0("\n</div>\n")
 }
 
+#' Change webex widget style
+#'
+#' @param default the colour of the widgets when the correct answer is not filled in (defaults to blue)
+#' @param correct the colour of the widgets when the correct answer not filled in (defaults to red)
+#' @details Call this function inline in an RMarkdown document to change the default and correct colours using any valid HTML colour word (e.g., red, rgb(255,0,0), hsl(0, 100%, 50%) or #FF0000).
+#' @export
+widget_style <- function(default = "blue", correct = "red") {
+  paste0(
+    "\n<style>\n",
+    "    .solveme { border-color: ", default,"; }\n",
+    "    .solveme.correct { border-color: ", correct,"; }\n",
+    "</style>\n\n"
+  )
+}
+
 #' Round up from .5
 #'
 #' @param x a numeric string (or number that can be converted to a string)

README.Rmd

@@ -0,0 +1,198 @@
+---
+output: github_document
+---
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+<link href="inst/reports/default/webex.css" rel="stylesheet" />
+
+```{r setup, include = FALSE}
+library("webex")
+
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>",
+  fig.path = "man/figures/README-",
+  out.width = "100%"
+)
+```
+
+
+# webex
+
+The goal of webex is to enable instructors to easily create web documents that students can use in self-assessment.
+
+## Installation
+
+You can install the released version of webex from [GitHub](https://github.com/PsyTeachR/webex) with:
+
+``` r
+devtools::install_packages_github("PsyTeachR/webex")
+```
+
+## Example
+
+This is a Web Exercise template created by the [psychology teaching team at the University of Glasgow](http://www.psy.gla.ac.uk), based on ideas by [Software Carpentry](https://software-carpentry.org/lessons/). This template enables instructors to easily create web documents that students can use in self-assessment.
+
+The webex package provides a number of functions that you use in [inline R code](https://github.com/rstudio/cheatsheets/raw/master/rmarkdown-2.0.pdf) to create HTML widgets (text boxes, pull down menus, buttons that reveal hidden content). Examples are provided in this document. Knit this file to HTML to see how it works.
+
+**NOTE: To use the widgets in the compiled HTML file, you need to have a JavaScript-enabled browser. The widgets don't work in the built-in RStudio browser. In the built-in browser, click the "Open in Browser" button to open the file in your operating system's browser.**
+
+## Fill-In-The-Blanks (`fitb()`)
+
+Create fill-in-the-blank questions using `fitb()`, providing the answer as the first argument.
+
+- 2 + 2 is `r fitb("4")`
+
+You can also create these questions dynamically, using variables from your R session.
+
+```{r echo = FALSE}
+x <- sample(2:8, 1)
+```
+
+- The square root of `r x^2` is: `r fitb(x)`
+
+The blanks are case-sensitive; if you don't care about case, use the argument `ignore_case = TRUE`.
+
+- What is the letter after D? `r fitb("E", ignore_case = TRUE)`
+
+If you want to ignore differences in whitespace use, use the argument `ignore_ws = TRUE` and include spaces in your answer anywhere they could be acceptable..
+
+- How do you load the tidyverse package? `r fitb("library( tidyverse )", ignore_case = TRUE, width = "20")`
+
+You can set more than one possible correct answer by setting the answers as a vector.
+
+- Type a vowel: `r fitb(c("A", "E", "I", "O" , "U"), ignore_case = TRUE)`
+
+## Multiple Choice (`mcq()`)
+
+- "Never gonna give you up, never gonna: `r mcq(c("let you go", "turn you down", "run away", answer = "let you down"))`"
+- "I `r mcq(c(answer = "bless the rains", "guess it rains", "sense the rain"))` down in Africa" -Toto
+
+## True or False (`torf()`)
+
+- You can permute values in a vector using `sample()`. `r torf(TRUE)`
+
+## Hidden solutions and hints (`hide()` and `unhide()`)
+
+- Recreate the scatterplot below, using the built-in `cars` dataset.
+
+```{r echo = FALSE}
+with(cars, plot(speed, dist))
+```
+
+`r hide("I need a hint")`
+`?plot`
+`r unhide()`
+
+`r hide()`
+```{r eval = FALSE}
+with(cars, plot(speed, dist))
+```
+`r unhide()`
+
+*Don't forget to `unhide()` after the solution!*
+
+
+<script>
+
+/* update total correct if #total_correct exists */
+update_total_correct = function() {
+  if (t = document.getElementById("total_correct")) {
+    t.innerHTML =
+      document.getElementsByClassName("correct").length + " of " +
+      document.getElementsByClassName("solveme").length + " correct";
+  }
+}
+
+/* solution button toggling function */
+b_func = function() {
+  var cl = this.parentElement.classList;
+  if (cl.contains('open')) {
+    cl.remove("open");
+  } else {
+    cl.add("open");
+  }
+}
+
+/* function for checking solveme answers */
+solveme_func = function(e) {
+  var real_answers = JSON.parse(this.dataset.answer);
+  var my_answer = this.value;
+  var cl = this.classList;
+  if (cl.contains("ignorecase")) {
+    my_answer = my_answer.toLowerCase();
+  }
+  if (cl.contains("nospaces")) {
+    my_answer = my_answer.replace(/ /g, "");
+  }
+
+  if (my_answer !== "" & real_answers.includes(my_answer)) {
+    cl.add("correct");
+  } else {
+    cl.remove("correct");
+  }
+
+  // match numeric answers within a specified tolerance
+  if(this.dataset.tol){
+    var tol = JSON.parse(this.dataset.tol);  
+    var matches = real_answers.map(x => Math.abs(x - my_answer) < tol)
+    if (matches.reduce((a, b) => a + b, 0) > 0) {
+      cl.add("correct");
+    } else {
+      cl.remove("correct");
+    }  
+  }
+
+  // added regex bit
+  if (cl.contains("regex")){
+    answer_regex = RegExp(real_answers.join("|"))
+    if (answer_regex.test(my_answer)) {
+      cl.add("correct");
+    }  
+  }
+
+  update_total_correct();
+}
+
+window.onload = function() {
+  /* set up solution buttons */
+  var buttons = document.getElementsByTagName("button");
+
+  for (var i = 0; i < buttons.length; i++) {
+    if (buttons[i].parentElement.classList.contains('solution')) {
+      buttons[i].onclick = b_func;
+    }
+  }
+
+  /* set up solveme inputs */
+  var solveme = document.getElementsByClassName("solveme");
+
+  for (var i = 0; i < solveme.length; i++) {
+    /* make sure input boxes don't auto-anything */
+    solveme[i].setAttribute("autocomplete","off");
+    solveme[i].setAttribute("autocorrect", "off");
+    solveme[i].setAttribute("autocapitalize", "off"); 
+    solveme[i].setAttribute("spellcheck", "false");
+    solveme[i].value = "";
+
+    /* adjust answer for ignorecase or nospaces */
+    var cl = solveme[i].classList;
+    var real_answer = solveme[i].dataset.answer;
+    if (cl.contains("ignorecase")) {
+      real_answer = real_answer.toLowerCase();
+    }
+    if (cl.contains("nospaces")) {
+      real_answer = real_answer.replace(/ /g, "");
+    }
+    solveme[i].dataset.answer = real_answer;
+
+    /* attach checking function */
+    solveme[i].onkeyup = solveme_func;
+    solveme[i].onchange = solveme_func;
+  }
+
+  update_total_correct();
+}
+
+</script>