R Shiny: how to keep zoom and pan from svgPanZoomOutput on input change?
Asked Answered
F

0

8

I've got a Shiny app in which I'm displaying some images. For a selected image I have pan and zoom (using svgPanZoom package) and brightness change (using sliderInput). Also on button click I am moving to next image. Unfortunately whenever I'm clicking on a button or changing value on a slider zoom and pan is resetting (which is not surprising). See example below:

Exaple app

Is there any way to keep the pan and zoom values on inputs change ? I was thinking of a javascript code in which I would save those values and send them to new input using Shiny.setInputValue, but for now I can't even get current pan and zoom.

Here is my example app code and JS I was trying to run:

# global.R
library(tidyverse)
library(shiny.semantic)
library(semantic.dashboard)
library(svgPanZoom)
library(SVGAnnotation)

# Some image data
imgs <- 1:2 %>% map(~ array(runif(1080 * 680 * 3), dim = c(1080, 680, 3)))

# Zoom script
zoom_script <-   tags$script(HTML(
  'window.onload = function() {
var rtg_plot = document.getElementById("picture");
var btn_next = document.getElementById("next_pic");
btn_next.addEventListener("click", printZoom, false);
function printZoom() {
    x = rtg_plot.getPan()
    console.log(x)
}
}'
))
# ui.R
semanticPage(
  tags$head(
    tags$link(
      rel = "stylesheet", type = "text/css", id = "bootstrapCSS",
      href = "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css"
    ),
    tags$script(src = "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js")
  ),
  zoom_script,
  div(style = "height: 900px; overflow-y: scroll; padding: 10px;", class = "ui grid",
      box(
        title = "Picture", color = "blue", ribbon = TRUE, title_side = "top left", collapsible = FALSE, width = 16,
        div(class = "ui grid", style = "max-height: 920px; padding: 10px;",
            fluidRow(style = "text-align: center;",
                     column(8, sliderInput("slider", "slider", min = -100, max = 100, step = 1, value = 0)),
                     column(8, actionButton(inputId = "next_pic", label = "Next image")))
        ),
        fluidRow(style = "text-align: center;",
                 column(16, svgPanZoomOutput("picture", height = "100%", width = "100%"))
        )
      )
  )
)
# server.R
shinyServer(function(input, output, session) {
  # Image indicator
  indicator <- reactiveVal(1)

  # Image output
  img <- reactive({
    ind <- indicator() %% 2 +1
    (imgs[[ind]])^(1 - input$slider / 100)
  }) %>% debounce(20)

  output$picture <- renderSvgPanZoom(svgPanZoom(svgPlot(grid::grid.raster(img(), interpolate = FALSE)), viewBox = FALSE))

  observeEvent(input$next_pic, {
    new_ind <- indicator() + 1
    indicator(new_ind)
  })

})
Forestforestage answered 20/9, 2019 at 17:18 Comment(1)
I don't know those features but I would think of something like: 1/ saving the parameters in a reactiveValues with an observeEvent of higher priority, 2/ letting the input work and 3/ use an update*() method to reuse your parameters.Bairn

© 2022 - 2024 — McMap. All rights reserved.