A patch for extending pdf device to embed popup text and web links
Sample script & patch to R-2.6.2
pdf("sample.pdf")
par(oma=c(2,2,2,2))
plot(1:10)
pdf.link.on.box(1, 5, 3, 8, url="http://www.r-project.org")
for(i in 1:10)
pdf.text.on.box(i-0.1, i-0.1, i+0.1, i+0.1, LETTERS[i], border=c(0,0,0))
text(5, 9, "mouse over points!", col=2)
text(5, 2, "text test")
pdf.link.on.text("http://www.google.com")
mtext("mtext test 1", cex=2)
pdf.link.on.text("http://www.apple.com")
mtext("mtext test 2", side = 2, line=2)
pdf.link.on.text("http://www.vmware.com")
mtext("mtext test 3", outer=T, side = 1)
pdf.link.on.text("http://www.playstation.com")
mtext("mtext test 4", outer=T, side = 4, cex=3)
pdf.link.on.text("http://www.bioconductor.org")
dev.off()Patch
diff -r -c R.org/src/library/grDevices/NAMESPACE R/src/library/grDevices/NAMESPACE
*** R.org/src/library/grDevices/NAMESPACE 2007-09-05 07:13:01.000000000 +0900
--- R/src/library/grDevices/NAMESPACE 2008-03-30 17:09:02.000000000 +0900
***************
*** 7,13 ****
# below to add these and can use a different prefix.
useDynLib(grDevices, R_chull,
! PicTeX, PostScript, XFig, PDF,
Type1FontInUse, CIDFontInUse, R_GD_nullDevice)
export(Hershey, as.graphicsAnnot, boxplot.stats, check.options, chull,
--- 7,13 ----
# below to add these and can use a different prefix.
useDynLib(grDevices, R_chull,
! PicTeX, PostScript, XFig, PDF, PDFAnnotBox, PDFTextBoxInfo,
Type1FontInUse, CIDFontInUse, R_GD_nullDevice)
export(Hershey, as.graphicsAnnot, boxplot.stats, check.options, chull,
***************
*** 19,24 ****
--- 19,26 ----
extendrange, getGraphicsEvent, graphics.off, gray, grey,
gray.colors, grey.colors, heat.colors, hsv, hcl, make.rgb,
n2mfrow, nclass.Sturges, nclass.FD, nclass.scott, palette, pdf,
+ pdf.annot.box, pdf.text.box.info, pdf.link.on.box, pdf.text.on.box,
+ pdf.link.on.text, pdf.text.on.text,
pdfFonts, pictex, postscript, postscriptFont, postscriptFonts,
ps.options, rainbow, recordGraphics, recordPlot, replayPlot,
rgb, rgb2hsv, terrain.colors, topo.colors,
diff -r -c R.org/src/library/grDevices/R/postscript.R R/src/library/grDevices/R/postscript.R
*** R.org/src/library/grDevices/R/postscript.R 2007-11-23 12:05:05.000000000 +0900
--- R/src/library/grDevices/R/postscript.R 2008-03-30 17:08:30.000000000 +0900
***************
*** 299,304 ****
--- 299,375 ----
invisible()
}
+ pdf.annot.box <- function(x0, y0, x1, y1, annotation_text, coord="USER")
+ {
+ ## is the device pdf?
+ if (names(dev.cur())[1] == "pdf") {
+ .External("PDFAnnotBox", x0, y0, x1, y1,
+ as.character(annotation_text[1]), as.character(coord[1]))
+ }
+ }
+
+ pdf.text.box.info <- function()
+ {
+ ## is the device pdf?
+ if (names(dev.cur())[1] == "pdf") {
+ .External("PDFTextBoxInfo")
+ }
+ }
+
+ pdf.link.on.box <- function(x0, y0, x1, y1, url, col=c(0,1,1),
+ border=c(0,0,1), coord="USER")
+ {
+ col <- as.numeric(abs(col))[1:3]
+ if (max(col)>1) {
+ col <- col / max(col)
+ }
+ border <- as.integer(abs(border))[1:3]
+ annotation_text <-
+ paste(paste(c("/C [", col, "]"), collapse=" "),
+ paste(c("/Border [", border, "]"), collapse=" "),
+ paste("/Subtype /Link /A << /Type /Action /S /URI /URI(",
+ as.character(url[1]), ")>>", sep=""), sep="\n")
+ pdf.annot.box(x0, y0, x1, y1, annotation_text, coord)
+ }
+
+ pdf.text.on.box <- function(x0, y0, x1, y1, text, col=NULL,
+ border=c(0,0,0), coord="USER")
+ {
+ if (length(col)>=1 && max(col)>1) {
+ col <- col / max(col)
+ }
+ border <- as.integer(abs(border))[1:3]
+ annotation_text <-
+ paste(paste(c("/C [", col, "]"), collapse=" "),
+ paste(c("/Border [", border, "]"), collapse=" "),
+ "/Subtype /Square",
+ paste("/Contents (", paste(text, collapse="\r"), ")", sep=""),
+ "/BS << /Type /Border /W 0 >>", sep="\n")
+ pdf.annot.box(x0, y0, x1, y1, annotation_text, coord)
+ }
+
+ pdf.link.on.text <- function(url, col=c(0,1,1), border=c(0,0,1))
+ {
+ geo <- pdf.text.box.info()
+ m <- matrix(c(geo[2], geo[3], -geo[3], geo[2]), nrow=2)/geo[1]
+ x <- cbind(c(0, -geo[8]), c(0, geo[7]),
+ c(geo[6], -geo[8]), c(geo[6], geo[7]))
+ xx <- m %*% x + c(geo[4], geo[5])
+ pdf.link.on.box(min(xx[1,]), min(xx[2,]), max(xx[1,]), max(xx[2,]), url,
+ col, border, "DEVICE")
+ }
+
+ pdf.text.on.text <- function(text, col=c(0,1,1), border=c(0,0,1))
+ {
+ geo <- pdf.text.box.info()
+ m <- matrix(c(geo[2], geo[3], -geo[3], geo[2]), nrow=2)/geo[1]
+ x <- cbind(c(0, -geo[8]), c(0, geo[7]),
+ c(geo[6], -geo[8]), c(geo[6], geo[7]))
+ xx <- m %*% x + c(geo[4], geo[5])
+ pdf.text.on.box(min(xx[1,]), min(xx[2,]), max(xx[1,]), max(xx[2,]), text,
+ col, border, "DEVICE")
+ }
+
.ps.prolog <- c(
"/gs { gsave } def",
"/gr { grestore } def",
diff -r -c R.org/src/library/grDevices/src/devPS.c R/src/library/grDevices/src/devPS.c
*** R.org/src/library/grDevices/src/devPS.c 2007-10-12 18:21:29.000000000 +0900
--- R/src/library/grDevices/src/devPS.c 2008-03-30 17:07:23.000000000 +0900
***************
*** 5076,5081 ****
--- 5076,5085 ----
Rboolean inText;
char title[1024];
+ char **annots; /* annotations in a page */
+ int annotsmax; /* allocated size */
+ int annotspos; /* number of annotations */
+
/*
* Fonts and encodings used on the device
*/
***************
*** 5089,5094 ****
--- 5093,5105 ----
cidfontfamily defaultCIDFont;
/* Record if fonts are used */
Rboolean fontUsed[100];
+
+ /*
+ * Current text geometry information (stored in PDF_Text)
+ */
+ int text_size;
+ double text_a, text_b, text_x, text_y;
+ double text_ascent, text_descent, text_width;
}
PDFDesc;
***************
*** 5129,5138 ****
--- 5140,5157 ----
static double PDF_StrWidth(const char *str,
R_GE_gcontext *gc,
NewDevDesc *dd);
+ static void PDF_StrSize(const char *str,
+ R_GE_gcontext *gc,
+ NewDevDesc *dd,
+ double *ascent_max,
+ double *descent_max,
+ double *width_sum);
static void PDF_Text(double x, double y, const char *str,
double rot, double hadj,
R_GE_gcontext *gc,
NewDevDesc *dd);
+ static void PDF_free_annots(PDFDesc *pd);
+ static void PDF_add_annot(PDFDesc *pd, char *str);
/*
* Add a graphics engine font family to the list of fonts used on a
***************
*** 5247,5252 ****
--- 5266,5279 ----
}
pd->pagemax = 100;
+ pd->annots = (char **) calloc(1000, sizeof(char *));
+ if(!pd->annots) {
+ free(pd->pos); free(pd->pageobj); free(pd); free(dd);
+ error(_("cannot allocate pd->annots"));
+ }
+ pd->annotsmax = 1000;
+ pd->annotspos = 0;
+
/* initialize PDF device description */
strcpy(pd->filename, file);
***************
*** 5260,5266 ****
if(strlen(encoding) > PATH_MAX - 1) {
free(dd);
! free(pd->pos); free(pd->pageobj); free(pd);
error(_("encoding path is too long"));
}
/*
--- 5287,5293 ----
if(strlen(encoding) > PATH_MAX - 1) {
free(dd);
! free(pd->pos); free(pd->pageobj); PDF_free_annots(pd); free(pd);
error(_("encoding path is too long"));
}
/*
***************
*** 5502,5508 ****
pd->cidfonts = NULL;
pd->encodings = NULL;
free(dd);
! free(pd->pos); free(pd->pageobj); free(pd);
error(_("invalid foreground/background color (pdf)"));
}
--- 5529,5535 ----
pd->cidfonts = NULL;
pd->encodings = NULL;
free(dd);
! free(pd->pos); free(pd->pageobj); PDF_free_annots(pd); free(pd);
error(_("invalid foreground/background color (pdf)"));
}
***************
*** 5567,5573 ****
pd->cidfonts = NULL;
pd->encodings = NULL;
free(dd);
! free(pd->pos); free(pd->pageobj); free(pd);
return 0;
}
--- 5594,5600 ----
pd->cidfonts = NULL;
pd->encodings = NULL;
free(dd);
! free(pd->pos); free(pd->pageobj); PDF_free_annots(pd); free(pd);
return 0;
}
***************
*** 6268,6273 ****
--- 6295,6301 ----
static void PDF_endpage(PDFDesc *pd)
{
int here;
+ int i;
if(pd->inText) textoff(pd);
fprintf(pd->pdffp, "Q\n");
here = (int) ftell(pd->pdffp);
***************
*** 6275,6280 ****
--- 6303,6324 ----
pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
fprintf(pd->pdffp, "%d 0 obj\n%d\nendobj\n", pd->nobjs,
here - pd->startstream);
+ pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
+ fprintf(pd->pdffp, "%d 0 obj\n<<\n/Type /Page\n/Parent 3 0 R\n/Contents %d 0 R\n/Resources 4 0 R\n",
+ pd->nobjs, pd->nobjs-2);
+ if(pd->annotspos) {
+ fprintf(pd->pdffp, "/Annots [");
+ for(i = 0 ; i < pd->annotspos ; i++)
+ fprintf(pd->pdffp, " %d 0 R", pd->nobjs+1+i);
+ fprintf(pd->pdffp, " ]\n");
+ }
+ fprintf(pd->pdffp, ">>\nendobj\n");
+ for(i = 0 ; i < pd->annotspos ; i++) {
+ pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
+ fprintf(pd->pdffp, "%d %s", pd->nobjs, pd->annots[i]);
+ free(pd->annots[i]);
+ }
+ pd->annotspos = 0;
}
#define R_VIS(col) (R_ALPHA(col) > 0)
***************
*** 6284,6289 ****
--- 6328,6334 ----
{
PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
char buf[512];
+ int i;
if(pd->pageno >= pd->pagemax || pd->nobjs >= 3*pd->pagemax) {
pd->pageobj = (int *)
***************
*** 6309,6318 ****
}
}
! pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
! pd->pageobj[pd->pageno++] = pd->nobjs;
! fprintf(pd->pdffp, "%d 0 obj\n<<\n/Type /Page\n/Parent 3 0 R\n/Contents %d 0 R\n/Resources 4 0 R\n>>\nendobj\n",
! pd->nobjs, pd->nobjs+1);
pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
fprintf(pd->pdffp, "%d 0 obj\n<<\n/Length %d 0 R\n>>\nstream\r\n",
pd->nobjs, pd->nobjs + 1);
--- 6354,6360 ----
}
}
! pd->pageobj[pd->pageno++] = pd->nobjs+3;
pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
fprintf(pd->pdffp, "%d 0 obj\n<<\n/Length %d 0 R\n>>\nstream\r\n",
pd->nobjs, pd->nobjs + 1);
***************
*** 6343,6349 ****
freeDeviceEncList(pd->encodings);
pd->fonts = NULL;
pd->encodings = NULL;
! free(pd->pos); free(pd->pageobj); free(pd);
}
static void PDF_Activate(NewDevDesc *dd) {}
--- 6385,6391 ----
freeDeviceEncList(pd->encodings);
pd->fonts = NULL;
pd->encodings = NULL;
! free(pd->pos); free(pd->pageobj); PDF_free_annots(pd); free(pd);
}
static void PDF_Activate(NewDevDesc *dd) {}
***************
*** 6595,6600 ****
--- 6637,6643 ----
int face = gc->fontface;
double a, b, rot1;
const char *str1 = str;
+ double ascent, descent, width;
if(!R_VIS(gc->col)) return;
***************
*** 6615,6620 ****
--- 6658,6672 ----
a, b, -b, a, x, y);
PostScriptWriteString(pd->pdffp, str1);
fprintf(pd->pdffp, " Tj\n");
+ pd->text_size = size;
+ pd->text_a = a;
+ pd->text_b = b;
+ pd->text_x = x;
+ pd->text_y = y;
+ PDF_StrSize(str1, gc, dd, &ascent, &descent, &width);
+ pd->text_ascent = ascent;
+ pd->text_descent = descent;
+ pd->text_width = width;
}
#ifndef SUPPORT_MBCS
***************
*** 6643,6648 ****
--- 6695,6701 ----
double a, b, rot1;
const char *str1 = str;
char *buff;
+ double ascent, descent, width;
if(!R_VIS(gc->col)) return;
***************
*** 6664,6669 ****
--- 6717,6732 ----
if(fabs(b) < 0.01) b = 0.0;
if(!pd->inText) texton(pd);
+ pd->text_size = size;
+ pd->text_a = a;
+ pd->text_b = b;
+ pd->text_x = x;
+ pd->text_y = y;
+ PDF_StrSize(str1, gc, dd, &ascent, &descent, &width);
+ pd->text_ascent = ascent;
+ pd->text_descent = descent;
+ pd->text_width = width;
+
if(isCIDFont(gc->fontfamily, PDFFonts, pd->defaultCIDFont) && face != 5) {
/* NB we could be in a SBCS here */
unsigned char *buf = NULL /* -Wall */;
***************
*** 6932,6937 ****
--- 6995,7025 ----
}
}
+ static void PDF_StrSize(const char *str,
+ R_GE_gcontext *gc,
+ NewDevDesc *dd,
+ double* ascent_max,
+ double* descent_max,
+ double* width_sum)
+ {
+ PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
+ int face = gc->fontface;
+ double ascent, descent, width;
+ int i, n;
+
+ *ascent_max = 0.0;
+ *descent_max = 0.0;
+ *width_sum = 0.0;
+
+ n = (int) strlen(str);
+ for(i=0; i<n; i++) {
+ PDF_MetricInfo((int) str[i], gc, &ascent, &descent, &width, dd);
+ if (*ascent_max < ascent) *ascent_max = ascent;
+ if (*descent_max < descent) *descent_max = descent;
+ *width_sum += width;
+ }
+ }
+
static void PDF_MetricInfo(int c,
R_GE_gcontext *gc,
double* ascent, double* descent,
***************
*** 6960,6965 ****
--- 7048,7084 ----
*width = floor(gc->cex * gc->ps + 0.5) * *width;
}
+ static void PDF_free_annots(PDFDesc *pd)
+ {
+ int i;
+ for (i = 0; i < pd->annotspos; i++) free(pd->annots[i]);
+ free(pd->annots);
+ }
+
+ static void PDF_add_annot(PDFDesc *pd, char *str)
+ {
+ char **annots;
+ char *annot_str;
+ int nchar;
+
+ if (pd->annotspos >= pd->annotsmax) {
+ annots = realloc(pd->annots, pd->annotsmax + 1000);
+ if (annots) {
+ pd->annots = annots;
+ pd->annotsmax += 1000;
+ } else {
+ error(_("unable to increase annotation limit"));
+ }
+ }
+ nchar = strlen(str);
+ annot_str = (char *) calloc(nchar+1, sizeof(char));
+ if(!annot_str) {
+ error(_("cannot allocate pd->annots[i]"));
+ }
+ strncpy(annot_str, str, nchar+1);
+ pd->annots[pd->annotspos++] = annot_str;
+ }
+
/* PostScript Device Driver Parameters:
* ------------------------
***************
*** 7207,7209 ****
--- 7326,7452 ----
vmaxset(vmax);
return R_NilValue;
}
+
+
+ /* PDFAnnotBox(x0, y0, x1, y1, text, coord) */
+ SEXP PDFAnnotBox(SEXP args)
+ {
+ GEDevDesc *gedd = GEcurrentDevice();
+ PDFDesc *pd = (PDFDesc *) gedd->dev->deviceSpecific;
+ DevDesc *dd = CurrentDevice();
+ double x0, y0, x1, y1;
+ char *text, *coord;
+ GUnit from, to;
+ char annot_text[1024] = "";
+
+ args = CDR(args);
+ x0 = asReal(CAR(args)); args = CDR(args);
+ y0 = asReal(CAR(args)); args = CDR(args);
+ x1 = asReal(CAR(args)); args = CDR(args);
+ y1 = asReal(CAR(args)); args = CDR(args);
+ text = (char *)CHAR(asChar(CAR(args))); args = CDR(args);
+ coord = (char *)CHAR(asChar(CAR(args)));
+
+ if (strcmp("DEVICE", coord) == 0) { from = DEVICE; }
+ if (strcmp("NDC", coord) == 0) { from = NDC; }
+ if (strcmp("INCHES", coord) == 0) { from = INCHES; }
+ if (strcmp("OMA1", coord) == 0) { from = OMA1; }
+ if (strcmp("OMA2", coord) == 0) { from = OMA2; }
+ if (strcmp("OMA3", coord) == 0) { from = OMA3; }
+ if (strcmp("OMA4", coord) == 0) { from = OMA4; }
+ if (strcmp("NIC", coord) == 0) { from = NIC; }
+ if (strcmp("NFC", coord) == 0) { from = NFC; }
+ if (strcmp("MAR1", coord) == 0) { from = MAR1; }
+ if (strcmp("MAR2", coord) == 0) { from = MAR2; }
+ if (strcmp("MAR3", coord) == 0) { from = MAR3; }
+ if (strcmp("MAR4", coord) == 0) { from = MAR4; }
+ if (strcmp("NPC", coord) == 0) { from = NPC; }
+ if (strcmp("USER", coord) == 0) { from = USER; }
+ to = DEVICE;
+
+ GConvert(&x0, &y0, from, to, dd);
+ GConvert(&x1, &y1, from, to, dd);
+
+ snprintf(annot_text, 1024,
+ "0 obj <<\n/Type /Annot\n/Rect [ %.2f %.2f %.2f %.2f ]\n%s\n>> endobj\n",
+ x0, y0, x1, y1, text);
+ PDF_add_annot(pd, annot_text);
+ return R_NilValue;
+ }
+
+ /* PDFTextBoxInfo() */
+ SEXP PDFTextBoxInfo(SEXP args)
+ {
+ GEDevDesc *gedd = GEcurrentDevice();
+ PDFDesc *pd = (PDFDesc *) gedd->dev->deviceSpecific;
+ SEXP out;
+ out = allocVector(REALSXP, 8);
+ REAL(out)[0] = pd->text_size;
+ REAL(out)[1] = pd->text_a;
+ REAL(out)[2] = pd->text_b;
+ REAL(out)[3] = pd->text_x;
+ REAL(out)[4] = pd->text_y;
+ REAL(out)[5] = pd->text_width;
+ REAL(out)[6] = pd->text_ascent;
+ REAL(out)[7] = pd->text_descent;
+
+ return out;
+ /*
+ SEXP sx, sy, stext, scoord;
+ GEDevDesc *gedd = GEcurrentDevice();
+ PDFDesc *pd = (PDFDesc *) gedd->dev->deviceSpecific;
+ DevDesc *dd = CurrentDevice();
+ R_GE_gcontext gc; gcontextFromGP(&gc, dd);
+
+ args = CDR(args);
+ sx = CAR(args); args = CDR(args);
+ sy = CAR(args); args = CDR(args);
+ stext = CAR(args); args = CDR(args);
+ scoord = CAR(args);
+
+ double x = REAL(sx)[0];
+ double y = REAL(sy)[0];
+ const char *text = CHAR(STRING_ELT(stext, 0));
+ const char *coord = CHAR(STRING_ELT(scoord, 0));
+
+ GUnit from, to;
+
+ if (strcmp("DEVICE", coord) == 0) { from = DEVICE; }
+ if (strcmp("NDC", coord) == 0) { from = NDC; }
+ if (strcmp("INCHES", coord) == 0) { from = INCHES; }
+ if (strcmp("OMA1", coord) == 0) { from = OMA1; }
+ if (strcmp("OMA2", coord) == 0) { from = OMA2; }
+ if (strcmp("OMA3", coord) == 0) { from = OMA3; }
+ if (strcmp("OMA4", coord) == 0) { from = OMA4; }
+ if (strcmp("NIC", coord) == 0) { from = NIC; }
+ if (strcmp("NFC", coord) == 0) { from = NFC; }
+ if (strcmp("MAR1", coord) == 0) { from = MAR1; }
+ if (strcmp("MAR2", coord) == 0) { from = MAR2; }
+ if (strcmp("MAR3", coord) == 0) { from = MAR3; }
+ if (strcmp("MAR4", coord) == 0) { from = MAR4; }
+ if (strcmp("NPC", coord) == 0) { from = NPC; }
+ if (strcmp("USER", coord) == 0) { from = USER; }
+ to = DEVICE;
+
+ GConvert(&x, &y, from, to, dd);
+ double ascent, descent, width, ascent_max = 0, descent_max = 0, width_sum = 0;
+ int i, n;
+ n = (int) strlen(text);
+ for(i=0; i<n; i++) {
+ PDF_MetricInfo((int) text[i], &gc, &ascent, &descent, &width, gedd->dev);
+ if (ascent_max < ascent) ascent_max = ascent;
+ if (descent_max < descent) descent_max = descent;
+ width_sum += width;
+ }
+
+ SEXP out;
+ out = allocVector(REALSXP, 5);
+ REAL(out)[0] = x;
+ REAL(out)[1] = y;
+ REAL(out)[2] = width_sum;
+ REAL(out)[3] = ascent_max;
+ REAL(out)[4] = descent_max;
+
+ return out;
+ */
+ }
diff -r -c R.org/src/library/grDevices/src/grDevices.h R/src/library/grDevices/src/grDevices.h
*** R.org/src/library/grDevices/src/grDevices.h 2007-09-05 07:12:57.000000000 +0900
--- R/src/library/grDevices/src/grDevices.h 2008-03-23 00:27:31.000000000 +0900
***************
*** 42,47 ****
--- 42,50 ----
SEXP Quartz(SEXP);
+ SEXP PDFAnnotBox(SEXP);
+ SEXP PDFTextBoxInfo(SEXP);
+
SEXP R_GD_nullDevice();
Rboolean
diff -r -c R.org/src/library/grDevices/src/init.c R/src/library/grDevices/src/init.c
*** R.org/src/library/grDevices/src/init.c 2007-09-05 07:12:57.000000000 +0900
--- R/src/library/grDevices/src/init.c 2008-03-26 00:55:51.000000000 +0900
***************
*** 56,61 ****
--- 56,63 ----
#else
EXTDEF(Quartz, -1),
#endif
+ EXTDEF(PDFAnnotBox, 6),
+ EXTDEF(PDFTextBoxInfo, 0),
{NULL, NULL, 0}
};
