R Under development (unstable) (2025-02-20 r87772 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > library(xdvir) TeX: C:\PROGRA~1\MiKTeX\miktex\bin\x64\latex.exe xetex: MiKTeX-XeTeX 4.9 (MiKTeX 23.1) luatex: This is LuaTeX, Version 1.16.0 (MiKTeX 23.1) luaotfload-tool: 3.23 > > ## 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) 96 glyphs IDENTICAL!!! 96 rules IDENTICAL!!! $glyphs x y 1 0 0 2 0 0 3 0 0 4 0 0 5 0 0 6 0 0 7 0 0 8 0 0 $rules x y w h 1 0 0 0 0 > compare(type, xdvir, 10, dviFile=dviFile, fontLib=testLib) 10 glyphs IDENTICAL!!! 10 rules IDENTICAL!!! $glyphs x y 1 0 0 2 0 0 3 0 0 4 0 0 5 0 0 6 0 0 7 0 0 8 0 0 $rules x y w h 1 0 0 0 0 > compare(type, xdvir, 100, dviFile=dviFile, fontLib=testLib) 100 glyphs IDENTICAL!!! 100 rules IDENTICAL!!! $glyphs x y 1 0 0 2 0 0 3 0 0 4 0 0 5 0 0 6 0 0 7 0 0 8 0 0 $rules x y w h 1 0 0 0 0 > compare(type, xdvir, 1000, dviFile=dviFile, fontLib=testLib) 1000 glyphs IDENTICAL!!! 1000 rules IDENTICAL!!! $glyphs x y 1 0 0 2 0 0 3 0 0 4 0 0 5 0 0 6 0 0 7 0 0 8 0 0 $rules x y w h 1 0 0 0 0 > compare(type, xdvir, 4736287, dviFile=dviFile, fontLib=testLib) 4736287 glyphs IDENTICAL!!! 4736287 rules IDENTICAL!!! $glyphs x y 1 0 0 2 0 0 3 0 0 4 0 0 5 0 0 6 0 0 7 0 0 8 0 0 $rules x y w h 1 0 0 0 0 > > proc.time() user system elapsed 0.73 0.12 4.25