Refactor addCMF to follow skeleton_TA structure

R/addCMF.R

@@ -2,41 +2,72 @@
 # addCMF {{{
 `addCMF` <- function(n=20) {
 
-  lchob <- get.current.chob()
+  lenv <- new.env()
+  lenv$chartCMF <- function(x, n) {
+    xdata <- x$Env$xdata
+    xsubset <- x$Env$xsubset
+    xdata <- cbind(Hi(xdata),Lo(xdata),Cl(xdata))
+    vo <- x$Env$vo
+    cmf <- CMF(xdata,vo,n=n)[xsubset]
+    spacing <- x$Env$theme$spacing
+    x.pos <- 1 + spacing * (1:NROW(cmf) - 1)
+    xlim <- x$Env$xlim
+    ylim <- c(-max(abs(cmf), na.rm = TRUE), 
+              max(abs(cmf), na.rm = TRUE))*1.05
+    theme <- x$Env$theme
 
-  x <- as.matrix(lchob@xdata)
-
-  chobTA <- new("chobTA")
-  chobTA@new <- TRUE
-
-  xx <- if(is.OHLC(x)) {
-    cbind(Hi(x),Lo(x),Cl(x))
+    cmf.positive <- ifelse(cmf >= 0,cmf,0)
+    cmf.negative <- ifelse(cmf <  0,cmf,0)
+
+    polygon(c(x.pos,rev(x.pos)),cbind(cmf.positive,rep(0,length(cmf))),col=theme$up.col)
+    polygon(c(x.pos,rev(x.pos)),cbind(cmf.negative,rep(0,length(cmf))),col=theme$dn.col)
+  }
+  mapply(function(name, value) {
+    assign(name, value, envir = lenv)
+  }, names(list(n = n)), list(n = n))
+  exp <- parse(text = gsub("list", "chartCMF", as.expression(substitute(list(x = current.chob(), 
+                                                                                  n = n)))), srcfile = NULL)
+  exp <- c(exp, expression(
+    lc <- xts:::legend.coords("topleft", xlim, c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05),
+    legend(x = lc$x, y = lc$y, 
+           legend = c(paste(legend, ":"),
+                      paste(sprintf("%.3f",last(cmf)), sep = "")),
+           text.col = c(theme$fg, ifelse(last(cmf) > 0,theme$up.col,theme$dn.col)), 
+           xjust = lc$xjust, 
+           yjust = lc$yjust, 
+           bty = "n", 
+           y.intersp=0.95)))
+  exp <- c(expression(    
+    # add inbox color
+    rect(xlim[1], -max(abs(cmf), na.rm = TRUE)*1.05, xlim[2], max(abs(cmf), na.rm = TRUE)*1.05, col=theme$fill),
+    # add grid lines and left-side axis labels
+    segments(xlim[1], y_grid_lines(c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05), 
+             xlim[2], y_grid_lines(c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05), 
+             col = theme$grid, lwd = x$Env$grid.ticks.lwd, lty = 3),
+    text(xlim[1], y_grid_lines(c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05), y_grid_lines(c(-max(abs(cmf), na.rm = TRUE),max(abs(cmf), na.rm = TRUE))*1.05), 
+         col = theme$labels, srt = theme$srt, 
+         offset = 0.5, pos = 2, cex = theme$cex.axis, xpd = TRUE),
+    # add border of plotting area
+    rect(xlim[1], -max(abs(cmf), na.rm = TRUE)*1.05, xlim[2], max(abs(cmf), na.rm = TRUE)*1.05, border=theme$labels),
+    segments(xlim[1], 0, xlim[2], 0, col = "#999999")), exp)
+
+  lchob <- current.chob()
+  xdata <- lchob$Env$xdata
+  xdata <- if(is.OHLC(xdata)) {
+    cbind(Hi(xdata),Lo(xdata),Cl(xdata))
   } else stop("CMF only applicaple to HLC series")
-
-  cmf <- CMF(xx,Vo(x),n=n)
-
-  [email protected] <- cmf[lchob@xsubset]
-  chobTA@name <- "chartCMF"
-  chobTA@call <- match.call()
-  chobTA@params <- list(xrange=lchob@xrange,
-                        colors=lchob@colors,
-                        [email protected],
-                        [email protected],
-                        spacing=lchob@spacing,
-                        width=lchob@width,
-                        bp=lchob@bp,
-                        [email protected],
-                        [email protected],
-                        n=n)
-  if(is.null(sys.call(-1))) {
-    TA <- [email protected]$TA
-    [email protected]$TA <- c(TA,chobTA)
-    lchob@windows <- lchob@windows + ifelse(chobTA@new,1,0)
-    do.call('chartSeries.chob',list(lchob))
-    invisible(chobTA)
-  } else {
-   return(chobTA)
-  } 
+  xsubset <- lchob$Env$xsubset
+  vo <- lchob$Env$vo
+
+  cmf <- CMF(xdata,vo,n=n)[xsubset]
+  lchob$Env$cmf <- cmf
+  if(!is.character(legend) || legend == "auto")
+    lchob$Env$legend <- paste("Chaikin Money Flow (", n, ")", sep="")
+  lchob$add_frame(ylim=c(-max(abs(cmf), na.rm = TRUE), 
+                         max(abs(cmf), na.rm = TRUE))*1.05,asp=1,fixed=TRUE)
+  lchob$next_frame()
+  lchob$replot(exp, env=c(lenv,lchob$Env), expr=TRUE)
+  lchob
 } #}}}
 # chartCMF {{{
 `chartCMF` <-