这是indexloc提供的服务，不要输入任何密码
Skip to content

fix to get the pan up/down not reversed #27

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Aug 12, 2015
Merged

fix to get the pan up/down not reversed #27

Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
0bc3a85
get svgPanZoom working correctly
timelyportfolio Aug 7, 2015
d09b6e7
Merge branch 'master' of https://github.com/mtennekes/tmap
timelyportfolio Aug 7, 2015
61a9c58
use height and width from the tmap for the htmlwidget height and width
timelyportfolio Aug 7, 2015
fe36673
add check to make sure title exists before creating new node
timelyportfolio Aug 7, 2015
9d002b9
add height and width for htmlwidget container that should autoscale, …
timelyportfolio Aug 7, 2015
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
129 changes: 114 additions & 15 deletions pkg/R/tmap2svg.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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?
Expand Down Expand Up @@ -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% names(xmlAttrs(g_el))){
addChildren(
g_el
, newXMLNode("title",xmlAttrs(g_el)[["title"]])
)
}
}
)

Expand Down Expand Up @@ -97,17 +99,114 @@ 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]] )

# 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
, viewportSelector = ".map_viewport"
, controlIconsEnabled = TRUE
, center = FALSE
, width = width
, height = height
)

}










################### 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
}