setUserCallbacks() to scene generated with newSubscene3d()

36 views Asked by At

I'm having trouble figuring out how to apply the callback function set by setUserCallbacks() to scene generated with newSubscene3d(), except for the first scene.

In the example below, the added scene covers the bottom left of the original scene, but I can't figure out how to receive events in this part.

If the desired output is not HTML, several methods are possible. For example, One could create a scene that covers the entire viewport as the topmost scene to receive and process events on behalf of other scenes.

% R -e rmarkdown::render"('index.Rmd',output_file='index.html')"
---
title: "WebGL callback for a subscene created with newSubscene3d()"
output: html_document
vignette: >
  %\VignetteIndexEntry{Callback implementation}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
library(knitr)
library(rgl)
options(rgl.useNULL = TRUE)
setupKnitr(autoprint = FALSE)
opts_chunk$set(echo=FALSE, error=FALSE, warning=FALSE, message=FALSE)
knit_hooks$set(webgl = hook_webgl)
setupKnitr(autoprint = FALSE)
```

```{r}
sys.source("ex.R", envir = knit_global())

func1()

scene <- setUserCallbacks("left", 
      begin = "alert('AAA')", 
      update = "alert('BBB')", 
      end = "alert('CCC')",
      scene = scene3d(minimal = FALSE),
      subscene = scene3d(minimal = FALSE)$rootSubscene$id,
      applyToScene = TRUE,
      applyToDev = FALSE)

rglwidget(scene)
```
## This is ex.R.

library(rgl)

func1 <- function() {

  func1.dev.id <- open3d()
  func1.scene.1 <- subsceneInfo()$id

  par3d(windowRect = c(0, 0, 500, 500))
  view3d(theta=0, phi=0, zoom=1, fov=0)
  spheres3d(0,0,0, r=10, color = "green", alpha=0.5) # 
  spheres3d(500,500,0, r=10, color = "green", alpha=0.5) # 

  start <- list()

  begin <- function(x, y) {
    set3d(func1.dev.id, silent = TRUE)
    start$x <<- x
    start$y <<- y
    start$umat <<- par3d(subscene = func1.scene.1, "userMatrix")
    start$umat <<- par3d(subscene = func1.scene.2, "userMatrix")
  }

  update <- function(x, y) {
    viewport <- par3d("viewport")    
    x <- (x - start$x) / viewport[["width"]] / 1 # 1 is enpirically determined
    y <- (y - start$y) / viewport[["height"]] / 1
    umat <- start$umat
    umat <- umat %*% rotationMatrix(x, 0, 1, 0) # disp. y
    umat <- umat %*% rotationMatrix(y, 1, 0, 0) # disp. x

    par3d(subscene = func1.scene.1, userMatrix=umat)
    par3d(subscene = func1.scene.2, userMatrix=umat)
  }

  func1.scene.2 <- newSubscene3d(newviewport = c(0, 0, 200, 200))
  useSubscene3d(func1.scene.2)

  spheres3d(0,200,0, r=10, color = "red", alpha=0.5) # 
  spheres3d(200,0,0, r=10, color = "red", alpha=0.5) # 

  rgl.setMouseCallbacks(1, begin, update)
}
1

There are 1 answers

3
user2554330 On

You are asking to set the callback on the root subscene when you write subscene = scene3d(minimal = FALSE)$rootSubscene$id. You should use the id of the subscene you intended if it wasn't the root subscene.

Additionally, the expression scene3d(minimal = FALSE)$rootSubscene$id is more complicated than it needs to be. The ids used in rglwidget() displays are the same ids as in the R session. So if you want a callback on the subscene that you created with

func1.scene.2 <- newSubscene3d(newviewport = c(0, 0, 200, 200))

then you should save the value func1.scene.2, and use that value as the subscene argument in your call to setUserCallbacks. The simplest way to do that is to return it from func1, and then use this code in your document:

sys.source("ex.R", envir = knit_global())

subsceneid <- func1()

scene <- setUserCallbacks("left", 
      begin = "alert('AAA')", 
      update = "alert('BBB')", 
      end = "alert('CCC')",
      scene = scene3d(minimal = FALSE),
      subscene = subsceneid,
      applyToScene = TRUE,
      applyToDev = FALSE)

rglwidget(scene)

I just tried your code with my fix, and discovered that there's a bug in one of the functions used by setUserCallbacks(), so my fix doesn't work. It should work once version 1.2.15 or higher of rgl is available. Try using the devel version (remotes::install_github("dmurdoch/rgl") should install it) once it is online.