# Example of a valid snapping function: snap to nearest round number and
# make sure the overlay is at least 2 units wide.
mysnap <- function(ov, i) {
# remove any "out of bounds" overlays
oob <- seq_len(ov$n) %in% i &
(ov$cx0 < ov$bound_cx | ov$cx1 > ov$bound_cx + ov$bound_cw)
ov$active[oob] <- FALSE
# adjust position and with
widths <- pmax(2, round(ov$cx1[i] - ov$cx0[i]))
ov$cx0[i] <- pmax(round(ov$bound_cx),
pmin(round(ov$bound_cx + ov$bound_cw) - widths, round(ov$cx0[i])))
ov$cx1[i] <- pmin(round(ov$bound_cx + ov$bound_cw), ov$cx0[i] + widths)
}
ui <- shiny::fluidPage(
useOverlay(),
overlayPlotOutput("my_plot", 640, 480),
overlayToken("add", "Raise")
# further UI elements here . . .
)
server <- function(input, output) {
ov <- overlayServer("my_plot", 4, 1, snap = mysnap)
output$my_plot_menu <- renderUI({
i <- req(ov$editing)
textInput("label_input", "Overlay label", value = ov$label[i])
})
observeEvent(input$label_input, {
i <- req(ov$editing)
ov$label[i] <- input$label_input
})
output$my_plot <- shiny::renderPlot({
df <- data.frame(x = seq(0, 2 * pi, length.out = 200))
df$y <- sin(df$x) + 0.1 * sum(ov$active * (df$x > ov$cx0 & df$x < ov$cx1))
plot(df, type = "l")
overlayBounds(ov, "base")
})
# further server code here . . .
}
if (interactive()) {
shiny::shinyApp(ui, server)
}
Run the code above in your browser using DataLab