.packageName <- "DescribeDisplay"
# Load describe display
# Retrieve output of from describe display plugin
# 
# Also performs some conversion of data structures to more 
# conveient form so that other functions do not have to repeatedly
# recompute.  Some of these conversions could probably be moved into 
# the Describe Display plugin, but it may be easier to just do them
# on the R side..
# 
# @arguments file path
# @value object of class dd
# @keyword  manip
# a <- dd_load(system.file("examples", "test-edges.r"))
# b <- dd_load(system.file("examples", "test-dot.r"))
dd_load <- function(path) {
  dd <- source(path)$value
  class(dd) <- c("dd", dd_plot_class(dd$type))
  dd$colormap$foreground <- sapply(dd$colormap$foregroundColors, 
    function(x) do.call(rgb, as.list(x))
  )
  dd$colormap$foregroundColors <- NULL
  cols <- nulldefault(dd$ncols, 1)
  dd$dim <- c(dd$nplots / cols, cols)
  dd$plots <- lapply(1:dd$nplots, function(n) dd_clean_plot(dd, n))  
  
  dd
}

# Clean plot data structure
# Cleans up plot data structure into consistent, easy to use data structure
# 
# @arguments dd object
# @arguments plot number
# @keyword internal 
dd_clean_plot <- function(dd, n=1) {
  names(dd$plots[[n]]) <- gsub("plot", "", names(dd$plots[[n]]))
  plot <- c(
    list(
      points = dd_points(dd, n),
      edges = dd_edges(dd, n),
    ), 
    dd$plots[[n]][c("type","projection", "params")]
  )
  plot$xscale <- expand_range(range(plot$points$x), 0.1)
  plot$yscale <- expand_range(range(plot$points$y), 0.1)
  class(plot) <- c(plot$type, dd_plot_class(plot$projection), "ddplot")
  plot
}



# Describe display points data
# Retrieves the describe display points data for the given plot number.
# 
# @arguments list of values from describe display 
# @arguments plot number, defaults to first plot
# @value data frame suitable for plotting
# @keyword internal 
dd_points <- function(dd, n=1) {
  df <- as.data.frame(dd$plots[[n]]$points)
  
  # Remap point aesthetics to R appropriate values
  df$col <- dd$colormap$foreground[df$color + 1]
  df$pch <- c(18, 3, 4, 1, 0, 16, 15)[df$glyphtype + 1]
  df$cex <- (df$glyphsize + 1)/2
  rownames(df) <- df$index
  df[!df$hidden, c("x","y", "col","pch", "cex")] # Return only visible points
}

# Describe display edge data
# Retrieves the describe display edge data for the given plot number.
# 
# @arguments list of values from describe display 
# @arguments plot number, defaults to first plot
# @value data frame suitable for plotting
# @keyword internal 
dd_edges <- function(dd, n=1) {
  if (is.null(dd$plots[[n]]$edges)) return()
  df <- do.call(rbind, lapply(dd$plots[[n]]$edges, as.data.frame))
  
  # Remap edge aesthetics to appropriate values
  df$col <- dd$colormap$foreground[df$color + 1]
  df$lwd <- (df$lwd + 1)/2
  df$lty <- rep(1,6)[df$ltype + 1]
  
  df <- df[!df$hidden, c("src","dest", "col","lwd", "lty")] # Return only visible edges
  points <- dd_points(dd, n)
  src <- points[as.character(df$src), c("x","y")]
  names(src) <- c("src.x", "src.y")
  dest <- points[as.character(df$dest), c("x","y")]
  names(dest) <- c("dest.x", "dest.y")
  
  cbind(src, dest, df)
}

# Describe display plot class
# Compute valid R class name for given plot type
# 
# @arguments list of values from describe display 
# @arguments plot number, defaults to first plot
# @keyword internal 
dd_plot_class <- function(projection) {
  gsub("\\s+", "", tolower(projection))
}

