Reactive objects with eventloop

reactive.Rmd

---
title: "Reactive Objects"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Reactive Objects}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```




## A block-based drawing canvas

Draw blocks as the mouse moves.

Extra logic is used to "decay" the size of the blocks depending upon
how long it has been since the mouse was near.


## Controls

* Press ESC to quit




```{r setup, eval=FALSE}
library(eventloop)
library(grid)
library(viridisLite)


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Global data encapsulating the state of the board
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
N <- 33
r <- 1/N/2
decay    <- 0.004
min_size <- 0.1
points <- expand.grid(
  x = seq(N)/N - r,
  y = seq(N)/N - r,
  r = r,
  scale = min_size
)

points$fill <- viridisLite::magma(nrow(points))
scale <- rep(min_size, nrow(points))


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Activate points within the board when the mouse is near
#' 
#' Press ESC to quit. event
#'        occurred.  Otherwise has `type` element set to:
#'        `event$type = 'mouse_down'` 
#'               - an event in which a mouse button was pressed
#'               - `event$button` gives the index of the button
#'        `event$type = 'mouse_up'`   
#'               - a mouse button was released
#'        `event$type = 'mouse_move'`   
#'               - mouse was moved 
#'        `event$type = 'key_press'`  
#'               - a key was pressed
#'               - `event$char` holds the character as string
#' @param mouse_x,mouse_y current location of mouse within window. If mouse is 
#'        not within window, this will be set to the last available coordinates
#' @param frame_num integer count of which frame this is
#' @param fps_actual,fps_target the curent framerate and the framerate specified
#'        by the user
#' @param dev_width,dev_height the width and height of the output device. Note:
#'        this does not cope well if you resize the window
#' @param ... any extra arguments ignored
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
canvas <- function(event, mouse_x, mouse_y, ...) {

  # Highlight points near mouse
  near <- (abs(points$x - mouse_x)+ abs(points$y - mouse_y)) < (1.4 * r)
  scale[near] <<- 1

  # Draw all the points
  grid::grid.rect(gp = grid::gpar(fill = 'white'))
  grid::grid.rect(
    x = points$x,
    y = points$y,
    width  = 2 * points$r * scale,
    height = 2 * points$r * scale,
    gp = grid::gpar(fill = points$fill, col = NA)
  )

  # decay the size of each point
  scale <<- pmax(scale - decay, min_size)
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Run the loop
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
run_loop(canvas, 10, 10, fps_target = 30)
```


Since an interactive window cannot be captured in a vignette, a video
screen capture has been taken of the window and included below.

<video controls>
  <source src="images/interact.mp4" type="video/mp4">
  Your browser does not support the video tag.
</video>