#  Copyright (C) 2012 Paul Murrell
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  http://www.gnu.org/licenses/gpl.txt

drawPoly <- function(p, name, col="black", lwd=1, fill=NA) {
    if (length(p@pts)) {
        pts <- getpts(p)
        grid.polygon(pts$x, pts$y, default="native",
                     gp=gpar(col=col, lwd=lwd, fill=fill),
                     name=name)
    }
}

library(grid)

polyRangeX <- function(p) {
    if (length(p@pts)) {
        pts <- getpts(p)
        range(pts$x)
    } else {
        NA
    }
}

polyRangeY <- function(p) {
    if (length(p@pts)) {
        pts <- getpts(p)
        range(pts$y)
    } else {
        NA
    }
}

drawRegions <- function(result, label=FALSE, top=TRUE,
                        col="black", lwd=1, fill=NA,
                        newpage=TRUE, debug=FALSE) {
    names <- result$names
    k <- result$k
    sites <- result$s
    weights <- result$w
    if (newpage) {
        grid.newpage()
        xrange <- range(unlist(lapply(k, polyRangeX)), na.rm=TRUE)
        yrange <- range(unlist(lapply(k, polyRangeY)), na.rm=TRUE)
        pushViewport(viewport(width=.8, height=.8,
                              xscale=xrange, yscale=yrange))
    }
    if (top) {
        if (missing(lwd)) { lwd <- 4 }
        invisible(mapply(drawPoly, k, names, MoreArgs=list(lwd=lwd)))
        invisible(mapply(drawPoly, k, names,
                         MoreArgs=list(lwd=lwd/2, col=col)))
    } else {
        invisible(mapply(drawPoly, k, names, col=col, lwd=lwd, fill=fill))
    }
    if (label) {
        if (top) {
            cex=1
        } else {
            cex=.5
        }
        grid.text(result$names, sites$x, sites$y, default="native",
                  gp=gpar(cex=cex))
        if (debug) {
            col <- ifelse(weights < 0, "red", "black")
            grid.circle(sites$x, sites$y, default="native",
                        r=unit(weights, "native"),
                        gp=gpar(col=col, fill=NA))
        }
    }
}