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

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/[email protected]/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)

CodePudding user response：

That's the same strange bug I encountered the first time. A possible solution is to put the script in the renderUI:

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

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

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://unpkg.com/[email protected]/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)