Merge pull request #355 from jread-usgs/master

code for several issues

Author: Lindsay Carr

R/bgCol.R

@@ -36,10 +36,8 @@ bgCol <- function(object, ...) {
 
 bgCol.gsplot <- function(object, ...){
 
-  
   to.gsplot <- filter_arguments(fun.name = "bgCol", ...)$call.args
-  object <- append(object, to.gsplot)
-  class(object) <- 'gsplot'
+  object$global$bgCol <- append_replace(object$global$bgCol, to.gsplot[[1]])
   return(object)
 
 }
@@ -49,10 +47,9 @@ bgCol.gsplot <- function(object, ...){
 #' @param col color code or name, 
 #' see \code{\link[grDevices]{colors}}, \code{\link[grDevices]{palette}}. 
 #' Here NULL means color 0.
-#' @param \dots additional arguments passed to \code{\link[graphics]{rect}}
 #' @export
 #' @keywords internal
-bgCol.default <- function(col,...){
+bgCol.default <- function(col=NULL){
 
   if(par()$xlog){
     x1 <- 10^(par("usr")[1])
@@ -70,7 +67,7 @@ bgCol.default <- function(col,...){
     y2 <- par("usr")[4]  
   }
 
-  rect(x1,y1,x2,y2,col = col, border = NA, ...)
+  rect(x1,y1,x2,y2,col = col, border = NA)
 
 }
 

R/gather_function_info.R

@@ -19,7 +19,7 @@
 #' @return a code{gsplot} object
 #' @keywords internal
 gather_function_info <- function(object, fun.name, ..., legend.name, side){
-  arguments <- filter_arguments(fun.name, ...)
+  arguments <- filter_arguments(fun.name, ..., side=side)
 
   call.args <- arguments$call.args
   option.args <- arguments$option.args

R/print.R

@@ -43,9 +43,10 @@ print.gsplot <- function(x, ...){
 
   par(x$global$par)
 
-  bg.arg <- views$bgCol
-  title.arg <- views$title
-  
+  bg.arg <- views$global$bgCol
+  title.arg <- views$global$title
+  bgCol(bg.arg)
+  title(title.arg)
   view.info <- view_info(views)
   side.names <- side_names(views)
 
@@ -73,13 +74,9 @@ print.gsplot <- function(x, ...){
     if(any(names(views[[view.name]]) %in% 'grid')){
       draw_custom_grid(views,view.name)
     }
+
     print.view(views[[view.name]])
-        # -- initial view --
-    if(view.name == view_names(views)[1]){
-      if (!is.null(bg.arg))
-        bgCol(bg.arg)
-      title(title.arg)
-    }
+    
     par(new=TRUE)
   }
 

R/title.R

@@ -35,10 +35,6 @@ title <- function(object, ...) {
 title.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
   to.gsplot <- set_args("title", ..., package = "graphics")
 
-  to.gsplot <- list("title"=to.gsplot)
-  
-  object <- append(object, to.gsplot)
-  class(object) <- 'gsplot'
+  object$global$title <- append_replace(object$global$title, to.gsplot)
   return(object)
-  # set_window_args(object, fun.name='title', ..., legend.name=legend.name, side=side, def.funs=graphics::title)
 }

inst/doc/gsplotIntro.html

@@ -10,6 +10,8 @@ test_that("mtext on correct side", {
   expect_true(4 %in% gsplot:::as.side(names(gs[i])))
   warning('skipping axes test in mtext. not sure why this was here')
   #expect_false(gs$side.4$axes)
+  
+  expect_equal(gs$view.1.4$mtext$side, 4)
 })
 
 

man/bgCol.default.Rd

@@ -11,7 +11,7 @@ test_that("testing content of gsplot list for title", {
     lines(20:30,20:30, side=c(3,4)) %>%
     title("Great Graph")
 
-  expect_true(any(names(gs) %in% "title"))
+  expect_true(any(names(gs$global) %in% "title"))
 
 })
 

tests/testthat/test-mtext.R

@@ -11,7 +11,7 @@ test_that("testing content of gsplot list for bgCol", {
     lines(20:30,20:30, side=c(3,4)) %>%
     bgCol(col="coral2")
 
-  expect_true(any(names(gs) %in% "bgCol"))
+  expect_true(any(names(gs$global) %in% "bgCol"))
 
 })