From fe90140ec35910af935ebcff745b0c831c381c54 Mon Sep 17 00:00:00 2001
From: "Antonio, Fabio Di Narzo" <antonio.fabio@gmail.com>
Date: Tue, 27 Nov 2007 01:03:32 +0100
Subject: [PATCH] added image map grob

---
 RiDMC/R/grobs.R      |  3 ++-
 RiDMC/R/imageGrobs.R | 13 +++++++++++--
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/RiDMC/R/grobs.R b/RiDMC/R/grobs.R
index 87e08ab..37abc24 100644
--- a/RiDMC/R/grobs.R
+++ b/RiDMC/R/grobs.R
@@ -76,7 +76,8 @@ makePlotGrobViewports <- function(xlim, ylim, respect, mar) {
         viewport(layout.pos.col=2, layout.pos.row=2, name='plotArea', xscale=xlim, yscale=ylim, clip=TRUE),
         viewport(layout.pos.row=1, name='titleArea', gp=gpar(cex=par('cex.main'))),
         viewport(layout.pos.col=2, layout.pos.row=3, name='xlabArea'),
-        viewport(layout.pos.col=1, layout.pos.row=2, name='ylabArea')))
+        viewport(layout.pos.col=1, layout.pos.row=2, name='ylabArea'),
+        viewport(layout.pos.col=3, layout.pos.row=2, name='rightMarginArea')))
 }
 
 mkPlotChildsAndViewports <- function(contents=NULL, main=NULL, xlab=NULL, ylab=NULL, 
diff --git a/RiDMC/R/imageGrobs.R b/RiDMC/R/imageGrobs.R
index a5a8f1e..cc1790c 100644
--- a/RiDMC/R/imageGrobs.R
+++ b/RiDMC/R/imageGrobs.R
@@ -44,8 +44,17 @@ editDetails.imageScale <- function(x, specs){
 ##Complete image map grob##
 ###########################
 ##Has optional axes and legend. Space is accomodated accordingly
-imageMapGrob <- function(values, breaks, colors, xlim=0:1, ylim=0:1, axes=TRUE, legend=TRUE, name=NULL, gp=NULL, vp=NULL) {
-  stop('TODO')
+imageMapGrob <- function(values, breaks, palette, xlim=0:1, ylim=0:1, axes=TRUE, legend=TRUE, name=NULL, gp=NULL, vp=NULL) {
+  cg <- imageScaleGrob(values, breaks, palette)
+  pg <- plotGrob(cg, axes=axes, mar=c(2,2,2,6), xlim=xlim, ylim=ylim, respect=TRUE)
+  lg <- ribbonLegend(breaks, palette, n=10)
+  extend(pg, 'imageMap', legend=lg)
+}
+drawDetails.imageMap <- function(x, recording) {
+  NextMethod()
+  downViewport(vpPath('plotLayout','rootArea','rightMarginArea'))
+  grid.draw(getField(x, 'legend'))
+  upViewport(3)
 }
 grid.imageMap <- function(...)
   grid.draw(imageMapGrob(...))
-- 
2.11.4.GIT