|
|
|
|
|
|
|
|
APP_TITLE <- "App Title" |
|
|
APP_TITLE <- "App Title" |
|
|
HELP_TEXT <- "Some guidance text can go here" |
|
|
HELP_TEXT <- "Some guidance text can go here" |
|
|
|
|
|
|
|
|
|
|
|
top_male_names <- readRDS(here::here("t4c/data/top_male_names.rds")) |
|
|
|
|
|
random_name <- function() sample(top_male_names, 1) |
|
|
|
|
|
possessive_name <- function(x) if (substr(x, nchar(x), nchar(x)) == "s") paste0(x, "'") else paste0(x, "'s") |
|
|
|
|
|
|
|
|
questions <- readxl::read_xlsx(here::here("docs/questions.xlsx")) %>% |
|
|
questions <- readxl::read_xlsx(here::here("docs/questions.xlsx")) %>% |
|
|
arrange(order) |
|
|
arrange(order) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
) |
|
|
) |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
swipe_help_row_div <- div( |
|
|
|
|
|
class = "bottom-help text-moffitt-grey", |
|
|
|
|
|
div(class = "bottom-help-left", img(src = "/images/swipe-left.svg", width = "50px"), p("Bad")), |
|
|
|
|
|
div(class = "bottom-help-right", img(src = "/images/swipe-right.svg", width = "50px"), p("Okay")), |
|
|
|
|
|
div(class = "bottom-help-middle", span("Swipe Card", class = "bottom-help-middle-text")) |
|
|
|
|
|
) |
|
|
|
|
|
|
|
|
ui <- fixedPage( |
|
|
ui <- fixedPage( |
|
|
includeCSS("devices.min.css"), |
|
|
includeCSS("devices.min.css"), |
|
|
includeCSS("t4c.css"), |
|
|
includeCSS("t4c.css"), |
|
|
|
|
|
|
|
|
p(), |
|
|
p(), |
|
|
phone_container( |
|
|
phone_container( |
|
|
div( |
|
|
div( |
|
|
class = "overlay splash animated", id = "splash-overlay", |
|
|
|
|
|
|
|
|
class = "overlay bg-moffitt-grey splash animated", id = "splash-overlay", |
|
|
div( |
|
|
div( |
|
|
class = "splash-body", |
|
|
class = "splash-body", |
|
|
h1("Welcome!"), |
|
|
h1("Welcome!"), |
|
|
|
|
|
|
|
|
actionButton("splash_next_screen", "Get Started", class = "btn-bottom-right btn-primary") |
|
|
actionButton("splash_next_screen", "Get Started", class = "btn-bottom-right btn-primary") |
|
|
) |
|
|
) |
|
|
), |
|
|
), |
|
|
|
|
|
div( |
|
|
|
|
|
id = "app-intro", |
|
|
|
|
|
class = "app-main bg-white animated", |
|
|
|
|
|
h1(APP_TITLE, class = "app-title text-white bg-moffitt-blue"), |
|
|
|
|
|
p(class = "help-text text-moffitt-grey", |
|
|
|
|
|
"Guidance about how to approach the questions goes here."), |
|
|
|
|
|
div( |
|
|
|
|
|
id = "test-card-swipe-container", |
|
|
|
|
|
style = "width: 100%; max-height: 275px; position: relative; height: 100%;", |
|
|
|
|
|
shinyswiprUI( |
|
|
|
|
|
"test_card_swipe_ui", |
|
|
|
|
|
div(class = "swiperCard-header", |
|
|
|
|
|
h4(class = "card-title text-white bg-moffitt-light-blue", |
|
|
|
|
|
"Try It Now" |
|
|
|
|
|
) |
|
|
|
|
|
), |
|
|
|
|
|
div(class = "swiperCard-body", |
|
|
|
|
|
h4("An Example Question"), |
|
|
|
|
|
p("Something to think about. Swipe", strong("left"), "if you feel X.", |
|
|
|
|
|
"Swipe", strong("right"), "if you feel Y.") |
|
|
|
|
|
) |
|
|
|
|
|
), |
|
|
|
|
|
swipe_help_row_div |
|
|
|
|
|
), |
|
|
|
|
|
shinyjs::hidden(div( |
|
|
|
|
|
id = "test_swipe_success", |
|
|
|
|
|
style = "font-size: 1.5em; text-align: center; width: 100%; padding: 50px", |
|
|
|
|
|
p(icon("thumbs-o-up", class = "fa-3x text-moffitt-green"), |
|
|
|
|
|
br(), |
|
|
|
|
|
actionLink("app_intro_next", "Great, let's get started!") |
|
|
|
|
|
) |
|
|
|
|
|
)) |
|
|
|
|
|
), |
|
|
div( |
|
|
div( |
|
|
id = "app-main", |
|
|
id = "app-main", |
|
|
class = "app-main animated", |
|
|
class = "app-main animated", |
|
|
|
|
|
|
|
|
) |
|
|
) |
|
|
), |
|
|
), |
|
|
div(class = "swiperCard-body", |
|
|
div(class = "swiperCard-body", |
|
|
# h4("Question title"), |
|
|
|
|
|
h4(textOutput("question_topic")), |
|
|
h4(textOutput("question_topic")), |
|
|
p(textOutput("question_text")) |
|
|
|
|
|
|
|
|
p(textOutput("question_text")), |
|
|
|
|
|
uiOutput("question_story_link") |
|
|
) |
|
|
) |
|
|
), |
|
|
), |
|
|
div( |
|
|
|
|
|
class = "bottom-help text-moffitt-grey", |
|
|
|
|
|
div(class = "bottom-help-left", img(src = "/images/swipe-left.svg", width = "50px"), p("Bad")), |
|
|
|
|
|
div(class = "bottom-help-right", img(src = "/images/swipe-right.svg", width = "50px"), p("Okay")), |
|
|
|
|
|
div(class = "bottom-help-middle", span("Swipe Card", class = "bottom-help-middle-text")) |
|
|
|
|
|
) |
|
|
|
|
|
|
|
|
swipe_help_row_div |
|
|
|
|
|
), |
|
|
|
|
|
div( |
|
|
|
|
|
id = "app-story", |
|
|
|
|
|
class = "app-story animated fadeOutUp", |
|
|
|
|
|
div(class = "close-button", actionLink("app_main_hide_story", NULL, icon("times", class = "fa-lg"))), |
|
|
|
|
|
htmlOutput("question_story") |
|
|
) |
|
|
) |
|
|
), |
|
|
), |
|
|
hr(), |
|
|
hr(), |
|
|
actionButton("toggle_splash", "Toggle Splash"), |
|
|
actionButton("toggle_splash", "Toggle Splash"), |
|
|
|
|
|
actionButton("back", "Back"), |
|
|
h4("Answer History"), |
|
|
h4("Answer History"), |
|
|
dataTableOutput("results_table") |
|
|
dataTableOutput("results_table") |
|
|
) |
|
|
) |
|
|
|
|
|
|
|
|
iter = 1L, |
|
|
iter = 1L, |
|
|
results = data_frame(question_id = integer(), swipe = character()), |
|
|
results = data_frame(question_id = integer(), swipe = character()), |
|
|
complete = FALSE, |
|
|
complete = FALSE, |
|
|
splash = TRUE |
|
|
|
|
|
|
|
|
splash = TRUE, |
|
|
|
|
|
screen_prev = NULL, |
|
|
|
|
|
screen_active = "splash-overlay", |
|
|
|
|
|
screen_next = NULL |
|
|
) |
|
|
) |
|
|
|
|
|
|
|
|
|
|
|
app_screens <- c( |
|
|
|
|
|
"splash-overlay" = 1, |
|
|
|
|
|
"app-intro" = 2, |
|
|
|
|
|
"app-main" = 3 |
|
|
|
|
|
) |
|
|
|
|
|
get_screen_next <- function(x) names(app_screens)[which(names(app_screens) == x) + 1L] |
|
|
|
|
|
get_screen_prev <- function(x) names(app_screens)[which(names(app_screens) == x) - 1L] |
|
|
|
|
|
|
|
|
question <- reactive({ |
|
|
question <- reactive({ |
|
|
if (app_data$iter > length(question_ids)) return(NULL) |
|
|
if (app_data$iter > length(question_ids)) return(NULL) |
|
|
questions %>% |
|
|
questions %>% |
|
|
|
|
|
|
|
|
}) |
|
|
}) |
|
|
|
|
|
|
|
|
card_swipe <- callModule(shinyswipr, "card_swipe_ui") |
|
|
card_swipe <- callModule(shinyswipr, "card_swipe_ui") |
|
|
|
|
|
card_swipe_test <- callModule(shinyswipr, "test_card_swipe_ui") |
|
|
|
|
|
|
|
|
question_ids <- arrange(questions, order) %>% pull(id) |
|
|
question_ids <- arrange(questions, order) %>% pull(id) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
output$results_table <- renderDataTable({ |
|
|
output$results_table <- renderDataTable({ |
|
|
app_data$results |
|
|
app_data$results |
|
|
}) |
|
|
}) |
|
|
|
|
|
output$question_story <- renderUI({ |
|
|
|
|
|
if (!app_data$complete) { |
|
|
|
|
|
q_story <- question()$Story |
|
|
|
|
|
if (is.na(q_story)) return(p("No story.")) |
|
|
|
|
|
tagList( |
|
|
|
|
|
h1(app_data$male_name, "Experience"), |
|
|
|
|
|
q_story %>% |
|
|
|
|
|
strsplit("\\s*(\r\n){1,2}") %>% |
|
|
|
|
|
.[[1]] %>% |
|
|
|
|
|
purrr::map(~ tags$p(.)) |
|
|
|
|
|
) |
|
|
|
|
|
} |
|
|
|
|
|
}) |
|
|
|
|
|
output$question_story_link <- renderUI({ |
|
|
|
|
|
if (app_data$complete) return(NULL) |
|
|
|
|
|
q_story <- question()$Story |
|
|
|
|
|
if (is.na(q_story)) return(NULL) |
|
|
|
|
|
app_data$male_name <- possessive_name(random_name()) |
|
|
|
|
|
actionLink("app_main_show_story", |
|
|
|
|
|
paste("Read", app_data$male_name, "story...")) |
|
|
|
|
|
}) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
observe({ |
|
|
observe({ |
|
|
cat("iter:", app_data$iter, "\n") |
|
|
|
|
|
cat("ques:", question()$`Question Text`, "\n") |
|
|
|
|
|
print(app_data$results) |
|
|
|
|
|
|
|
|
# cat("iter:", app_data$iter, "\n") |
|
|
|
|
|
# cat("ques:", question()$`Question Text`, "\n") |
|
|
|
|
|
# print(app_data$results) |
|
|
|
|
|
# str(app_data) |
|
|
}) |
|
|
}) |
|
|
|
|
|
|
|
|
# on swipe |
|
|
|
|
|
|
|
|
# on main app card swipe |
|
|
observeEvent(card_swipe(), { |
|
|
observeEvent(card_swipe(), { |
|
|
if (app_data$complete) { |
|
|
if (app_data$complete) { |
|
|
cat("\nNothing to do.") |
|
|
cat("\nNothing to do.") |
|
|
|
|
|
|
|
|
) |
|
|
) |
|
|
|
|
|
|
|
|
# update app_data |
|
|
# update app_data |
|
|
|
|
|
Sys.sleep(0.5) # wait for animation to complete |
|
|
app_data$iter <- app_data$iter + 1L |
|
|
app_data$iter <- app_data$iter + 1L |
|
|
next_q <- question() |
|
|
next_q <- question() |
|
|
if (is.null(next_q)) app_data$complete <- TRUE |
|
|
if (is.null(next_q)) app_data$complete <- TRUE |
|
|
}) |
|
|
}) |
|
|
|
|
|
|
|
|
observeEvent(input$splash_next_screen, { |
|
|
observeEvent(input$splash_next_screen, { |
|
|
if (app_data$splash) app_data$splash <- FALSE |
|
|
|
|
|
|
|
|
app_data$screen_next <- get_screen_next("splash-overlay") |
|
|
}) |
|
|
}) |
|
|
|
|
|
|
|
|
observeEvent(input$toggle_splash, { |
|
|
observeEvent(input$toggle_splash, { |
|
|
app_data$splash <- !app_data$splash |
|
|
|
|
|
|
|
|
if (!app_data$screen_active == "splash-overlay") { |
|
|
|
|
|
app_data$screen_next <- "splash-overlay" |
|
|
|
|
|
} else { |
|
|
|
|
|
app_data$screen_next <- app_data$screen_prev |
|
|
|
|
|
} |
|
|
}) |
|
|
}) |
|
|
|
|
|
|
|
|
observeEvent(app_data$splash, { |
|
|
|
|
|
if (app_data$init) { |
|
|
|
|
|
app_data$init <- app_data$init - 1L |
|
|
|
|
|
return() |
|
|
|
|
|
|
|
|
observeEvent(input$back, { |
|
|
|
|
|
if (!is.null(app_data$screen_prev)) app_data$screen_next <- app_data$screen_prev |
|
|
|
|
|
}) |
|
|
|
|
|
|
|
|
|
|
|
observeEvent(card_swipe_test(), { |
|
|
|
|
|
shinyjs::hide("test-card-swipe-container", anim = TRUE, animType = "fade", time = 1) |
|
|
|
|
|
Sys.sleep(1) |
|
|
|
|
|
shinyjs::show("test_swipe_success", anim = TRUE, animType = "fade") |
|
|
|
|
|
}) |
|
|
|
|
|
|
|
|
|
|
|
observeEvent(input$app_intro_next, { |
|
|
|
|
|
app_data$screen_next <- get_screen_next("app-intro") |
|
|
|
|
|
}) |
|
|
|
|
|
|
|
|
|
|
|
observeEvent(input$app_main_show_story, { |
|
|
|
|
|
shinyjs::removeClass("app-story", "fadeOutUp") |
|
|
|
|
|
shinyjs::addClass("app-story", "fadeInDown") |
|
|
|
|
|
}) |
|
|
|
|
|
observeEvent(input$app_main_hide_story, { |
|
|
|
|
|
shinyjs::addClass("app-story", "fadeOutUp") |
|
|
|
|
|
shinyjs::removeClass("app-story", "fadeInDown") |
|
|
|
|
|
}) |
|
|
|
|
|
|
|
|
|
|
|
observeEvent(app_data$screen_next, { |
|
|
|
|
|
if (is.null(app_data$screen_next)) return() |
|
|
|
|
|
cat("\n", app_data$screen_active, "to", app_data$screen_next) |
|
|
|
|
|
if (app_screens[app_data$screen_active] < app_screens[app_data$screen_next]) { |
|
|
|
|
|
# Move forward: active out left, next in right |
|
|
|
|
|
shinyjs::removeClass(app_data$screen_active, "slideInLeft slideInRight") |
|
|
|
|
|
shinyjs::removeClass(app_data$screen_next, "slideOutLeft slideOutRight") |
|
|
|
|
|
shinyjs::addClass(app_data$screen_active, "slideOutLeft") |
|
|
|
|
|
shinyjs::addClass(app_data$screen_next, "slideInRight") |
|
|
|
|
|
} else { |
|
|
|
|
|
# Move backward: active out right, next in left |
|
|
|
|
|
shinyjs::removeClass(app_data$screen_active, "slideInLeft slideInRight") |
|
|
|
|
|
shinyjs::removeClass(app_data$screen_next, "slideOutLeft slideOutRight") |
|
|
|
|
|
shinyjs::addClass(app_data$screen_active, "slideOutRight") |
|
|
|
|
|
shinyjs::addClass(app_data$screen_next, "slideInLeft") |
|
|
} |
|
|
} |
|
|
if (!app_data$splash) { |
|
|
|
|
|
# cli::cat_line(strftime(Sys.time(), "%F %T"), " splash out") |
|
|
|
|
|
shinyjs::removeClass("splash-overlay", "slideInLeft") |
|
|
|
|
|
shinyjs::removeClass("app-main", "slideOutRight") |
|
|
|
|
|
shinyjs::addClass("app-main", "slideInRight") |
|
|
|
|
|
shinyjs::addClass("splash-overlay", "slideOutLeft") |
|
|
|
|
|
} else { |
|
|
|
|
|
# cli::cat_line(strftime(Sys.time(), "%F %T"), " splash in") |
|
|
|
|
|
shinyjs::removeClass("splash-overlay", "slideOutLeft") |
|
|
|
|
|
shinyjs::removeClass("app-main", "slideInRight") |
|
|
|
|
|
shinyjs::addClass("app-main", "slideOutRight") |
|
|
|
|
|
shinyjs::addClass("splash-overlay", "slideInLeft") |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# Update screen state |
|
|
|
|
|
app_data$screen_prev <- app_data$screen_active |
|
|
|
|
|
app_data$screen_active <- app_data$screen_next |
|
|
|
|
|
app_data$screen_next <- NULL |
|
|
}, priority = -100) |
|
|
}, priority = -100) |
|
|
} |
|
|
} |
|
|
|
|
|
|