
library(osmar)
src <- osmsource_api()
bb <- center_bbox(174.77, -36.851, 700, 700)
# ua <- get_osm(bb, source = src)
# save(ua, file="ua.rda")
load("ua.rda")

street_ids <- find(ua, way(tags(k == "highway" & v != "pedestrian")))
street_ids <- find_down(ua, way(street_ids))
path_ids <- find(ua, way(tags(k == "highway" & v == "pedestrian")))
path_ids <- find_down(ua, way(path_ids))

streets <- subset(ua, ids = street_ids)
paths <- subset(ua, ids = path_ids)

bg_ids <- find(ua, way(tags(k == "building")))
bg_ids <- find_down(ua, way(bg_ids))
bg <- subset(ua, ids = bg_ids)

bg_poly <- as_sp(bg, "polygons")
street_line <- as_sp(streets, "lines")
path_line <- as_sp(paths, "lines")

library(grid)

##############################################################################
# Campus map

campusMap <- function() {
    print(spplot(bg_poly, z=1, col.regions="lightblue", colorkey=FALSE),
          prefix="campus")
    grid.edit("campus.background", gp=gpar(fill="grey"))
    grid.remove("border", grep=TRUE)
    downViewport("campus.panel.1.1.vp")
    sp.lines(street_line, lwd=1)
    sp.lines(path_line, lty="dotted")
}

pdf("campus-%d.pdf", onefile=FALSE)
campusMap()
dev.off()

library(gridSVG)
gridsvg("campus.svg")
campusMap()
dev.off()

# pdf("campus-shading-%d.pdf", onefile=FALSE)
# campusMap()
# sp.polygons(campus_poly, col=NA, fill=rgb(1,1,0,.3))
# dev.off()

# gridsvg("campus-shading.svg")
# campusMap()
# sp.polygons(campus_poly, col=NA, fill=rgb(1,1,0,.3))
# dev.off()

##############################################################################
# Animation

smoothStep <- function(xy, one, two, dist) {
    x <- xy[one:two, 1]
    y <- xy[one:two, 2]
    dx <- diff(x)
    dy <- diff(y)
    dd <- dx*dx + dy*dy
    if (dd > dist*dist) {
        mult <- sqrt(dd)/dist
        x <- seq(x[1], x[2], length=floor(mult + 1))
        y <- seq(y[1], y[2], length=floor(mult + 1))
    }
    cbind(x, y)[-length(x), ]
}
# Test
smoothStep(rbind(c(0, 0),
                 c(1, 0)),
           1, 2, .33)
smoothSteps <- function(xy, dist) {
    n <- nrow(xy)
    do.call(rbind,
            mapply(function(one, two, xy, dist) {
                       smoothStep(xy, one, two, dist)
                   },
                   1:(n-1), 2:n,
                   MoreArgs=list(xy, dist),
                   SIMPLIFY=FALSE))
}
# Test
smoothSteps(rbind(c(0, 0),
                  c(1, 0),
                  c(2, 0)),
            .33)
getBus <- function(route, lineSet=NULL) {
    bus_ids <- find(ua, relation(tags(k == "ref" & v == route)))
    bus_ids <- find_down(ua, relation(bus_ids))
    bus <- subset(ua, ids=bus_ids)
    bus_line <- as_sp(bus, "lines")
    if (is.null(lineSet)) {
        lineSet <- 1:length(bus_line@lines)
    }
    do.call(rbind, lapply(bus_line@lines[lineSet],
                          function(x) { coordinates(x)[[1]] }))
}
drawBus <- function(route, lineSet=NULL) {
    busCoords <- smoothSteps(getBus(route, lineSet), .0001)
    x <- busCoords[,1]
    y <- busCoords[,2]
    grid.lines(x, y, default="native",
               gp=gpar(col="green", lwd=3),
               name=paste("busRoute", route, sep="-"))
    grid.circle(x[1], y[1], default="native",
                r=unit(1, "mm"),
                gp=gpar(fill="green"),
                name=paste("bus", route, sep="-"))
}
animateBus <- function(route, col, lineSet=NULL, rev=FALSE) {
    busCoords <- smoothSteps(getBus(route, lineSet), .0001)
    x <- busCoords[,1]
    y <- busCoords[,2]
    if (rev) {
        x <- rev(x)
        y <- rev(y)
    }
    grid.lines(x, y, default="native",
               gp=gpar(col=adjustcolor(col, alpha=.5), lwd=5),
               name=paste("busRoute", route, sep="-"))
    grid.circle(x[1], y[1], default="native",
                r=unit(1, "mm"),
                gp=gpar(fill=col),
                name=paste("bus", route, sep="-"))
    n <- length(x)
    index <- unlist(lapply(1:n, seq))
    grid.animate(paste("busRoute", route, sep="-"),
                 x=animUnit(unit(x[index], "native"),
                     timeid=rep(1:n, 1:n)),
                 y=animUnit(unit(y[index], "native"),
                     timeid=rep(1:n, 1:n)),
                 duration=5)
    grid.animate(paste("bus", route, sep="-"),
                 x=x, y=y,
                 duration=5)
}

gridsvg("campus-animation.svg")
campusMap()
animateBus("500", "green", c(3:5, 2:1))
animateBus("Outer", "red", c(9, 5, 12, 6, 1, 3, 13, 7, 16))
animateBus("233", "blue", c(5, 9, 11, 4, 3, 6, 2), rev=TRUE)
dev.off()

# For screen cap
gridsvg("campus-animation-cap.svg")
campusMap()
animateBus("500", "green", c(3:5, 2))
animateBus("Outer", "red", c(9, 5, 12, 6, 1, 3, 13))
animateBus("233", "blue", c(6, 2), rev=TRUE)
dev.off()

##############################################################################
# Mask
campus_ids <- find(ua, way(tags(k == "campus")))
campus_ids <- find_down(ua, way(campus_ids))
campus <- subset(ua, ids=campus_ids)
campus_poly <- as_sp(campus, "polygons")

pdf("mask-%d.pdf", onefile=FALSE)
print(spplot(bg_poly, z=1, col.regions="lightblue", colorkey=FALSE),
      prefix="campus")
grid.edit("campus.background", gp=gpar(fill="grey30"))
grid.gremove("pathgrob")
grid.remove("border", grep=TRUE)
downViewport("campus.panel.1.1.vp")
sp.polygons(campus_poly, col=NA, fill="white")
mask <- mask(grid.grab())
dev.off()

campusMasked <- function() {
    grid.newpage()
    pushMask(mask)
    print(spplot(bg_poly, z=1, col.regions="lightblue", colorkey=FALSE),
          newpage=FALSE, prefix="campus")
    grid.edit("campus.background", gp=gpar(fill="grey"))
    grid.remove("border", grep=TRUE)
    downViewport("campus.panel.1.1.vp")
    sp.lines(street_line, lwd=1)
    sp.lines(path_line, lty="dotted")
}

pdf("campus-mask-%d.pdf", onefile=FALSE)
campusMasked()
dev.off()

gridsvg("campus-mask.svg")
campusMasked()
dev.off()


