PDF link patch
R-2.6.2で、PDFにアノテーションとして、メモやURLのリンクを埋め込むことができるパッチです。
今のところマニュアルはありません、パッチを適用してコンパイル後、下記のスクリプトを走らせてみて、
作成されたPDFから、どんなことが出来るか確認して下さい。
パッチは cd R-2.6.2 ; patch -p1 < R_PDF_patch_file で当てて下さい。
動作確認環境は、Mac OS X 10.5.2です。
注: こちらに、pdfのサンプルを置きました
pdf("sample.pdf") par(oma=c(2,2,2,2)) plot(1:10) pdf.link.box(1, 5, 3, 8, url="http://www.r-project.org") for(i in 1:10) pdf.text.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.text("http://www.google.com") mtext("mtext test 1", cex=2) pdf.link.text("http://www.apple.com") mtext("mtext test 2", side = 2, line=2) pdf.link.text("http://www.vmware.com") mtext("mtext test 3", outer=T, side = 1) pdf.link.text("http://www.playstation.com") mtext("mtext test 4", outer=T, side = 4, cex=3) pdf.link.text("http://www.bioconductor.org") dev.off()
ここからパッチ
diff -r -c R-2.6.2.org/src/library/grDevices/NAMESPACE R-2.6.2/src/library/grDevices/NAMESPACE *** R-2.6.2.org/src/library/grDevices/NAMESPACE 2007-09-05 07:13:01.000000000 +0900 --- R-2.6.2/src/library/grDevices/NAMESPACE 2008-03-26 02:44:34.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,25 ---- 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.box, pdf.text.box, pdf.link.text, pdfFonts, pictex, postscript, postscriptFont, postscriptFonts, ps.options, rainbow, recordGraphics, recordPlot, replayPlot, rgb, rgb2hsv, terrain.colors, topo.colors, diff -r -c R-2.6.2.org/src/library/grDevices/R/postscript.R R-2.6.2/src/library/grDevices/R/postscript.R *** R-2.6.2.org/src/library/grDevices/R/postscript.R 2007-11-23 12:05:05.000000000 +0900 --- R-2.6.2/src/library/grDevices/R/postscript.R 2008-03-26 03:00:49.000000000 +0900 *************** *** 299,304 **** --- 299,361 ---- 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.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.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.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.box(min(xx[1,]), min(xx[2,]), max(xx[1,]), max(xx[2,]), url, + col, border, "DEVICE") + } + .ps.prolog <- c( "/gs { gsave } def", "/gr { grestore } def", diff -r -c R-2.6.2.org/src/library/grDevices/src/devPS.c R-2.6.2/src/library/grDevices/src/devPS.c *** R-2.6.2.org/src/library/grDevices/src/devPS.c 2007-10-12 18:21:29.000000000 +0900 --- R-2.6.2/src/library/grDevices/src/devPS.c 2008-03-26 02:43:17.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,5158 ---- 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 int PDF_sprintf(PDFDesc *pd, const char * restrict format, ...); + 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 **** --- 5267,5280 ---- } 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")); } /* --- 5288,5294 ---- 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)")); } --- 5530,5536 ---- 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; } --- 5595,5601 ---- pd->cidfonts = NULL; pd->encodings = NULL; free(dd); ! free(pd->pos); free(pd->pageobj); PDF_free_annots(pd); free(pd); return 0; } *************** *** 6268,6273 **** --- 6296,6302 ---- 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 **** --- 6304,6325 ---- 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 **** --- 6329,6335 ---- { 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); --- 6355,6361 ---- } } ! 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) {} --- 6386,6392 ---- 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 **** --- 6638,6644 ---- int face = gc->fontface; double a, b, rot1; const char *str1 = str; + double ascent, descent, width; if(!R_VIS(gc->col)) return; *************** *** 6615,6620 **** --- 6659,6673 ---- 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 **** --- 6696,6702 ---- double a, b, rot1; const char *str1 = str; char *buff; + double ascent, descent, width; if(!R_VIS(gc->col)) return; *************** *** 6664,6669 **** --- 6718,6733 ---- 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 **** --- 6996,7026 ---- } } + 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 **** --- 7049,7085 ---- *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 **** --- 7327,7453 ---- 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-2.6.2.org/src/library/grDevices/src/grDevices.h R-2.6.2/src/library/grDevices/src/grDevices.h *** R-2.6.2.org/src/library/grDevices/src/grDevices.h 2007-09-05 07:12:57.000000000 +0900 --- R-2.6.2/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-2.6.2.org/src/library/grDevices/src/init.c R-2.6.2/src/library/grDevices/src/init.c *** R-2.6.2.org/src/library/grDevices/src/init.c 2007-09-05 07:12:57.000000000 +0900 --- R-2.6.2/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} };