# Describe display plot defaults
# Gather overall plot defaults for specified plot
# 
# @arguments list of values from describe display 
# @arguments plot number, defaults to first plot
# @keyword internal 
dd_defaults <- function(dd, n=1) {
  list(
    main = dd$title,
    xlab = nulldefault(dd$plots[[n]]$plotparams$xlab, ""),
    ylab = nulldefault(dd$plots[[n]]$plotparams$ylab, ""),
    axes = FALSE
  )  
}

# Describe display tour axis
# Return representation of axes for specified plot
# 
# @arguments list of values from describe display 
# @arguments plot number, defaults to first plot
# @keyword internal 
dd_tour_axes <- function(plot) {
  if (is.null(plot$params$F)) return()
  if (plot$projection == "1D Tour") return()
  
  proj <- matrix(plot$params$F, ncol=2, byrow=F)
  colnames(proj) <- c("x","y")
  lbls <- plot$params$labels
  
  ranges <- do.call(rbind,  plot$params$ranges)
  df <- data.frame(proj, label=lbls, range=ranges)
  
  df$r <- with(df, sqrt(x^2 + y^2))
  df$theta <- atan2(df$y, df$x)
  
  df
}

# Print dd object
# 
# @keyword internal 
print.dd <- function(x, ...) str(x)
# Create a nice plot
# Create a nice looking plot complete with axes using ggplot.
# 
# @arguments plot to display
# @arguments other (currently) unused arguments
# @keyword hplot
#X xy <- dd_load(system.file("examples", "test-xyplot.r", package="DescribeDisplay"))
#X ggplot(xy$plots[[1]])
ggplot.ddplot <- function(data, ...) {
  p <- ggplot(data$points, aesthetics=list(x=x, y=y, colour=col, shape=pch, size=cex*1.5))
  p <- scmanual(p, "colour")
  p <- scmanual(p, "size")
  p <- scmanual(p, "shape")
  p <- pscontinuous(p, "x", range=data$xscale)
  p <- pscontinuous(p, "y", range=data$yscale)

  ggpoint(p)
}
# Plot describe display output.
# This uses base graphics and is rather limited in terms of layout.
# 
# You probably shouldn't need to ever use this, but it is convenient 
# for quickly checking that the datastructures are correct.
# 
# @arguments describe display object
# @arguments plot 
# @keyword hplot 
plot.dd <- function(x, y=1, ...) {
  dd <- x; n <- 1
  arguments <- defaults(list(...), c(dd_points(dd, n), dd_defaults(dd, n)))
  
  do.call(plot, arguments)
  edges <- dd_edges(dd,n)
  if (!is.null(edges)) {
    segments(edges$src.x, edges$src.y, edges$dest.x, edges$dest.y, lwd=edges$lwd, col=edges$col)
    
  }
  
  box(col="grey")
}

# Panel grob
# Construct grob for single panel.
# 
# @arguments describe display object
# @arguments plot 
# @arguments axis location, x and y position
# @keyword internal 
panelGrob <- function(panel,axislocation = c(0.1, 0.1)) {
  points <- panel$points
  edges <- panel$edges
  
  axesVp <- viewport(xscale=c(-1,1), yscale=c(-1,1), name="axes", width=0.2, height=0.2, x=axislocation[1], y=axislocation[2])
  grobs <- list(
    rectGrob(gp=gpar(col="grey")),
    pointsGrob(points$x, points$y, pch=points$pch, gp=gpar(col=points$col), size=unit(points$cex, "char")),
    textGrob(nulldefault(panel$params$xlab, ""), 0.99, 0.01, just = c("right","bottom")),
    textGrob(nulldefault(panel$params$ylab, ""), 0.01, 0.99, just = c("left", "top")),
    axesGrob(panel)
  )

  if (length(panel$params$label) == 1)
    grobs <- append(grobs, list(textGrob(nulldefault(panel$params$label, ""), 0.5, 0.01, just = c("centre", "bottom"))))

  if (!is.null(panel$drawlines) && panel$drawlines) {
    grobs <- append(grobs, list(segmentsGrob(points$x, 0, points$x, points$y, default.units="native",  gp=gpar(col=points$col))))
  }

  if (!is.null(edges))  
    grobs <- append(grobs, list(segmentsGrob(edges$src.x, edges$src.y, edges$dest.x, edges$dest.y, default.units="native", gp=gpar(lwd=edges$lwd, col=edges$col))))
  
  gTree(
    children = do.call(gList, grobs), 
    vp = dataViewport(
      xscale = panel$xscale,
      yscale = panel$yscale
    ),
    childrenvp = axesVp
  )
}

