adding view-level pars #247

Author: Jordan S Read

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: gsplot
 Type: Package
 Title: Geological Survey Plotting
-Version: 0.3.2
-Date: 2015-09-12
+Version: 0.4.0
+Date: 2015-09-16
 Authors@R: c( person("Jordan", "Read", role = "aut",
     email = "[email protected]"),
     person("Laura", "DeCicco", role = c("aut","cre"),

R/abline.R

@@ -28,5 +28,5 @@ abline <- function(object, ...) {
 
 
 abline.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='abline', ..., legend.name=legend.name, side=side)
+  set_window_args(object, fun.name='abline', ..., legend.name=legend.name, side=side, def.funs=graphics::abline)
 }

R/arrows.R

@@ -33,5 +33,5 @@ arrows <- function(object, ...) {
 
 
 arrows.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='arrows', ..., legend.name=legend.name, side=side)
+  set_window_args(object, fun.name='arrows', ..., legend.name=legend.name, side=side, def.funs=graphics::arrows)
 }

R/calc_views.R

@@ -48,8 +48,9 @@ group_views <- function(gsplot){
     if (!is.null(view.1) && !is.null(view.2) && any(view.2==view.1)){
       v.i = view.2[which(view.2 %in% view.1)]
       views[[v.i]] <- append(views[[v.i]], to_draw)
+      views[[v.i]][['window']][['par']] <- append_replace(views[[v.i]][['window']][['par']], tail.gs[['gs.config']][['par']])
     } else{
-      views <- append(views, list(view = append(to_draw, list(window=list(side=add_sides)))))
+      views <- append(views, list(view = append(to_draw, list(window=list(side=add_sides,par=tail.gs[['gs.config']][['par']])))))
     }
   } else {
     # // if field isn't associated with a side(s), it is moved up to top level (e.g., legend)
@@ -61,6 +62,13 @@ group_views <- function(gsplot){
   return(append(views, non.views))
 }
 
+append_replace <- function(old.list, new.list){
+  out.list <- old.list
+  out.list[names(old.list) %in% names(new.list)] <- new.list[names(out.list[names(old.list) %in% names(new.list)])]
+  new.list[names(new.list) %in% names(old.list)] <- NULL
+  out.list <- append(out.list, new.list)
+  return(out.list)
+}
 set_sides <- function(sides){
   if (length(sides)==1){
     if(sides %% 2 == 0)

R/callouts.R

@@ -29,7 +29,7 @@ callouts <- function(object, ...) {
 
 callouts.gsplot <- function(object, ..., side=c(1,2)){
 
-  set_window_args(object, fun.name='callouts', ..., legend.name=NULL, side=side, package='gsplot')
+  set_window_args(object, fun.name='callouts', ..., legend.name=NULL, side=side, package='gsplot', def.funs=c(graphics::arrows,callouts.default))
 }
 #' Default for adding callouts to a plot.
 #' 

R/grid.R

@@ -21,5 +21,5 @@ grid <- function(object, ...) {
 
 
 grid.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='grid', ..., legend.name=legend.name, side=side)
+  set_window_args(object, fun.name='grid', ..., legend.name=legend.name, side=side, def.funs = graphics::grid)
 }

R/lines.R

@@ -43,5 +43,5 @@ lines <- function(object, ...) {
 
 
 lines.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='lines', ..., legend.name=legend.name, side=side)
+  set_window_args(object, fun.name='lines', ..., legend.name=legend.name, side=side, def.funs=c(graphics::plot.xy, graphics::lines.default))
 }

R/mtext.R

@@ -29,5 +29,5 @@ mtext <- function(object, ...) {
 
 
 mtext.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='mtext', ..., legend.name=legend.name, side=side)
+  set_window_args(object, fun.name='mtext', ..., legend.name=legend.name, side=side, def.funs=graphics::mtext)
 }

R/par_arguments.R

@@ -0,0 +1,28 @@
+par_arguments <- function(arguments, def.funs){
+  
+  args = arguments[!names(arguments) %in% names(formal_arguments(arguments, def.funs)) & names(arguments) %in% names(par(no.readonly=T))]
+  if (length(args) > 0)
+    return(args)
+  else 
+    NULL
+}
+
+formal_arguments <- function(arguments, def.funs){
+  if (length(def.funs) > 1)
+    formal_names <- unique(unlist(lapply(def.funs, function(x)names(formals(x)))))
+  else 
+    formal_names <- names(formals(def.funs))
+  args = arguments[names(arguments) %in% formal_names]
+  if (length(args) > 0)
+    return(args)
+  else 
+    NULL
+}
+
+window_arguments <- function(arguments, def.funs){
+  args = arguments[!names(arguments) %in% names(formal_arguments(arguments, def.funs)) & !names(arguments) %in% names(par(no.readonly=T))]
+  if (length(args) > 0)
+    return(args)
+  else 
+    NULL
+}

R/points.R

@@ -46,5 +46,5 @@ points <- function(object, ...) {
 }
 
 points.gsplot <- function(object, ..., legend.name=NULL, side=c(1,2)){
-  set_window_args(object, fun.name='points', ..., legend.name=legend.name, side=side)
+  set_window_args(object, fun.name='points', ..., legend.name=legend.name, side=side, def.funs = c(graphics::plot.xy, graphics::points.default))
 }