 uoaBlue <- "#00467f"
library(colorspace)
uoaLCH <- colorspace::coords(as(colorspace::hex2RGB(uoaBlue), "polarLUV")) 
 hues <- c(uoaLCH[3], uoaLCH[3] + 90, uoaLCH[3] + 180, uoaLCH[3] + 270)
darks <- hcl(hues, uoaLCH[2], uoaLCH[1])
lights <- hcl(hues, uoaLCH[2], 80)
arr <- arrow(length=unit(2, "mm"), type="closed")
document <- function(label, x=.5, y=.5,
                     w=unit(2, "cm"), h=unit(3, "cm"), d=unit(6, "mm"),
                     ann=TRUE, border=NA, fill=NULL, name="script") {
    if (is.null(fill)) {
        fill=lights[1]
    }
    pushViewport(viewport(x, y, w, h, name="scriptvp"))
    grid.polygon(unit.c(unit(0, "npc"),
                        unit(0, "npc"),
                        unit(1, "npc"),
                        unit(1, "npc"),
                        d,
                        d,
                        unit(0, "npc")),
                 unit.c(unit(1, "npc") - d,
                        unit(0, "npc"),
                        unit(0, "npc"),
                        unit(1, "npc"),
                        unit(1, "npc"),
                        unit(1, "npc") - d,
                        unit(1, "npc") - d),
                 gp=gpar(col=border, fill=fill),
                 name=name)
    grid.polygon(unit.c(unit(0, "npc"),
                        d,
                        d),
                 unit.c(unit(1, "npc") - d,
                        unit(1, "npc") - d,
                        unit(1, "npc")),
                 gp=gpar(col=NA, fill=darks[1]))
    grid.text(label)
    if (ann) {
        grid.rect(y=0, height=unit(2, "lines"), just="top",
                  gp=gpar(col=NA, fill=darks[1]))
        grid.segments(0, 0, 1, 0, gp=gpar(col="white", lwd=2))
        grid.text("SCRIPT", gp=gpar(col="white"),
                  y=unit(-1, "lines"))
    }
    upViewport()
}
module <- function(label, nin, nout,
                   x=.5, y=.5, w=unit(3, "cm"), h=unit(4, "cm"),
                   ann=TRUE, border=NA,
                   labelin=TRUE, labelout=TRUE, inoutext=.2,
                   arrowsin=TRUE, arrowsout=TRUE) {
    pushViewport(viewport(x, y, w, h, name="modulevp"))
    grid.rect(gp=gpar(col=border, 
 fill=lights[2]))
    document(label, ann=FALSE, border=darks[1], name=label)
    if (arrowsin) {
        arrin <- arr
    } else {
        arrin <- NULL
    }
    if (arrowsout) {
        arrout <- arr
    } else {
        arrout <- NULL
    }
    if (nin > 0) {
        grid.segments(-inoutext, 1:nin/(nin+1),
                      grobX(rectGrob(vp="scriptvp"), 180), 1:nin/(nin+1),
                      gp=gpar(lwd=3, col="black"), arrow=arrin)
        if (is.character(labelin)) {
            lab <- labelin
            fam <- "mono"
        } else if (labelin) {
            lab <- "IN"
            fam <- "sans"
        } else {
            lab <- NULL
        }
        if (!is.null(lab)) {
            grid.text(lab, unit(-inoutext, "npc") - unit(2, "mm"),
                      1:nin/(nin+1),
                      just="right", gp=gpar(cex=.7, fontfamily=fam))
        }
    }
    if (nout > 0) {
        grid.segments(grobX(rectGrob(vp="scriptvp"), 0),
                      1:nout/(nout+1), 1 + inoutext, 1:nout/(nout+1),
                      gp=gpar(lwd=3, col="black"), arrow=arrout)
        if (is.character(labelout)) {
            lab <- labelout
            fam <- "mono"
        } else if (labelout) {
            lab <- "OUT"
            fam <- "sans"
        } else {
            lab <- NULL
        }
        if (!is.null(lab)) {
            grid.text(lab, unit(1 + inoutext, "npc") + unit(2, "mm"),
                      1:nout/(nout+1),
                      just="left", gp=gpar(cex=.7, fontfamily=fam))
        }
    }
    if (ann) {
        grid.rect(y=0, height=unit(2, "lines"), just="top",
                  gp=gpar(col=NA, fill=darks[2]))
        grid.segments(0, 0, 1, 0, gp=gpar(col="white", lwd=2))
        grid.text("MODULE", gp=gpar(col="white"),
                  y=unit(0, "npc") - unit(1, "lines"))
    }
    upViewport()
}
pipeline <- function(x=.5, y=.5, width=unit(10, "cm"), height=unit(6, "cm"),
                     modules=TRUE) {
    pushViewport(viewport(x, y, width=width, height=height,
                          name="pipelinevp"))
    grid.rect(gp=gpar(col=NA, fill=lights[4]))
    if (modules) {
        module("R", 1, 2, x=1/4, labelout=FALSE, inoutext=.5, arrowsout=FALSE,
               ann=FALSE, border=darks[2])
        module("Python", 2, 1, x=3/4, labelin=FALSE, inoutext=.5,
               ann=FALSE, border=darks[2])
    }
    grid.rect(y=0, height=unit(2, "lines"), just="top",
#               gp=gpar(col=NA, fill=hcl(hue, sat, 40, trans)))
              gp=gpar(col=NA, fill=darks[4]))
    grid.segments(0, 0, 1, 0, gp=gpar(col="white", lwd=2))
    grid.text("PIPELINE", gp=gpar(col="white"),
              y=unit(0, "npc") - unit(1, "lines"))
    upViewport()
}
# grid.newpage()
pipeline(modules=FALSE, width=unit(10, "cm"), height=unit(10, "cm"))
downViewport("pipelinevp")
# Module 1
module("R", 0, 0, x=.2, labelin=FALSE, labelout=FALSE,
       ann=FALSE, border=darks[2])
