# Utility functions for the Rattle Book. # # Copyright (c) 2011 Graham.Williams@togawre.com # # At the beginning of each .Rnw file we should source this file and # save the current state, which is restored at the end of the .Rnw. # # source("utility.R") # pkgs <- lspkgs(); objs <- ls() # # ... # # rattle:::close_rattle() # rmobj(pkgs, "detach"); rmobj(objs, "rm") # while (dev.cur() > 1) dev.off() require(rattle) crv$show.timestamp <- FALSE ## source("dmoop.R") # 100529 Until it is packaged "libary(dmoop)" lspkgs <- function() { search()[grep("package:", search())] } # At the end remove each newly attached package. # # rmobj(pkgs, "detach"); rmobj(objs, "rm") rmobj <- function(keep, rmfun) { if (rmfun == "rm") remove <- setdiff(ls(topenv()), keep) else remove <- setdiff(lspkgs(), keep) if (length(remove)) sapply(remove, function(x) eval(parse(text=sprintf("%s('%s'%s)", rmfun, x, ifelse(rmfun=="rm", ", envir=topenv()", ""))))) } # Take a screen shot of a specific window. screenShot <- function(fname="book:save_plot", folder="graphics", type="png", title="RPlot", num=dev.cur(), pause=0, close=FALSE, wm.compiz=TRUE) { if (dirname(fname) == ".") fname <- file.path(folder, fname) if (!length(grep("\\....$", fname))) fname <- sprintf("%s.%s", fname, type) title <- switch(title, RPlot = sprintf("R Graphics: Device %d (ACTIVE)", num), RattlePlot = sprintf("Rattle: Plot %d", num), RattleStart = "R Data Miner - [Rattle]", RattleAudit = "R Data Miner - [Rattle (audit.csv)]", RattleWeather = "R Data Miner - [Rattle (weather.csv)]", RattleDVDTrans = "R Data Miner - [Rattle (dvdtrans.csv)]", title) # 090903 Get the window's ID (not needed for import but it is for xdotool # and scrot). We also sleep momentarily to allow the window to be instantiated # before we try to get the required information. Sys.sleep(pause + .05) # 100124 Chenge how we get the window ID to using a substring # matching, which is what wmctrl can also do, bit xwininfo does # not. This is needed because some windows contain variable lists # (like latticisit which contains "...c(2:23)..." but when I change # the data (by adding some more variables) I need to change all # references. So just list the substring to match. #window.id <- unlist(strsplit(system(sprintf("xwininfo -name '%s' | grep 'Window id'", # title), intern=TRUE), " "))[4] window.id <- system(sprintf("wmctrl -l | grep -F '%s' | head -1 | awk '{print $1}'", title), intern=TRUE) # 090903 Import does not grab the frame when copmiz is running. So let's use # scrot to grab the screen and then extract the bit we want. We obtain the frame # and window stuff here for scrot processing. # 090924 Seems like xprop now no longer has a _NET_FRAME_WINDOW! What gives????? Okay, # so try instead adding a bit to each of the edges in the crop. ## frame.id <- unlist(strsplit(system(sprintf("xprop -id %s _NET_FRAME_WINDOW", ## window.id), intern=TRUE), " "))[5] ## frame.x <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", ## "grep 'Absolute upper-left X'"), ## frame.id), intern=TRUE), ": *"))[2] ## frame.y <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", ## "grep 'Absolute upper-left Y'"), ## frame.id), intern=TRUE), ": *"))[2] ## frame.w <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", ## "grep 'Width'"), ## frame.id), intern=TRUE), ": *"))[2] ## frame.h <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", ## "grep 'Height'"), ## frame.id), intern=TRUE), ": *"))[2] # frame.id <- unlist(strsplit(system(sprintf("xprop -id %s _NET_FRAME_WINDOW", # window.id), intern=TRUE), " "))[5] frame.x <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", "grep 'Absolute upper-left X'"), window.id), intern=TRUE), ": *"))[2] frame.y <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", "grep 'Absolute upper-left Y'"), window.id), intern=TRUE), ": *"))[2] frame.w <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", "grep 'Width'"), window.id), intern=TRUE), ": *"))[2] frame.h <- unlist(strsplit(system(sprintf(paste("xwininfo -id %s |", "grep 'Height'"), window.id), intern=TRUE), ": *"))[2] # 090903 Make sure the window is on top. system(sprintf("xdotool windowactivate %s", window.id)) Sys.sleep(pause) # Now the screenshot. 090903 The import command fails to grab the frame when # compriz is running. Use scrot until that is fixed. # system(sprintf("import -silent -pause %d -frame -window '%s' %s", # pause, title, fname)) system("scrot -d 1 tmp.png") convert.cmd <- sprintf("convert -crop '%s'x'%s'+'%s'+'%s'! tmp.png %s", as.numeric(frame.w)+6, as.numeric(frame.h)+25, max(0, as.numeric(frame.x)-3), as.numeric(frame.y)-22, fname) # cat(convert.cmd, file="tmp.log") system(convert.cmd) if (close) { system(sprintf("wmctrl -c '%s'", title)) Sys.sleep(1) # To give time for R to notice the window disappears } #cat(sprintf("Saved '%s' to '%s'%s\n", title, fname, # ifelse(close, " and closed.", "."))) } digits2text <- function(x, mult="") { units <- c("one", "two", "three", "four", "five", "six", "seven", "eight", "nine") teens <- c("ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen") tens <- c("ten", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety") digits <- rev(as.numeric(strsplit(as.character(x), "")[[1]])) digilen <- length(digits) if(digilen == 2 && digits[2] == 1) return(teens[digits[1]+1]) digitext <- units[digits[1]] if(digilen > 1) digitext <- c(digitext, tens[digits[2]]) if(digilen > 2) digitext <- c(digitext, "hundred", units[digits[3]]) if(digilen > 3) digitext <- c(digitext, digits2text(floor(x/1000), "thousand")) if(digilen > 6) digitext <- c(digitext, digits2text(floor(x/1000000), "million")) return(paste(c(rev(digitext), mult), sep="", collapse=" ")) } rebuild <- function(fname=NULL) { if (is.null(fname)) return(REBUILD) fname <- sprintf("graphics/%s.png", fname) if (file.exists(fname)) return(REBUILD) return(TRUE) }