tour | create structure for navigating tour stage

app/app/main.R

@@ -5,6 +5,7 @@ box::use(
 
 box::use(
   app / view / main_map,
+  app / view / tour,
   app / view / downloads,
   app / view / information,
 )
@@ -14,6 +15,10 @@ box::use(
 ui <- function(id) {
   ns <- shiny$NS(id)
   bslib$page_navbar(
+    bslib$nav_panel(
+      title = "Tour",
+      tour$ui(ns("tour"))
+    ),
     bslib$nav_panel(
       title = "Maps",
       main_map$ui(ns("maps"))
@@ -26,17 +31,13 @@ ui <- function(id) {
       title = "Information",
       information$ui(ns("information"))
     )
-    # make more pages for main map, downloads and information.
-    # bslib$nav_panel(
-    #   title = "tour",
-    #   tour$ui(ns("tour"))
-    # )
   )
 }
 
 #' @export
 server <- function(id) {
   shiny$moduleServer(id, function(input, output, session) {
+    tour$server("tour")
     main_map$server("maps")
     downloads$server("downloads")
     information$server("information")

app/app/view/tour/__init__.R

@@ -0,0 +1,7 @@
+#' @export
+box::use(
+  app / view / tour / page[
+    server,
+    ui,
+  ],
+)

app/app/view/tour/content.R

@@ -0,0 +1,64 @@
+box::use(
+  glue,
+  here,
+  shiny,
+)
+
+#' @export
+tour_card_width <- 300
+
+separator <- "<br>"
+
+img_width <- tour_card_width * 0.9
+
+app_src_dir <- here$here("app/static")
+tour_images_dir <- here$here("app/static/tour")
+
+#' @export
+get_tour_content <- function(tab) {
+  card_content <- content[[tab]]$card_content
+
+  list(
+    card_content = card_content
+  )
+}
+
+#' @export
+content <- list(
+  t1 = list(
+    card_content = paste(
+      sep = separator,
+      "<h3>Welcome to iTRAQI: injury Treatment & Rehabilitation Accessibility Queensland Index</h3>",
+      "This pilot study uses moderate-to-severe traumatic brain injury (TBI) to map and rank access to acute treatment and rehabilitation units.",
+      "Take this self-paced tour to explore and understand iTRAQI.",
+      glue$glue('<br><img src="tour-1-tbi-image.jpg" alt="tbi-image" style="width:{img_width}px;">')
+    )
+  ),
+  t2 = list(
+    card_content = paste(
+      sep = separator,
+      "<h3>Accessibility Indices</h3>",
+      "The most common measure of remoteness used in Australia is ARIA+ (Accessibility and Remoteness Index of Australia) and variants. ARIA+ groups are shown on this map. While most of Queensland’s land area is remote or very remote, these do not specifically consider access to health care.",
+      "For many injury types, timely access to treatment is a matter of life and death. For more severe injuries, such as TBI, access to rehabilitation is vital to regain function and improve quality of life."
+    )
+  ),
+  t3 = list(
+    card_content = paste(
+      sep = separator,
+      "<h3>Queensland</h3>",
+      "Since emergency services and hospitals are organised at the State level, our focus is on Queensland. Covering 1.7 million square kilometres, including very remote islands in the Torres Strait, moving seriously injured patients to the right hospital for time-sensitive emergency care is a challenge. In Queensland, we use helicopters, planes and road ambulances to transport patients quickly, with bases scattered throughout the State (see map).",
+      glue$glue(
+        '<div class="container">',
+        '<img src="tour-3-plane.jfif" alt="plane-image" align="left" style="width:{(img_width-15)*(4/9)}px;">',
+        '<img src="tour-3-ambulance.png" alt="ambulance-image" style="width:{(img_width-15)*(5/9)}px;">',
+        "</div>"
+      ),
+      '<img src="rsq.png" width="50"/>         : Aeromedical bases (n=13)',
+      '<img src="red-cross.png" width="50"/>   : Queensland Ambulance (n=302)'
+    )
+  )
+
+)
+
+#' @export
+n_tours <- length(content)

app/app/view/tour/page.R

@@ -0,0 +1,41 @@
+box::use(
+  bslib,
+  shiny,
+  waiter,
+)
+
+box::use(
+  # mapping module - might change this to rdeck if it's possible - they will need to have
+  # all the same functions in both modules so making generic names like "create map" and "update map" with generic inputs etc
+  mm = app / mapping,
+  app / view / tour / tour_navigation,
+  app / logic / load_shapes,
+  app / logic / wrangle_data,
+)
+
+
+#' @export
+ui <- function(id) {
+  ns <- shiny$NS(id)
+  shiny$div(
+    shiny$tagList(
+      bslib$card(
+        height = "calc(100vh - 100px)",
+        waiter$autoWaiter(html = waiter$spin_solar()),
+        mm$mapOutput(ns("map")),
+        tour_navigation$make_tour_nav_card_ui(ns = ns)
+      )
+    )
+  )
+}
+
+
+
+#' @export
+server <- function(id) {
+  shiny$moduleServer(id, function(input, output, session) {
+    output$map <- mm$make_base_map()
+  })
+
+  tour_navigation$make_tour_nav_card_server(id)
+}

app/app/view/tour/tour_navigation.R

@@ -0,0 +1,77 @@
+box::use(
+  bslib,
+  shiny,
+)
+
+box::use(
+  app / logic / constants,
+  app / logic / scales_and_palettes,
+  app / view / tour / content,
+)
+
+
+#' @export
+make_tour_nav_card_ui <- function(ns) {
+  shiny$absolutePanel(
+    width = 400,
+    top = 25,
+    right = 35,
+    shiny$uiOutput(ns("tour_card"))
+  )
+}
+
+
+#' @export
+make_tour_nav_card_server <- function(id) {
+  shiny$moduleServer(id, function(input, output, session) {
+    current_tour_tab <- shiny$reactiveVal(1)
+    ns <- session$ns
+
+    shiny$observeEvent(current_tour_tab(), {
+      tour <- content$get_tour_content(tab = current_tour_tab())
+
+      output$tour_card <- shiny$renderUI({
+        if(current_tour_tab() == 1) {
+          nav_buttons <- shiny$splitLayout(
+            cellWidths = 180,
+            NULL,
+            shiny$actionButton(ns("nextTourTab"), "Next")
+          )
+        } else if(current_tour_tab() == content$n_tours) {
+          nav_buttons <- shiny$splitLayout(
+            cellWidths = 180,
+            shiny$actionButton(ns("prevTourTab"), "Back"),
+            NULL
+          )
+        } else {
+          nav_buttons <- shiny$splitLayout(
+            cellWidths = 180,
+            shiny$actionButton(ns("prevTourTab"), "Back"),
+            shiny$actionButton(ns("nextTourTab"), "Next")
+          )
+        }
+
+        bslib$card(
+          shiny$HTML(tour$card_content),
+          nav_buttons
+        )
+      })
+    })
+
+
+    # navigate tour forward and back
+    shiny$observeEvent(input$nextTourTab, {
+      current_tour_tab(current_tour_tab() + 1)
+    })
+
+    shiny$observeEvent(input$prevTourTab, {
+      current_tour_tab(current_tour_tab() - 1)
+    })
+
+  })
+}
+
+
+
+
+