Creating a .ppm file under bitmap() fails under Window's GhostScript

[coatless]

See PPM spec: https://paulbourke.net/dataformats/ppm/

Ideal output (need to delete first 4 lines/header)

head(image)
> [1] "P3"                                                                                             
> [2] "# Image generated by GPL Ghostscript (device=ppm)"                                              
> [3] "504 504"                                                                                        
> [4] "255"                                                                                            
> [5] "255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255"
> [6] "255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255"

Windows output:

❯ checking examples ... ERROR
  Running examples in 'surreal-Ex.R' failed
  The error most likely occurred in:
  
  > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
  > ### Name: surreal_text
  > ### Title: Apply the surreal method to a text string
  > ### Aliases: surreal_text
  > 
  > ### ** Examples
  > 
  > # Create a surreal plot of the text "R is fun" appearing on one line
  > r_is_fun_result <- surreal_text("R is fun", verbose = TRUE)
  Warning in file(file, "r") :
    cannot open file 'C:\Users\RUNNER~1\AppData\Local\Temp\RtmpCCO0YX/working_dir\RtmpGy7v5d\filea647da4246f.ppm': No such file or directory
  Error in file(file, "r") : cannot open the connection
  Calls: surreal_text -> temporary_text_plot -> scan -> file
  Execution halted

MWE:

# Create a temporary file path using a known directory
temp_dir <- tempdir()
temp_file <- tempfile(tmpdir = temp_dir)

# Create a bitmap image
bitmap(temp_file, type = "ppm")

# Create a blank plot
plot(1, 1, type = "n", axes = FALSE, xlab = "", ylab = "")

# Add text to the plot
text(1, 1, "Testing print", cex = 4)

# Close the plotting device
dev.off()

# Read the image file
image <- scan(temp_file, "", sep = "\n", quiet = TRUE)
head(image)

For whatever reason, the device of ppm on Windows is not being detected across the test suites I have access to. So, we'll disable surreal_text() on non-unix platforms.

[coatless]

Options:

New backend

Switch to using png() or jpeg() as graphic devices with the accompanying R package to read in.

e.g. png():

# Create a temporary file path using a known directory
temp_dir <- tempdir()
temp_file <- tempfile(tmpdir = temp_dir, fileext = ".png")

# Create a bitmap image
png(temp_file, antialias="none")

# Create a blank plot
plot(1, 1, type = "n", axes = FALSE, xlab = "", ylab = "")

# Add text to the plot
text(1, 1, "Testing print", cex = 4)

# Close the plotting device
dev.off()

# Read the image file
image <- png::readPNG(temp_file)

# Convert the array to integer values between 0 and 255
img_matrix <- round(image[,,3] * 255)

size <- dim(img_matrix)

# Display the image
head(img_matrix)

image(img_matrix)


# Create a data frame of non-white points
non_white_points <- which(img_matrix == 0, arr.ind = TRUE)
df <- data.frame(
  x = non_white_points[, 2],  # Column index represents x
  y = nrow(img_matrix) - non_white_points[, 1] + 1  # Row index represents y, but flipped
)

plot(df)

Hard requirement

Add to DESCRIPTION a requirement for ghostscript, e.g.

SystemRequirements: ghostscript

https://github.com/cran/grImport/blob/2c54f79cde111005659229ec7b22b5c124776654/DESCRIPTION#L5

Detection on ghostwriter vs. OS

Need to modify/incorporate a has_ghostwriter() test based on grDevices:::check_gs_type():

function (gsexe, type) 
{
    gshelp <- system(paste(gsexe, "-help"), intern = TRUE)
    st <- grep("^Available", gshelp)
    en <- grep("^Search", gshelp)
    if (!length(st) || !length(en)) 
        warning("unrecognized format of gs -help")
    else {
        gsdevs <- gshelp[(st + 1L):(en - 1L)]
        devs <- c(strsplit(gsdevs, " "), recursive = TRUE)
        if (match(type, devs, 0L) == 0L) {
            op <- options(warning.length = 8000L)
            on.exit(options(op))
            stop(gettextf("device '%s' is not available\n", type), 
                gettextf("Available devices are:\n%s", paste(gsdevs, 
                  collapse = "\n")), domain = NA)
        }
    }
}

[coatless]

Maybe also include a conversion across the cube over to greyscale instead of just one dimension (since png() and png::readPNG() gives RGB):

# Convert the array to integer values between 0 and 255
img_matrix <- round(image * 255)

img_grey_matrix <- apply(image, c(1, 2), sum)
img_grey_matrix <- img_grey_matrix/max(img_grey_matrix)
img_grey_matrix <- round(img_grey_matrix*255)