# Plot a dd plot
# Convenient method to draw a single panel.
# 
# This is mainly used for bug testing so that you can pull out a single 
# panel quickly and easily.
# 
# @arguments object to plot
# @arguments axis location, x and y position
# @keyword hplot
plot.dd_plot <- function(x, ..., axislocation = c(0.1, 0.1)) {
  grid.newpage()
  grid.draw(panelGrob(x, axislocation=axislocation))  
}

# Draw dd plot
# Draw a complete describe display.
# 
# If you want to layout multiple dd plots on the same page, you can
# use \code{\link[grid]{grid.layout}}.  If you need even more control,
# set \code{draw = FALSE} and then \code{\link[grid]{grid.draw}} the 
# resulting grob yourself.
# 
# This function reads a number of options directly out of the 
# descripedisplay datastructure.  See the examples for ways to use
# these.
# 
# @arguments dd object to plot
# @arguments (unused)
# @arguments draw plot, or just return grob
# @value frame grob containing all panels, note that this does not contain the title or border
#X ash <- dd_load(system.file("examples", "test-ash.r", package="DescribeDisplay"))
#X plot(ash)
#X ash$plots[[1]]$drawlines <- TRUE
#X
#X texture <- dd_load(system.file("examples", "1d-texture.r", package="DescribeDisplay"))
#X plot(texture)
#X texture$plots[[1]]$yscale <- expand_range(texture$plots[[1]]$yscale, 0.5)
#X plot(texture)
# @keyword internal 
plot.dd <- function(x, ..., draw = TRUE, axislocation = c(0.1, 0.1)) {
  d <- x$dim
  layout <- grid.layout(nrow=d[1], ncol=d[2])
  panels <- frameGrob(layout = layout)
  
  for(i in 1:x$nplot) {
    panels <- placeGrob(panels, panelGrob(x$plots[[i]], axislocation=axislocation), col = (i - 1) %/% d[1] + 1
    , row = (i - 1) %% d[1] + 1)
  }

  pg <- frameGrob(grid.layout(nrow=2, ncol=1))
  pg <- packGrob(pg, textGrob(x$title, gp=gpar(cex=1.5)), row=1, height=unit(2,"lines"))
  pg <- packGrob(pg, panels, row=2)

  if (draw) {
    grid.newpage()
    pushViewport(viewport(w = 0.9, h = 0.9))
    grid.draw(pg)
  }
  
  invisible(panels)
  
}

# Axes grob
# Construct grob for axes.
# 
# @arguments describe display object
# @arguments plot 
# @keyword internal 
axesGrob <- function(panel) {
  axes <- dd_tour_axes(panel)
  if (is.null(axes)) return()

  gTree(children=gList(
    circleGrob(0, 0, 1, default.units="native", gp=gpar(fill="transparent", col="black")),
    segmentsGrob(0,0, axes$x, axes$y, default.units="native"),
    textGrob(axes$label, 1.1 * cos(axes$theta), 1.1 * sin(axes$theta), default.units="native", gp=gpar(fontsize=10))
  ), vp=vpPath("axes"))  
}
# Null default
# Convienece function for setting defaults for null values
# 
# @arguments value  
# @arguments default to use if value is null
# @keyword internal 
nulldefault <- function(x, default) {
  if (is.null(x)) return(default)
  x
}
