Allow custom settings to TA's color

Pass color settings to addTA functions except for addSAR, addMACD, addShading, addLines, addPoints and add*MA functions that have their own 'col' argument. Users can call chartTheme(addTA = list(...)) colors and pass chart.theme object to chartSeries to manage desired chart colors.
joshuaulrich · Aug 14, 2016 · e9199a1 · e9199a1
1 parent 435e7a3
commit e9199a1
Show file tree

Hide file tree

Showing 14 changed files with 142 additions and 80 deletions.
diff --git a/R/addAroon.R b/R/addAroon.R
@@ -20,9 +20,9 @@ function (n = 20, ..., on = NA, legend = "auto")
       ylim <- c(0,100)
       theme <- x$Env$theme
 
-      lines(x.pos, Aroon[,1], col = theme$aroon$col$aroonUp, 
+      lines(x.pos, Aroon[,1], col = theme$Aroon$col$aroonUp, 
             lwd = 1, lend = 2, ...)
-      lines(x.pos, Aroon[,2], col = theme$aroon$col$aroonDn, 
+      lines(x.pos, Aroon[,2], col = theme$Aroon$col$aroonDn, 
             lwd = 1, lend = 2, ...)
     }
     if(!is.character(legend) || legend == "auto")
@@ -39,7 +39,7 @@ function (n = 20, ..., on = NA, legend = "auto")
              legend = c(paste(legend, ":"),
                         paste("aroonUp :",format(last(Aroon[xsubset,1]),nsmall = 3L)), 
                         paste("aroonDn :",format(last(Aroon[xsubset,2]),nsmall = 3L))),
-             text.col = c(theme$fg, theme$aroon$col$aroonUp, theme$aroon$col$aroonDn), 
+             text.col = c(theme$fg, theme$Aroon$col$aroonUp, theme$Aroon$col$aroonDn), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 
@@ -61,9 +61,10 @@ function (n = 20, ..., on = NA, legend = "auto")
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
-    if (is.null(lchob$Env$theme$aroon$col$arronUp)) {
-      lchob$Env$theme$aroon$col$aroonUp <- 3
-      lchob$Env$theme$aroon$col$aroonDn <- 4
+    if (is.null(lchob$Env$theme$Aroon)) {
+      lchob$Env$theme$Aroon$col$aroonUp <- 3
+      lchob$Env$theme$Aroon$col$aroonDn <- 4
+      lchob$Env$theme$Aroon$col$aroonOsc <- 3
     }
     xdata <- lchob$Env$xdata
     xdata <- cbind(Hi(xdata),Lo(xdata))
@@ -97,7 +98,7 @@ function (n = 20, ..., on = NA, legend = "auto")
       ylim <- range(AroonOsc,na.rm=TRUE)
       theme <- x$Env$theme
 
-      lines(x.pos, AroonOsc, col = theme$aroon$col$aroonOsc, 
+      lines(x.pos, AroonOsc, col = theme$Aroon$col$aroonOsc, 
             lwd = 1, lend = 2, ...)
     }
     if(!is.character(legend) || legend == "auto")
@@ -135,8 +136,10 @@ function (n = 20, ..., on = NA, legend = "auto")
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
-    if (is.null(lchob$Env$theme$aroon$col$aroonOsc)) {
-      lchob$Env$theme$aroon$col$aroonOsc <- 3
+    if (is.null(lchob$Env$theme$Aroon)) {
+      lchob$Env$theme$Aroon$col$aroonUp <- 3
+      lchob$Env$theme$Aroon$col$aroonDn <- 4
+      lchob$Env$theme$Aroon$col$aroonOsc <- 3
     }
     xdata <- lchob$Env$xdata
     xdata <- cbind(Hi(xdata),Lo(xdata))

diff --git a/R/addCLV.R b/R/addCLV.R
@@ -18,7 +18,7 @@ function (..., on = NA, legend = "auto")
       ylim <- range(clv,na.rm=TRUE)
       theme <- x$Env$theme
 
-      lines(x.pos, clv, type = "h", col = theme$clv$col, 
+      lines(x.pos, clv, type = "h", col = theme$CLV$col, 
             lwd = 1, lend = 2, ...)
     }
     if(!is.character(legend) || legend == "auto")
@@ -34,7 +34,7 @@ function (..., on = NA, legend = "auto")
       legend(x = lc$x, y = lc$y, 
              legend = c(paste(legend, ":"),
                         paste(format(last(clv[xsubset]),nsmall = 3L))),
-             text.col = c(theme$fg, 5), 
+             text.col = c(theme$fg, theme$CLV$col), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 
@@ -56,8 +56,8 @@ function (..., on = NA, legend = "auto")
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
-    if (is.null(lchob$Env$theme$clv$col)) {
-      lchob$Env$theme$clv$col <- 5
+    if (is.null(lchob$Env$theme$CLV)) {
+      lchob$Env$theme$CLV$col <- 5
     }
     xdata <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset

diff --git a/R/addCMO.R b/R/addCMO.R
@@ -22,7 +22,7 @@
               max(abs(cmo), na.rm = TRUE))*1.05
     theme <- x$Env$theme
 
-    lines(x.pos, cmo, col = "#0033CC", lwd = 1, lend = 2)
+    lines(x.pos, cmo, col = theme$CMO$col, lwd = 1, lend = 2)
   }
   mapply(function(name, value) {
     assign(name, value, envir = lenv)
@@ -34,7 +34,7 @@
     legend(x = lc$x, y = lc$y, 
            legend = c(paste(legend, ":"),
                       paste(sprintf("%.3f",last(cmo[xsubset])), sep = "")),
-           text.col = c(theme$fg, "#0033CC"), 
+           text.col = c(theme$fg, theme$CMO$col), 
            xjust = lc$xjust, 
            yjust = lc$yjust, 
            bty = "n", 
@@ -57,6 +57,9 @@
   lchob <- current.chob()
   ncalls <- length(lchob$Env$call_list)
   lchob$Env$call_list[[ncalls + 1]] <- match.call()
+  if (is.null(lchob$Env$theme$CMO)) {
+    lchob$Env$theme$CMO$col <- "#0033CC"
+  }
 
   x <- lchob$Env$xdata
   xsubset <- lchob$Env$xsubset

diff --git a/R/addChaikin.R b/R/addChaikin.R
@@ -21,7 +21,7 @@ function (..., on = NA, legend = "auto")
       ylim <- range(ChaikinAD,na.rm=TRUE)
       theme <- x$Env$theme
 
-      lines(x.pos, ChaikinAD, col = theme$chaikin$col$chaikinad, 
+      lines(x.pos, ChaikinAD, col = theme$ChAD$col$chaikinAD, 
             lwd = 1, lend = 2, ...)
     }
     if(!is.character(legend) || legend == "auto")
@@ -37,7 +37,7 @@ function (..., on = NA, legend = "auto")
       legend(x = lc$x, y = lc$y, 
              legend = c(paste(legend, ":"),
                         paste(format(last(ChaikinAD[xsubset]),nsmall = 3L))),
-             text.col = c(theme$fg, theme$chaikin$col$chaikinad), 
+             text.col = c(theme$fg, theme$ChAD$col$chaikinAD), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 
@@ -59,8 +59,8 @@ function (..., on = NA, legend = "auto")
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
-    if (is.null(lchob$Env$theme$chaikin$col$chaikinad)) {
-      lchob$Env$theme$chaikin$col$chaikinad <- 3
+    if (is.null(lchob$Env$theme$ChAD)) {
+      lchob$Env$theme$ChAD$col$chaikinAD <- 3
     }
     xdata <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
@@ -92,7 +92,7 @@ function (n = 10, maType, ..., on = NA, legend = "auto")
       ylim <- range(ChaikinVol,na.rm=TRUE)
       theme <- x$Env$theme
 
-      lines(x.pos, ChaikinVol, col = theme$chaikin$col$chaikinvol, 
+      lines(x.pos, ChaikinVol, col = theme$ChVol$col$chaikinVol, 
             lwd = 1, lend = 2, ...)
     }
     if(missing(maType)) maType <- "SMA"
@@ -109,7 +109,7 @@ function (n = 10, maType, ..., on = NA, legend = "auto")
       legend(x = lc$x, y = lc$y, 
              legend = c(paste(legend, ":"),
                         paste(format(last(ChaikinVol[xsubset]),nsmall = 3L))),
-             text.col = c(theme$fg, theme$chaikin$col$chaikinvol), 
+             text.col = c(theme$fg, theme$ChVol$col$chaikinVol), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 
@@ -130,8 +130,8 @@ function (n = 10, maType, ..., on = NA, legend = "auto")
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
-    if (is.null(lchob$Env$theme$chaikin$col$chaikinvol)) {
-      lchob$Env$theme$chaikin$col$chaikinvol <- "#F5F5F5"
+    if (is.null(lchob$Env$theme$ChVol)) {
+      lchob$Env$theme$ChVol$col$chaikinVol <- "#F5F5F5"
     }
     xdata <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset

diff --git a/R/addEMV.R b/R/addEMV.R
@@ -21,12 +21,16 @@ function (volume, n = 9, maType, vol.divisor = 10000, ..., on = NA,
       ylim <- range(emv,na.rm=TRUE)*1.05
       theme <- x$Env$theme
 
-      lines(x.pos, emv$emv, col = 6, lwd = 1, lend = 2, ...)
-      lines(x.pos, emv$maEMV, col = 7, lwd = 1, lend = 2, ...)
+      lines(x.pos, emv$emv, col = theme$EMV$col$emv, lwd = 1, lend = 2, ...)
+      lines(x.pos, emv$maEMV, col = theme$EMV$col$maEMV, lwd = 1, lend = 2, ...)
     }
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
+    if (is.null(lchob$Env$theme$EMV)) {
+      lchob$Env$theme$EMV$col$emv <- 6
+      lchob$Env$theme$EMV$col$maEMV <- 7
+    }
     if(missing(volume)) volume <- lchob$Env$vo
     if(missing(maType)) maType <- "SMA"
     if(!is.character(legend) || legend == "auto")
@@ -46,7 +50,7 @@ function (volume, n = 9, maType, vol.divisor = 10000, ..., on = NA,
              legend = c(paste(legend, ":"),
                         paste("emv :", sprintf("%.3f",last(emv$emv[xsubset]))),
                         paste("maEMV :", sprintf("%.3f",last(emv$maEMV[xsubset])))),
-             text.col = c(theme$fg, 6, 7), 
+             text.col = c(theme$fg, theme$EMV$col$emv, theme$EMV$col$maEMV), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 

diff --git a/R/addKST.R b/R/addKST.R
@@ -22,8 +22,8 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9,
       ylim <- range(kst, na.rm=TRUE) * 1.05
       theme <- x$Env$theme
 
-      lines(x.pos, kst[,1], col = 6, lwd = 1, lend = 2, ...)
-      lines(x.pos, kst[,2], col = 7, lwd = 1, lend = 2, ...)
+      lines(x.pos, kst[,1], col = theme$KST$col$kst, lwd = 1, lend = 2, ...)
+      lines(x.pos, kst[,2], col = theme$KST$col$signal, lwd = 1, lend = 2, ...)
     }
     if(missing(maType)) maType <- "SMA"
     if(!is.character(legend) || legend == "auto")
@@ -43,7 +43,7 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9,
              legend = c(legend,
                         paste("kst :",format(last(kst[xsubset,1]),nsmall = 3L)), 
                         paste("signal :",format(last(kst[xsubset,2]),nsmall = 3L))),
-             text.col = c(theme$fg, 6, 7), 
+             text.col = c(theme$fg, theme$KST$col$kst, theme$KST$col$signal), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 
@@ -65,6 +65,10 @@ function (n = c(10, 10, 10, 15), nROC = c(10, 15, 20, 30), nSig = 9,
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
+    if (is.null(lchob$Env$theme$KST)) {
+      lchob$Env$theme$KST$col$kst <- 6
+      lchob$Env$theme$KST$col$signal <- 7
+    }
     x <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     x <- Cl(x)

diff --git a/R/addMFI.R b/R/addMFI.R
@@ -20,7 +20,7 @@ function (n = 14, ..., on = NA, legend = "auto")
       ylim <- c(0,100)
       theme <- x$Env$theme
 
-      lines(x.pos, mfi, col = 8, lwd = 1, lend = 2, ...)
+      lines(x.pos, mfi, col = theme$MFI$col, lwd = 1, lend = 2, ...)
     }
     if(!is.character(legend) || legend == "auto")
       legend <- gsub("^addMFI", "Money Flow Index ", deparse(match.call()))
@@ -35,7 +35,7 @@ function (n = 14, ..., on = NA, legend = "auto")
       legend(x = lc$x, y = lc$y, 
              legend = c(paste(legend, ":"),
                         paste(format(last(mfi[xsubset]),nsmall = 3L))),
-             text.col = c(theme$fg, 8), 
+             text.col = c(theme$fg, theme$MFI$col), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 
@@ -57,6 +57,9 @@ function (n = 14, ..., on = NA, legend = "auto")
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
+    if (is.null(lchob$Env$theme$MFI)) {
+      lchob$Env$theme$MFI$col <- 8
+    }
     x <- lchob$Env$xdata
     xsubset <- lchob$Env$xsubset
     volume <- lchob$Env$vo

diff --git a/R/addOBV.R b/R/addOBV.R
@@ -19,7 +19,7 @@ function (..., on = NA, legend = "auto")
       ylim <- range(obv, na.rm=TRUE) * 1.05 
       theme <- x$Env$theme
 
-      lines(x.pos, obv, col = 4, lwd = 1, lend = 2, ...)
+      lines(x.pos, obv, col = theme$OBV$col, lwd = 1, lend = 2, ...)
 
     }
     if(!is.character(legend) || legend == "auto")
@@ -36,7 +36,7 @@ function (..., on = NA, legend = "auto")
       legend(x = lc$x, y = lc$y, 
              legend = c(paste(legend, ":"),
                         paste(format(last(obv[xsubset]),nsmall = 3L))),
-             text.col = c(theme$fg, 4), 
+             text.col = c(theme$fg, theme$OBV$col), 
              xjust = lc$xjust, 
              yjust = lc$yjust, 
              bty = "n", 
@@ -58,6 +58,9 @@ function (..., on = NA, legend = "auto")
     lchob <- current.chob()
     ncalls <- length(lchob$Env$call_list)
     lchob$Env$call_list[[ncalls + 1]] <- match.call()
+    if (is.null(lchob$Env$theme$OBV)) {
+      lchob$Env$theme$OBV$col <- 4
+    }
     x <- try.xts(lchob$Env$xdata, error=FALSE)
     xsubset <- lchob$Env$xsubset
     vo <- lchob$Env$vo

diff --git a/R/addSMI.R b/R/addSMI.R
@@ -26,11 +26,8 @@
                 max(abs(smi[,1]), na.rm = TRUE))*1.05
     theme <- x$Env$theme
 
-    COLOR <- "#0033CC"
-    SIGNAL <- "#BFCFFF"
-
-    lines(x.pos,smi[,1],col=COLOR,lwd=1,type='l')
-    lines(x.pos,smi[,2],col=SIGNAL,lwd=1,lty='dotted',type='l')
+    lines(x.pos,smi[,1],col=theme$SMI$col$smi,lwd=1,type='l')
+    lines(x.pos,smi[,2],col=theme$SMI$col$signal,lwd=1,lty='dotted',type='l')
 
   }
   mapply(function(name, value) {
@@ -40,22 +37,20 @@
   exp <- parse(text = gsub("list", "chartSMI", as.expression(substitute(list(x = current.chob(), 
                                                                               n = n,fast = fast,slow = slow,signal = signal,ma.type = ma.type)))), srcfile = NULL)
   exp <- c(exp, expression(
-    COLOR <- "#0033CC",
-    SIGNAL <- "#BFCFFF",
     text(0, max(abs(smi[,1]), na.rm = TRUE)*.9,
          paste("Stochastic Momentum Index (",
                paste(n,fast,slow,signal,sep=','),
                "):", sep = ""), col = theme$fg, 
          pos = 4),
 
     text(0, max(abs(smi[,1]), na.rm = TRUE)*.9,
-         paste("\n\n\nSMI: ",sprintf("%.3f",last(smi[xsubset,1])), sep = ""), col = COLOR, 
-         pos = 4),
+         paste("\n\n\nSMI: ",sprintf("%.3f",last(smi[xsubset,1])), sep = ""), 
+         col = theme$SMI$col$smi, pos = 4),
 
     text(0, max(abs(smi[,1]), na.rm = TRUE)*.9,
          paste("\n\n\n\n\nSignal: ",
-               sprintf("%.3f",last(smi[xsubset,2])), sep = ""), col = SIGNAL, 
-         pos = 4)))
+               sprintf("%.3f",last(smi[xsubset,2])), sep = ""), 
+         col = theme$SMI$col$signal, pos = 4)))
   exp <- c(expression(
     smi <- TA$smi,
     # add inbox color
@@ -73,6 +68,10 @@
   lchob <- current.chob()
   ncalls <- length(lchob$Env$call_list)
   lchob$Env$call_list[[ncalls + 1]] <- match.call()
+  if (is.null(lchob$Env$theme$SMI)) {
+    lchob$Env$theme$SMI$col$smi <- "#0033CC"
+      lchob$Env$theme$SMI$col$signal <- "#BFCFFF"
+  }
 
   x <- lchob$Env$xdata
   xsubset <- lchob$Env$xsubset