Search code examples
rshinyzooming

Reset button reset svg in random size when "-" is pressed multiple times


In the shiny app below I zoom and reset on a svg file. As you can see in the gif if you click the buttons quickly in succession, the script seems to lose track and resize randomly? In the gif, I click the - button repeatedly and then at the end press Reset.

library(shiny)
library(shinyWidgets)
library(DiagrammeR)
library(magrittr)

js <- '
$(document).ready(function(){
  var instance;
  var myinterval = setInterval(function(){
    var element = document.getElementById("grr");
    if(element !== null){
      clearInterval(myinterval);
      instance = panzoom(element);
    }
  }, 100);
  var z = 1;
  $("body").on("click", "#zoomout", function(){
    instance.smoothZoom(0, 0, 0.9);
    z *= 0.9;
  });
  $("body").on("click", "#zoomin", function(){
    instance.smoothZoom(0, 0, 1.1);
    z *= 1.1;
  });
  $("body").on("click", "#reset", function(){
    instance.smoothZoom(0, 0, 1/z);
    z = 1;
  });
  $("body").on("dblclick", "#zoomout", function(){
    return false;
  });
  $("body").on("dblclick", "#zoomin", function(){
    return false;
  });
});
'

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://unpkg.com/panzoom@9.4.0/dist/panzoom.min.js"),
    tags$script(HTML(js))
  ),
  
  uiOutput("main")
  #grVizOutput("grr", width = "100%", height = "90vh"),
)

server <- function(input, output) {
  
  output$main <- renderUI({
    div(
      grVizOutput("grr", width = "100%", height = "90vh"),
      
      actionGroupButtons(
        inputIds = c("zoomout", "zoomin", "reset"),
        labels = list(icon("minus"), icon("plus"), "Reset"),
        status = "primary"
      )
    )
    
  })
  output$grr <- renderGrViz(render_graph(
    create_graph() %>%
      add_n_nodes(n = 2) %>%
      add_edge(
        from = 1,
        to = 2,
        edge_data = edge_data(
          value = 4.3
        )
      )
  ))
  
}

shinyApp(ui, server)  

Solution

  • Here is a similar app with another panzoom library. It works better.

    library(shiny)
    library(shinyWidgets)
    library(DiagrammeR)
    library(magrittr)
    
    js <- '
      var element = document.getElementById("grr");
      var panzoom = Panzoom(element, {
        maxScale: 5
      });
      var z = 1;
      $("#zoomout").on("click", function(){
        z *= 0.9;
        panzoom.zoom(z, { animate: true });
      });
      $("#zoomin").on("click", function(){
        z *= 1.1;
        panzoom.zoom(z, { animate: true });
      });
      $("#reset").on("click", function(){
        z = 1;
        panzoom.reset();
      });
    '
    
    ui <- fluidPage(
      tags$head(
        tags$script(src = "https://unpkg.com/@panzoom/panzoom@4.4.3/dist/panzoom.min.js")
      ),
    
      uiOutput("main")
    )
    
    server <- function(input, output) {
    
      output$main <- renderUI({
        tagList(
          div(
            grVizOutput("grr", width = "100%", height = "90vh"),
    
            actionGroupButtons(
              inputIds = c("zoomout", "zoomin", "reset"),
              labels = list(icon("minus"), icon("plus"), "Reset"),
              status = "primary"
            )
          ),
          tags$script(HTML(js))
        )
    
      })
    
      output$grr <- renderGrViz(render_graph(
        create_graph() %>%
          add_n_nodes(n = 2) %>%
          add_edge(
            from = 1,
            to = 2,
            edge_data = edge_data(
              value = 4.3
            )
          )
      ))
    
    }
    
    shinyApp(ui, server)