SymbolixAU / mapdeck
1
#' mapdeck dispatch
2
#'
3
#' Extension points for plugins
4
#'
5
#' @param map a map object, as returned from \code{\link{mapdeck}}
6
#' @param funcName the name of the function that the user called that caused
7
#'   this \code{mapdeck_dispatch} call; for error message purposes
8
#' @param mapdeck an action to be performed if the map is from
9
#'   \code{\link{mapdeck}}
10
#' @param mapdeck_update an action to be performed if the map is from
11
#'   \code{\link{mapdeck_update}}
12
#'
13
#' @return \code{mapdeck_dispatch} returns the value of \code{mapdeck} or
14
#' or an error. \code{invokeMethod} returns the
15
#' \code{map} object that was passed in, possibly modified.
16
#'
17
#' @export
18
mapdeck_dispatch = function(
19
  map,
20
  funcName,
21
  mapdeck = stop(paste(funcName, "requires a map update object")),
22
  mapdeck_update = stop(paste(funcName, "does not support map update objects"))
23
  ) {
24

25 1
  if (inherits(map, "mapdeck") | inherits(map, "google_map") )
26 1
    return(mapdeck)
27 0
  else if (inherits(map, "mapdeck_update") | inherits(map, "google_map_update"))
28 0
    return(mapdeck_update)
29
  else
30 0
    stop("mapdeck - Invalid map parameter")
31
}
32

33

34
#' @param method the name of the JavaScript method to invoke
35
#' @param ... unnamed arguments to be passed to the JavaScript method
36
#' @rdname mapdeck_dispatch
37
#' @export
38
invoke_method = function(map, method, ...) {
39 1
	args = evalFormula(list(...))
40 1
	mapdeck_dispatch(
41 1
		map,
42 1
		method,
43 1
		mapdeck = {
44 1
			x = map$x$calls
45 1
			if (is.null(x)) x = list()
46 1
			n = length(x)
47 1
			x[[n + 1]] = list(functions = method, args = args)
48 1
			map$x$calls = x
49 1
			map
50
		},
51 1
		mapdeck_update = {
52 0
			invoke_remote(map, method, args)
53
		}
54
	)
55
}
56

57

58
invoke_remote = function(map, method, args = list()) {
59

60 0
  if (!( inherits(map, "mapdeck_update") | inherits(map, "google_map_update") ) )
61 0
    stop("mapdeck - Invalid map parameter; mapdeck_update object was expected")
62

63

64 0
	calls <- "mapdeckmap-calls"
65 0
	if( inherits(map, "google_map_update")) calls <- "googlemap-calls"
66

67 0
  msg <- list(
68 0
    id = map$id,
69 0
    calls = list(
70 0
      list(
71 0
        dependencies = lapply(map$dependencies, shiny::createWebDependency),
72 0
        method = method,
73 0
        args = args
74
      )
75
    )
76
  )
77

78 0
  sess <- map$session
79 0
  if (map$deferUntilFlush) {
80

81 0
    sess$onFlushed(function() {
82 0
      sess$sendCustomMessage(calls, msg)
83 0
    }, once = TRUE)
84

85
  } else {
86 0
    sess$sendCustomMessage(calls, msg)
87
  }
88 0
  map
89
}
90

91

92
# Evaluate list members that are formulae, using the map data as the environment
93
# (if provided, otherwise the formula environment)
94
evalFormula = function(list, data) {
95 1
	evalAll = function(x) {
96 1
		if (is.list(x)) {
97 1
			structure(lapply(x, evalAll), class = class(x))
98 1
		} else resolveFormula(x, data)
99
	}
100 1
	evalAll(list)
101
}
102

103
resolveFormula = function(f, data) {
104 1
	if (!inherits(f, 'formula')) return(f)
105 0
	if (length(f) != 2L) stop("mapdeck - Unexpected two-sided formula: ", deparse(f))
106

107 0
	doResolveFormula(data, f)
108
}
109

110
doResolveFormula = function(data, f) {
111 0
	UseMethod("doResolveFormula")
112
}
113

114

115
doResolveFormula.data.frame = function(data, f) {
116 0
	eval(f[[2]], data, environment(f))
117
}
118

119
# Layer Id
120
#
121
# Checks the layer_id parameter, and provides a default one if NULL
122
# @param layer_id
123
layerId <- function(
124
	layer_id,
125
	layer = c("animated_arc", "animated_line", "arc", "bitmap", "cesium", "column",
126
						"geojson", "greatcircle","grid","heatmap","hexagon", "i3s",
127
						"line", "mesh", "path","pointcloud", "polygon","scatterplot", "screengrid", "terrain",
128
						"text", "title","trips")
129
	) {
130

131 1
	layer <- match.arg( layer )
132 1
	if (!is.null(layer_id) & length(layer_id) != 1)
133 1
		stop("mapdeck - please provide a single value for 'layer_id'")
134

135 1
	if (is.null(layer_id)) {
136 1
		return(paste0(layer, "-defaultLayerId"))
137
	} else {
138 1
		return(layer_id)
139
	}
140
}

Read our documentation on viewing source code .

Loading