R/boxshade.R

In mhahsler/rMSA: Interface for Popular Multiple Sequence Alignment Tools

#######################################################################
# BiostringsTools - Interfaces to several sequence alignment and
# classification tools
# Copyright (C) 2012 Michael Hahsler and Anurag Nagar
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

boxshade <- function(
    x, file, dev = "pdf", param = "-thr=0.5 -cons -def",
    pdfCrop = TRUE) {
    devs <- c(
        ps = 1, eps = 2, hpgl = 3, rtf = 4, crt = 5, ansi = 6, vt = 7,
        ascii = "b", fig = "c", pict = "d", html = "e"
    )

    dev <- tolower(dev)

    ## pdf?
    if (dev == "pdf") {
        pdf <- TRUE
        if (pdfCrop) {
            dev <- "eps"
        } else {
            dev <- "ps"
        }
    } else {
        pdf <- FALSE
    }

    if (dev %in% names(devs)) dev <- devs[[dev]]

    ## get temp files and change working directory
    wd <- tempdir()
    temp_file <- tempfile(tmpdir = wd)
    on.exit({
        file.remove(Sys.glob(paste(temp_file, ".*", sep = "")))
    })

    infile <- paste(temp_file, ".PHY", sep = "")
    write.phylip(x, filepath = infile)

    ## call boxshade (needs to be installed and in the path!)
    system2(.findExecutable(c("boxshade", "box")), args = c(
        paste0("-in=", infile), "-type=5",
        paste0("-out=", file),
        paste0("-dev=", dev),
        param)
    )

    if (pdf) {
        temp_file <- paste(file, ".tmp", sep = "")
        file.rename(file, temp_file)
        system2(
            .findExecutable("ps2pdf"), args = c(
            if (pdfCrop) "-dEPSCrop" else "",
            temp_file, file)
        )
        unlink(temp_file)
    }
}

boxshade_help <- function() {
    system2(
        .findExecutable(c("boxshade", "box")),
        args = c("-help")
    )
}