library(xdvir) ## Make debugging information available options(tinytex.verbose=TRUE, xdvir.quiet=FALSE) ## Model answer is dvitype output from a specific .dvi generated by pdflatex type96glyphs <- read.csv(textConnection(" char,h,x,v,y 116,-4736287,-96,-4159936,-84 101,-4481424,-91,-4159936,-84 115,-4190153,-85,-4159936,-84 116,-3931650,-80,-4159936,-84 120,-3379691,-69,-4452297,-90 0,-3082503,-63,-4452297,-90 22,-2672902,-55,-4452297,-90 50,-2997585,-61,-3933942,-79")) type10glyphs <- read.csv(textConnection(" char,h,x,v,y 116,-4736287,-10,-4159936,-9 101,-4481424,-9,-4159936,-9 115,-4190153,-8,-4159936,-9 116,-3931650,-7,-4159936,-9 120,-3379691,-7,-4452297,-10 0,-3082503,-6,-4452297,-10 22,-2672902,-5,-4452297,-10 50,-2997585,-6,-3933942,-9")) type100glyphs <- read.csv(textConnection(" char,h,x,v,y 116,-4736287,-100,-4159936,-88 101,-4481424,-95,-4159936,-88 115,-4190153,-89,-4159936,-88 116,-3931650,-84,-4159936,-88 120,-3379691,-71,-4452297,-94 0,-3082503,-65,-4452297,-94 22,-2672902,-56,-4452297,-94 50,-2997585,-63,-3933942,-83")) type1000glyphs <- read.csv(textConnection(" char,h,x,v,y 116,-4736287,-1000,-4159936,-878 101,-4481424,-946,-4159936,-878 115,-4190153,-885,-4159936,-878 116,-3931650,-830,-4159936,-878 120,-3379691,-714,-4452297,-940 0,-3082503,-651,-4452297,-940 22,-2672902,-565,-4452297,-940 50,-2997585,-633,-3933942,-830")) type4736287glyphs <- read.csv(textConnection(" char,h,x,v,y 116,-4736287,-4736287,-4159936,-4159936 101,-4481424,-4481424,-4159936,-4159936 115,-4190153,-4190153,-4159936,-4159936 116,-3931650,-3931650,-4159936,-4159936 120,-3379691,-3379691,-4452297,-4452297 0,-3082503,-3082503,-4452297,-4452297 22,-2672902,-2672902,-4452297,-4452297 50,-2997585,-2997585,-3933942,-3933942")) type96rules <- read.csv(textConnection(" x,y,w,h -69,-87,21,1")) type10rules <- read.csv(textConnection(" x,y,w,h -7,-10,3,1")) type100rules <- read.csv(textConnection(" x,y,w,h -71,-91,22,1")) type1000rules <- read.csv(textConnection(" x,y,w,h -714,-910,217,6")) type4736287rules <- read.csv(textConnection(" x,y,w,h -3379691,-4310670,1025447,26214")) ## The TFM metrics for the specific fonts and glyphs in the .dvi rebuildFraction <- function(digits) { n <- length(digits) acc <- 0 for (j in n:1) { acc <- digits[j] + (acc %/% 10) } acc <- (acc + 10) %/% 20 acc / 2^20 } retrieveFraction <- function(f) { digits <- strsplit(f, "") frac <- lapply(digits, function(x) as.numeric(x)*2^21) sapply(frac, rebuildFraction) } retrieveFixNum <- function(w) { parts <- strsplit(w, ".", fixed=TRUE) int <- sapply(parts, function(x) as.numeric(x[1])) frac <- retrieveFraction(sapply(parts, function(x) x[2])) int + frac } cmr10widths <- data.frame(char=c("e", "s", "t"), index=c(101, 115, 116), width=retrieveFixNum(c("0.444446", "0.394445", "0.38889"))) cmr7widths <- data.frame(char=c("2"), index=c(50), width=retrieveFixNum(c("0.5694475"))) cmmi7widths <- data.frame(char=c("x", "mu"), index=c(120, 22), width=retrieveFixNum(c("0.64782", "0.544146"))) cmsy7widths <- data.frame(char=c("-", "mu"), index=c(0), width=retrieveFixNum(c("0.892861"))) ## A special Font Library that will weork for the specific fonts and ## glyphs in the .dvi testWidth <- function(index, file) { width <- switch(file, cmr10=cmr10widths$width[cmr10widths$index == index], cmr7=cmr7widths$width[cmr7widths$index == index], cmmi7=cmmi7widths$width[cmmi7widths$index == index], cmsy7=cmsy7widths$width[cmsy7widths$index == index]) attr(width, "unitsPerEm") <- 1 width } testBounds <- function(index, file) { ## Just placeholder bounds <- c(0, 0, .4, .7) attr(bounds, "unitsPerEm") <- 1 bounds } testLib <- xdvir:::FontLibrary(glyphWidth=testWidth, glyphHeight=NULL, glyphBounds=testBounds) ## Generate dvitype model answer type <- function(dpi, rules=TRUE, ...) { glyphs <- get(paste0("type", dpi, "glyphs")) if (rules) { rules <- get(paste0("type", dpi, "rules")) } else { rules <- NULL } list(glyphs=glyphs[,c("x", "y")], rules=rules) } ## Generate {xdvir} answer. ## Unfortunately, {xdvir} cannot render .dvi generated by pdflatex. ## Fortunately, {xdvir} can read .dvi generated by pdflatex and ## generate a set of "objects" with hh/vv. xdvir <- function(dpi, dviFile, rules=TRUE, fontLib=NULL, ...) { pdf(tempfile(fileext=".pdf")) grob <- suppressWarnings(dviGrob(dviFile, dpi=dpi, fontLib=fontLib)) dev.off() objList <- grob$objList[[1]] glyphs <- do.call(rbind, lapply(objList, function(x) { if (inherits(x, "XDVIRglyphObj")) x else NULL }))[,c("index", "size", "xx", "yy")] colnames(glyphs) <- c("id", "size", "x", "y") if (rules) { rules <- do.call(rbind, lapply(objList, function(x) { if (inherits(x, "XDVIRruleObj")) do.call(c, x) else NULL }))[,c("xx", "yy", "ww", "hh")] names(rules) <- c("x", "y", "w", "h") } else { rules=NULL } list(glyphs=as.matrix(glyphs)[,c("x", "y")], rules=rules) } compare <- function(a, b, dpi, rules=TRUE, ...) { a <- a(dpi, ...) b <- b(dpi, ...) glyphs <- a$glyphs - b$glyphs if (all(glyphs == 0)) { cat(paste0(dpi, " glyphs IDENTICAL!!!\n\n")) } else { if (all(glyphs - glyphs[1] == 0)) { cat(paste0(dpi, " glyphs offset by ", glyphs[1], "\n\n")) } else { cat(paste0(dpi, " glyphs differ\n\n")) } stop("xdvir does not replicate dvitype glyphs") } if (rules) { rules <- a$rules - b$rules if (all(rules == 0)) { cat(paste0(dpi, " rules IDENTICAL!!!\n\n")) } else { cat(paste0(dpi, " rules differ\n\n")) stop("xdvir does not replicate dvitype rules") } } else { rules <- NULL } list(glyphs=glyphs, rules=rules) } dviFile <- system.file("DVI", "test-dvitype.dvi", package="xdvir") compare(type, xdvir, 96, dviFile=dviFile, fontLib=testLib) compare(type, xdvir, 10, dviFile=dviFile, fontLib=testLib) compare(type, xdvir, 100, dviFile=dviFile, fontLib=testLib) compare(type, xdvir, 1000, dviFile=dviFile, fontLib=testLib) compare(type, xdvir, 4736287, dviFile=dviFile, fontLib=testLib)