---
title: "Interactive overlays in Shiny"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Interactive overlays in Shiny}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

```{r}
library(shiny)
library(ggplot2)
library(overshiny)

# --- User interface ---
ui <- fluidPage(
    # Load overshiny
    useOverlay(),

    # Lighten the sidebar background
    tags$head(tags$style(".well { background-color: white }")),

    titlePanel("Overlay demo"),

    sidebarLayout(
        sidebarPanel(
            # Control whether overlays are displayed and whether they alter the plot
            checkboxInput("show_overlays", "Show overlays", value = TRUE),
            checkboxInput("enable_logic", "Enable overlay logic", value = TRUE),
            tags$hr(),

            # Select date range for the plot
            dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
            tags$hr(),

            # Overlay controls: tokens that can be dragged onto the plot
            h5("Drag tokens below onto the plot:"),
            overlayToken("grow", "Grow"),
            overlayToken("shrink", "Shrink")
        ),

        mainPanel(
            # Main plot with support for overlays
            overlayPlotOutput("plot", width = "100%", height = 300)
        )
    )
)

# --- App logic ---
server <- function(input, output, session)
{
    # --- OVERLAY SETUP ---

    # Initialise 8 draggable/resizable overlays
    ov <- overlayServer("plot", 8, width = 56) # 56 days = 8 weeks default width

    # Reactive values to store custom per-overlay settings
    opt <- reactiveValues(
        type = rep("Grow", 8),        # type of overlay action
        strength = rep(50, 8)         # strength as a percentage
    )

    # Toggle overlay visibility based on checkbox
    observe({
        ov$show <- isTRUE(input$show_overlays)
    })

    # --- OVERLAY DROPDOWN MENU ---

    # Render dropdown menu when an overlay is being edited
    output$plot_menu <- renderUI({
        i <- req(ov$editing)  # Current overlay being edited
        tagList(
            textOutput("dates"),
            selectInput("type", NULL, choices = c("Grow", "Shrink"), selected = ov$label[i]),
            sliderInput("strength", "Strength", min = 0, max = 100, value = opt$strength[i])
        )
    })

    # Display date range for the currently edited overlay
    output$dates <- renderText({
        i <- req(ov$editing)
        fmt <- function(t) format(as.Date(round(t), origin = "1970-01-01"), "%b %d")
        paste(fmt(ov$cx0[i]), "–", fmt(ov$cx1[i]))
    })

    # Update stored strength when the slider changes
    observeEvent(input$strength, {
        i <- req(ov$editing)
        opt$strength[i] <- input$strength
    })

    # Update stored type and overlay label when dropdown changes
    observeEvent(input$type, {
        i <- req(ov$editing)
        opt$type[i] <- input$type
        ov$label[i] <- input$type
    })

    # --- DATA PROCESSING BASED ON OVERLAY POSITION ---

    # Reactive dataset: oscillating signal modified by active overlays
    data <- reactive({
        date_seq <- seq(input$date_range[1], input$date_range[2], by = "1 day")
        y <- 1 + 0.5 * sin(as.numeric(date_seq) / 58)  # oscillating signal

        # Modify signal according to active overlays if logic is enabled
        if (isTRUE(input$enable_logic)) {
            for (i in which(ov$active)) {
                start <- as.Date(round(ov$cx0[i]), origin = "1970-01-01")
                end <- as.Date(round(ov$cx1[i]), origin = "1970-01-01")
                in_range <- date_seq >= start & date_seq <= end
                factor <- opt$strength[i] / 100
                y[in_range] <- y[in_range] * if (ov$label[i] == "Grow") (1 + factor) else (1 - factor)
            }
        }

        data.frame(date = date_seq, y = y)
    })

    # --- RENDERING OF DATA ---

    # Render plot and align overlays to current axis limits
    output$plot <- renderPlot({
        plot <- ggplot(data()) +
            geom_line(aes(x = date, y = y)) +
            ylim(0, 3) +
            labs(x = NULL, y = "Signal")

        overlayBounds(ov, plot,
            xlim = c(input$date_range),
            ylim = c(0, NA))
    })
}

# --- Run app ---
if (interactive()) {
    shinyApp(ui, server)
}
```