[R] rgl 0.100.54 using rgl.setMouseCallbacks in pan3d with rglwidget() and shiny server

[Kennard McDaniel]

I am currently attempting to implement rgl and the pan3d function on a 
shiny server but can't get the pan3d function to work. Using the right 
mouse button (2).  Here is a little sample code I was using to try to 
get it to work. Session info below the signature line.


  options(rgl.useNULL = TRUE)

  library(shiny)
  library(rgl)

app = shinyApp(
     ui =
       rglwidgetOutput("rglPlot")
      ,
   server = function(input, output) {
          output$rglPlot <- renderRglwidget({
            options(rgl.useNULL = TRUE)
            #rgl::open3d()

            # pan3d(2)

            ## setup pan function from right mouse button
            button <- 2
            dev = rgl.cur()
            subscene = currentSubscene3d(dev)

            start <- list()
            begin <- function(x, y) {
              activeSubscene <- rgl::par3d("activeSubscene", dev = dev)
              start$listeners <<- rgl::par3d("listeners", dev = dev, 
subscene = activeSubscene)
              for (sub in start$listeners) {
                init <- rgl::par3d(c("userProjection","viewport"), dev = 
dev, subscene = sub)
                init$pos <- c(x/init$viewport[3], 1 - 
y/init$viewport[4], 0.5)
                start[[as.character(sub)]] <<- init
              }
            }

            update <- function(x, y) {
              for (sub in start$listeners) {
                init <- start[[as.character(sub)]]
                xlat <- 2*(c(x/init$viewport[3], 1 - y/init$viewport[4], 
0.5) - init$pos)
                mouseMatrix <- rgl::translationMatrix(xlat[1], xlat[2], 
xlat[3])
                rgl::par3d(userProjection = mouseMatrix %*% 
init$userProjection, dev = dev, subscene = sub )
              }
            }
            rgl::rgl.setMouseCallbacks(button, begin, update, dev = dev, 
subscene = subscene)
            #cat("Callbacks set on button", button, "of rgl device", 
dev, "in subscene", subscene, "\n")


            spheres3d(rnorm(100), rnorm(100), rnorm(100,sd = 0.1), col = 
"red",
         radius = 0.1)
              axes3d()

             rglwidget()
         })
     })

runApp(app)
-- 

Thank you,

*Kennard J. McDaniel*

sessionInfo() R version 3.5.3 (2019-03-11) Platform: 
x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 
18363) Matrix products: default locale: [1] LC_COLLATE=English_United 
States.1252 LC_CTYPE=English_United States.1252 [3] 
LC_MONETARY=English_United States.1252 LC_NUMERIC=C [5] 
LC_TIME=English_United States.1252 attached base packages: [1] stats 
graphics grDevices utils datasets methods base other attached packages: 
[1] NiQMatrixFoamAnalysis_0.2.4 shiny_1.4.0.2 shinyRGL_0.1.0 [4] 
rgl_0.100.54 loaded via a namespace (and not attached): [1] Rcpp_1.0.4.6 
lattice_0.20-38 tidyr_1.0.3 [4] assertthat_0.2.1 digest_0.6.25 
packrat_0.5.0 [7] mime_0.9 R6_2.4.1 plyr_1.8.6 [10] odbc_1.2.2 
evaluate_0.14 ggplot2_3.3.0 [13] pillar_1.4.4 rlang_0.4.6 qcc_2.7 [16] 
misc3d_0.8-4 rstudioapi_0.11 miniUI_0.1.1.1 [19] blob_1.2.1 
rmarkdown_2.1 webshot_0.5.2 [22] stringr_1.4.0 htmlwidgets_1.5.1 
igraph_1.2.5 [25] bit_1.1-15.2 munsell_0.5.0 compiler_3.5.3 [28] 
httpuv_1.5.2 xfun_0.13 pkgconfig_2.0.3 [31] htmltools_0.4.0 
tidyselect_1.0.0 tibble_3.0.1 [34] SixSigma_0.9-52 codetools_0.2-16 
crayon_1.3.4 [37] dplyr_0.8.5 later_1.0.0 MASS_7.3-51.6 [40] 
nat.utils_0.5.1 grid_3.5.3 jsonlite_1.6.1 [43] xtable_1.8-4 gtable_0.3.0 
lifecycle_0.2.0 [46] DBI_1.1.0 magrittr_1.5 scales_1.1.0 [49] nat_1.8.14 
stringi_1.4.6 nabor_0.5.0 [52] reshape2_1.4.4 promises_1.1.0 
testthat_2.3.2 [55] ellipsis_0.3.0 vctrs_0.2.4 plot3D_1.3 [58] 
tools_3.5.3 bit64_0.9-7 manipulateWidget_0.10.1 [61] glue_1.4.0 
purrr_0.3.4 hms_0.5.3 [64] crosstalk_1.1.0.1 fastmap_1.0.1 yaml_2.2.1 
[67] colorspace_1.4-1 filehash_2.4-2 knitr_1.28



	[[alternative HTML version deleted]]