From 0bc3a85c5d911d24b881d1adf01cc9a77711c8ce Mon Sep 17 00:00:00 2001 From: timelyportfolio Date: Fri, 7 Aug 2015 08:30:16 -0500 Subject: [PATCH 1/4] get svgPanZoom working correctly --- pkg/R/tmap2svg.R | 96 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 86 insertions(+), 10 deletions(-) diff --git a/pkg/R/tmap2svg.R b/pkg/R/tmap2svg.R index e88059709..d523041b9 100644 --- a/pkg/R/tmap2svg.R +++ b/pkg/R/tmap2svg.R @@ -85,17 +85,93 @@ tmap2svg <- function(tm, file=NULL) { } # add pan zoom with svgPanZoom htmlwidget - svgPanZoom( - tmap_svg #grid.export(name = NULL)$svg #works but no interactivity from above - , controlIconsEnabled = TRUE - ) +# svgPanZoom( +# tmap_svg #grid.export(name = NULL)$svg #works but no interactivity from above +# , controlIconsEnabled = TRUE +# ) # restrict zoom to just the mapElements - # for now pan up/down is reversed, but can be fixed -# svgPanZoom( -# tmap_svg #grid.export(name = NULL)$svg #works but no interactivity from above -# , viewportSelector = "#mapElements\\.1" -# , controlIconsEnabled = TRUE -# ) + mapel <- getNodeSet( tmap_svg,"//*[contains(@id,'mapElements.1')]") + xmlAttrs(mapel[[1]]) <- c(xmlAttrs(mapel[[1]]),"transform"="scale(1,-1)") + + mapel_container <- newXMLNode( + "g" + , attrs = c( "transform"="scale(1,-1)") + ) + mapel_g <- newXMLNode( + "g" + , attrs = c("class"="map_viewport") + ) + replaceNodes( mapel[[1]], mapel_container ) + addChildren( mapel_container, mapel_g ) + addChildren( mapel_g, mapel[[1]] ) + + + svgPanZoom( + tmap_svg #grid.export(name = NULL)$svg #works but no interactivity from above + , viewportSelector = ".map_viewport" + , controlIconsEnabled = TRUE + ) + +} + + + + + + + + + + +################### all so I remember the hard times ####################### +function(){ + # this only works partially + # adding beforePan <- + reversePan <- htmlwidgets::JS( + ' + function( oldPan, newPan ){ + // reverse the y direction of the pan + var stopHorizontal = false + , stopVertical = false + var customPan = {}; + + customPan.x = newPan.x; + customPan.y = -newPan.y; + console.log("old"); + console.log(oldPan); + console.log("new"); + console.log(newPan); + console.log("custom"); + console.log(customPan); + + + return customPan; + } + ' + ) + + tmsvg <- tmap2svg(tm_shape(World) + tm_polygons("pop_est")) + + tmxml <- xmlParse(tmsvg$x$svg) + mapel <- getNodeSet( tmxml,"//*[contains(@id,'mapElements.1')]") + xmlAttrs(mapel[[1]]) <- c(xmlAttrs(mapel[[1]]),"transform"="scale(1,-1)") + + mapel_container <- newXMLNode( + "g" + , attrs = c( "transform"="scale(1,-1)") + ) + mapel_g <- newXMLNode( + "g" + , attrs = c("class"="map_viewport") + ) + replaceNodes( mapel[[1]], mapel_container ) + addChildren( mapel_container, mapel_g ) + addChildren( mapel_g, mapel[[1]] ) + + + tmsvg$x$svg <- saveXML( tmxml ) + tmsvg$x$config$viewportSelector = ".svg_pan_viewport" + tmsvg } \ No newline at end of file From 61a9c584accd9d66f53ef6656c007ffd861abca1 Mon Sep 17 00:00:00 2001 From: timelyportfolio Date: Fri, 7 Aug 2015 11:24:52 -0500 Subject: [PATCH 2/4] use height and width from the tmap for the htmlwidget height and width --- pkg/R/tmap2svg.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pkg/R/tmap2svg.R b/pkg/R/tmap2svg.R index ec6157516..17a0d52e0 100644 --- a/pkg/R/tmap2svg.R +++ b/pkg/R/tmap2svg.R @@ -123,6 +123,8 @@ tmap2svg <- function(tm, file=NULL) { tmap_svg #grid.export(name = NULL)$svg #works but no interactivity from above , viewportSelector = ".map_viewport" , controlIconsEnabled = TRUE + , width = xmlAttrs(xmlRoot(tmap_svg))[["width"]] + , height = xmlAttrs(xmlRoot(tmap_svg))[["height"]] ) } From fe3667335bd0762fde9214a80b0fe6072e7d99af Mon Sep 17 00:00:00 2001 From: timelyportfolio Date: Fri, 7 Aug 2015 11:42:02 -0500 Subject: [PATCH 3/4] add check to make sure title exists before creating new node --- pkg/R/tmap2svg.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/pkg/R/tmap2svg.R b/pkg/R/tmap2svg.R index 17a0d52e0..e0f73f844 100644 --- a/pkg/R/tmap2svg.R +++ b/pkg/R/tmap2svg.R @@ -59,10 +59,12 @@ tmap2svg <- function(tm, file=NULL) { tmap_svg ,"//*[local-name() = 'g' and starts-with(@id, 'tm_polygon')]" ,function(g_el){ - addChildren( - g_el - , newXMLNode("title",xmlAttrs(g_el)[["title"]]) - ) + if("title" %in% xmlAttrs(g_el)){ + addChildren( + g_el + , newXMLNode("title",xmlAttrs(g_el)[["title"]]) + ) + } } ) From 9d002b97d9af13074e625143305e6a50942b732c Mon Sep 17 00:00:00 2001 From: timelyportfolio Date: Fri, 7 Aug 2015 15:29:58 -0500 Subject: [PATCH 4/4] add height and width for htmlwidget container that should autoscale, remove svg elements --- pkg/R/tmap2svg.R | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/pkg/R/tmap2svg.R b/pkg/R/tmap2svg.R index e0f73f844..cdf2367ac 100644 --- a/pkg/R/tmap2svg.R +++ b/pkg/R/tmap2svg.R @@ -10,7 +10,7 @@ #' @import XML #' @example ../examples/tmap2svg.R #' @export -tmap2svg <- function(tm, file=NULL) { +tmap2svg <- function(tm, file=NULL, width = NULL, height = NULL ) { tmp <- tempfile() # Can I get the grid object, without actually plotting it? @@ -59,7 +59,7 @@ tmap2svg <- function(tm, file=NULL) { tmap_svg ,"//*[local-name() = 'g' and starts-with(@id, 'tm_polygon')]" ,function(g_el){ - if("title" %in% xmlAttrs(g_el)){ + if("title" %in% names(xmlAttrs(g_el))){ addChildren( g_el , newXMLNode("title",xmlAttrs(g_el)[["title"]]) @@ -119,14 +119,33 @@ tmap2svg <- function(tm, file=NULL) { replaceNodes( mapel[[1]], mapel_container ) addChildren( mapel_container, mapel_g ) addChildren( mapel_g, mapel[[1]] ) - + + # remove clip-path attribute to fill htmlwidget container + lapply( + getNodeSet(tmap_svg,"//*[contains(@clip-path,'url')]") + ,function(g_clip){ + x_attrs = xmlAttrs(g_clip) + removeAttributes(g_clip) + xmlAttrs(g_clip) <- x_attrs[-match('clip-path',names(x_attrs))] + } + ) + # also remove the map frame rect, since will no longer fit + invisible(xpathApply(tmap_svg,"//*[local-name()='g'][contains(@id,'mapFrame')]",removeNodes)) + # remove mapBG + removeNodes(getNodeSet(tmap_svg,"//*[contains(@id,'mapBG')]")[[1]]) + + if(is.null(width) || is.null(height)){ + width <- xmlAttrs(xmlRoot(tmap_svg))[["width"]] + height <- xmlAttrs(xmlRoot(tmap_svg))[["height"]] + } svgPanZoom( - tmap_svg #grid.export(name = NULL)$svg #works but no interactivity from above + tmap_svg , viewportSelector = ".map_viewport" , controlIconsEnabled = TRUE - , width = xmlAttrs(xmlRoot(tmap_svg))[["width"]] - , height = xmlAttrs(xmlRoot(tmap_svg))[["height"]] + , center = FALSE + , width = width + , height = height ) }