1919# ' @param width the width of the map
2020# ' @param height the height of the map
2121# ' @param padding the padding of the map
22+ # ' @param options the map options
2223# ' @return A HTML widget object, on which we can add graphics layers using
2324# ' \code{\%>\%} (see examples).
2425# ' @example inst/examples/leaflet.R
2526# ' @export
26- leaflet = function (data = NULL , width = NULL , height = NULL , padding = 0 ) {
27+ leaflet = function (data = NULL , width = NULL , height = NULL ,
28+ padding = 0 , options = leafletOptions()) {
29+
30+ # Validate the CRS if specified
31+ if (! is.null(options [[' crs' &&
32+ ! inherits(options [[' crs' ' leaflet_crs'
33+ stop(" CRS in mapOptions should be a return value of leafletCRS() function"
34+ }
35+
2736 htmlwidgets :: createWidget(
2837 ' leaflet'
2938 structure(
30- list (),
39+ list (options = options ),
3140 leafletData = data
3241 ),
3342 width = width , height = height ,
@@ -36,10 +45,32 @@ leaflet = function(data = NULL, width = NULL, height = NULL, padding = 0) {
3645 defaultHeight = 400 ,
3746 padding = padding ,
3847 browser.fill = TRUE
39- )
48+ ),
49+ preRenderHook = function (widget ) {
50+ if (! is.null(widget $ jsHooks $ render )) {
51+ widget $ jsHooks $ render <- lapply(widget $ jsHooks $ render , function (hook ) {
52+ if (is.list(hook )) {
53+ hook $ code <- sprintf(hookWrapperTemplate , paste(hook $ code , collapse = " \n "
54+ } else if (is.character(hook )) {
55+ hook <- sprintf(hookWrapperTemplate , paste(hook , collapse = " \n "
56+ } else {
57+ stop(" Unknown hook class " hook ))
58+ }
59+ hook
60+ })
61+ }
62+ widget
63+ }
4064 )
4165}
4266
67+ hookWrapperTemplate <- " function(el, x, data) {
68+ return (%s).call(this.getMap(), el, x, data);
69+ }"
70+
71+ # ' returns the map's data
72+ # ' @param map the map
73+ # ' @export
4374getMapData = function (map ) {
4475 attr(map $ x , " leafletData" exact = TRUE )
4576}
@@ -70,3 +101,98 @@ mapOptions <- function(map, zoomToLimits = c("always", "first", "never")) {
70101
71102 map
72103}
104+
105+ # ' Options for Map creation
106+ # ' @param minZoom Minimum zoom level of the map. Overrides any minZoom set on map layers.
107+ # ' @param maxZoom Maximum zoom level of the map. This overrides any maxZoom set on map layers.
108+ # ' @param crs Coordinate Reference System to use. Don't change this if you're not sure what it means.
109+ # ' @seealso \code{\link{leafletCRS}} for creating a custom CRS.
110+ # ' @param worldCopyJump With this option enabled, the map tracks when you pan to another "copy" of the world and seamlessly jumps to the original one so that all overlays like markers and vector layers are still visible.
111+ # ' @param ... other options.
112+ # ' @describeIn leaflet Options for map creation
113+ # ' @seealso \url{http://leafletjs.com/reference.html#map-options} for details.
114+ # ' @export
115+ leafletOptions <- function (
116+ minZoom = NULL ,
117+ maxZoom = NULL ,
118+ crs = leafletCRS(),
119+ worldCopyJump = NULL ,
120+ ... ) {
121+ filterNULL(
122+ list (
123+ minZoom = minZoom ,
124+ maxZoom = maxZoom ,
125+ crs = crs ,
126+ worldCopyJump = worldCopyJump ,
127+ ... )
128+ )
129+ }
130+
131+ # CRS classes supported
132+ crsClasses <- list (' L.CRS.EPSG3857' ' L.CRS.EPSG4326' ' L.CRS.EPSG3395'
133+ ' L.CRS.Simple' ' L.Proj.CRS' ' L.Proj.CRS.TMS'
134+
135+ # ' creates a custom CRS
136+ # ' Refer to \url{https://kartena.github.io/Proj4Leaflet/api/} for details.
137+ # ' @param crsClass One of L.CRS.EPSG3857, L.CRS.EPSG4326, L.CRS.EPSG3395,
138+ # ' L.CRS.Simple, L.Proj.CRS, L.Proj.CRS.TMS
139+ # ' @param code CRS identifier
140+ # ' @param proj4def Proj4 string
141+ # ' @param projectedBounds Only when crsClass = 'L.Proj.CRS.TMS'
142+ # ' @param origin Origin in projected coordinates, if set overrides transformation option.
143+ # ' @param transformation to use when transforming projected coordinates into pixel coordinates
144+ # ' @param scales Scale factors (pixels per projection unit, for example pixels/meter)
145+ # ' for zoom levels; specify either scales or resolutions, not both
146+ # ' @param resolutions factors (projection units per pixel, for example meters/pixel)
147+ # ' for zoom levels; specify either scales or resolutions, not both
148+ # ' @param bounds Bounds of the CRS, in projected coordinates; if defined,
149+ # ' Proj4Leaflet will use this in the getSize method, otherwise
150+ # ' defaulting to Leaflet's default CRS size
151+ # ' @param tileSize Tile size, in pixels, to use in this CRS (Default 256)
152+ # ' Only needed when crsClass = 'L.Proj.CRS.TMS'
153+ # ' @describeIn leaflet class to create a custom CRS
154+ # ' @export
155+ leafletCRS <- function (
156+ crsClass = ' L.CRS.EPSG3857'
157+ code = NULL ,
158+ proj4def = NULL ,
159+ projectedBounds = NULL ,
160+ origin = NULL ,
161+ transformation = NULL ,
162+ scales = NULL ,
163+ resolutions = NULL ,
164+ bounds = NULL ,
165+ tileSize = NULL
166+ ) {
167+ if (! crsClass %in% crsClasses ) {
168+ stop(sprintf(" crsClass argument must be one of %s"
169+ paste0(crsClasses , collapse = ' , '
170+
171+ }
172+ if (crsClass %in% c(' L.Proj.CRS' ' L.Proj.CRS.TMS' &&
173+ ! is.null(scales ) && ! is.null(resolutions )) {
174+ stop(sprintf(" Either input scales or resolutions"
175+ }
176+ if (crsClass %in% c(' L.Proj.CRS' ' L.Proj.CRS.TMS' &&
177+ is.null(scales ) && is.null(resolutions )) {
178+ stop(sprintf(" Input either scales or resolutions, not both"
179+ }
180+ structure(
181+ list (
182+ crsClass = crsClass ,
183+ code = code ,
184+ proj4def = proj4def ,
185+ projectedBounds = projectedBounds ,
186+ options = filterNULL(list (
187+ origin = origin ,
188+ transformation = transformation ,
189+ scales = scales ,
190+ resolutions = resolutions ,
191+ bounds = bounds ,
192+ tileSize = tileSize
193+ ))
194+ ),
195+ class = ' leaflet_crs'
196+ )
197+ }
198+
0 commit comments