tests/dpi.R

In xdvir: Render 'LaTeX' in Plots

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)