downViewport("scriptvp")
# inputs
document(".csv", x=-.95, y=.4,
         w=unit(1, "cm"), h=unit(1.5, "cm"), d=unit(3, "mm"),
         ann=FALSE, border="black", fill="grey80")
grid.segments(-.55, .4, 0, .4, arrow=arr, gp=gpar(lwd=3))
# outputs
grid.curve(1, .7, 1.6, .9, arrow=arr, gp=gpar(lwd=3))
grid.rect(x=1.6, y=1.05, width=unit(1, "cm"), height=unit(1, "lines"),
          gp=gpar(fill="black"))
grid.text("01011", x=1.6, y=1.05,
          gp=gpar(cex=.7, fontfamily="mono", col="white"))
upViewport(2) # script
# MARK
memtopx <- convertX(grobX(nullGrob(x=1.6, y=1.2, vp=vpPath("modulevp", "scriptvp")), 0),
                    "in")
memtopy <- convertY(grobY(nullGrob(x=1.6, y=1.2, vp=vpPath("modulevp", "scriptvp")), 0),
                    "in")
csvbotx <- convertX(grobX(nullGrob(x=1.9, y=-.5, vp=vpPath("modulevp", "scriptvp")), 0),
                    "in")
csvboty <- convertY(grobY(nullGrob(x=1.9, y=-.5, vp=vpPath("modulevp", "scriptvp")), 0),
                    "in")
downViewport("scriptvp")
grid.curve(1, .3, 1.9, .1, curv=-1, arrow=arr, gp=gpar(lwd=3))
document(".csv", x=1.9, y=-.2,
         w=unit(1, "cm"), h=unit(1.5, "cm"), d=unit(3, "mm"),
         ann=FALSE, border="black", fill="grey80")
upViewport(2) # script
# Module 2
module("R", 0, 0, x=.65, y=.75, labelin=FALSE, labelout=FALSE,
       ann=FALSE, border=darks[2])
grid.curve(memtopx, memtopy,
           grobX(rectGrob(vp=vpPath("modulevp", "scriptvp")), 180),
           grobY(rectGrob(vp=vpPath("modulevp", "scriptvp")), 180),
           curv=-1, arrow=arr, gp=gpar(lwd=3))
downViewport("scriptvp")
grid.curve(1, .7, 1.75, .5, curv=-1, arrow=arr, gp=gpar(lwd=3))
document(".xml", x=1.75, y=.2,
         w=unit(1, "cm"), h=unit(1.5, "cm"), d=unit(3, "mm"),
         ann=FALSE, border="black", fill="grey80")
grid.curve(1.75, -.1, .2, -.5, curv=-1, inflect=TRUE, gp=gpar(lwd=3))
upViewport(2) # script
# MARK
curvex <- convertX(grobX(nullGrob(x=.2, y=-.5, vp=vpPath("modulevp", "scriptvp")), 0),
                    "in")
curvey <- convertY(grobY(nullGrob(x=.2, y=-.5, vp=vpPath("modulevp", "scriptvp")), 0),
                    "in")
# Module 3
module("Python", 0, 0, x=.8, y=.25, labelin=FALSE, labelout=FALSE,
       ann=FALSE, border=darks[2])
grid.curve(csvbotx, csvboty,
           grobX(rectGrob(vp=vpPath("modulevp", "scriptvp")), 220),
           grobY(rectGrob(vp=vpPath("modulevp", "scriptvp")), 220),
           curv=1, arrow=arr, gp=gpar(lwd=3))
grid.curve(curvex, curvey,
           grobX(rectGrob(vp=vpPath("modulevp", "scriptvp")), 160),
           grobY(rectGrob(vp=vpPath("modulevp", "scriptvp")), 160),
           curv=1, arrow=arr, gp=gpar(lwd=3))
downViewport("scriptvp")
grid.segments(1, .4, 1.55, .4, arrow=arr, gp=gpar(lwd=3))
document(".pdf", x=1.95, y=.4,
         w=unit(1, "cm"), h=unit(1.5, "cm"), d=unit(3, "mm"),
         ann=FALSE, border="black", fill="grey80")
upViewport(2) # script
upViewport() # pipeline


