| 1 |
### bdopen
|
1 |
### bdopen
|
| 2 |
### Used to open a graphics driver with BDplot.
|
2 |
### Used to open a graphics driver with BDplot.
|
| 3 |
|
3 |
|
| 4 |
### In X11, height and width are scaled to get a nicer window on the screen.
|
4 |
### In X11, height and width are scaled to get a nicer window on the screen.
|
| 5 |
### This hack is ugly. At least there should be a scaling factor in stead so that all measures are scaled (fonts, etc).
|
5 |
### This hack is ugly. At least there should be a scaling factor in stead so that all measures are scaled (fonts, etc).
|
| 6 |
|
6 |
|
| 7 |
bdopen <- function(file=bdp()$file,paper=bdp()$paper,mfrow=bdp()$mfrow,scale=TRUE,quality=NULL,scaleheight=1,height=NULL)
|
7 |
bdopen <- function(file=bdp()$file,paper=bdp()$paper,mfrow=bdp()$mfrow,scale=TRUE,quality=NULL,scaleheight=1,height=NULL)
|
| 8 |
{
|
8 |
{
|
| 9 |
.bdcalcsizes(paper=paper,mfrow=mfrow,scaleheight=scaleheight,height=height)
|
9 |
.bdcalcsizes(paper=paper,mfrow=mfrow,scaleheight=scaleheight,height=height)
|
| 10 |
prm <- .bdgetpars()
|
10 |
prm <- .bdgetpars()
|
| 11 |
if(!is.null(height)){
|
11 |
if(!is.null(height)){
|
| 12 |
prm$height <- height
|
12 |
prm$height <- height
|
| 13 |
}
|
13 |
}
|
| 14 |
if(prm$debug)
|
14 |
if(prm$debug)
|
| 15 |
print(prm$height)
|
15 |
print(prm$height)
|
| 16 |
if( !is.na(file) )
|
16 |
if( !is.na(file) )
|
| 17 |
{
|
17 |
{
|
| 18 |
## If figdir is supplied, prepending it to filename.
|
18 |
## If figdir is supplied, prepending it to filename. It would be great only to do this if the path given in file is not absolute, ie starting by eather / or ~.
|
| 19 |
if(!is.null(prm$figdir)&!is.na(prm$figdir))
|
19 |
if(!is.null(prm$figdir)&&!is.na(prm$figdir) && (substring(bdp()$figdir,1,1)!="~"&&substring(bdp()$figdir,1,1)!="/") )
|
| 20 |
{
|
20 |
{
|
| 21 |
file <- paste(prm$figdir,file,sep="/")
|
21 |
file <- paste(prm$figdir,file,sep="/")
|
| 22 |
}
|
22 |
}
|
| 23 |
cat("Writing to",file,"\n")
|
23 |
cat("Writing to",file,"\n")
|
| 24 |
## determining device driver from filename
|
24 |
## determining device driver from filename
|
| 25 |
nchars <- nchar(file)
|
25 |
nchars <- nchar(file)
|
| 26 |
##### should switch be used here?
|
26 |
##### should switch be used here?
|
| 27 |
if( any( substr(file,nchars-2,nchars)==".ps",substr(file,nchars-3,nchars)==".eps")){
|
27 |
if( any( substr(file,nchars-2,nchars)==".ps",substr(file,nchars-3,nchars)==".eps")){
|
| 28 |
m <- {
|
28 |
m <- {
|
| 29 |
cat("B/D plotting writing to postscript file\n")
|
29 |
cat("B/D plotting writing to postscript file\n")
|
| 30 |
postscript(file=file, width=prm$width, height=prm$height, paper="special", family = "Helvetica", horizontal=FALSE)
|
30 |
postscript(file=file, width=prm$width, height=prm$height, paper="special", family = "Helvetica", horizontal=FALSE)
|
| 31 |
}
|
31 |
}
|
| 32 |
} else if ( substr(file,nchars-3,nchars)==".pdf")
|
32 |
} else if ( substr(file,nchars-3,nchars)==".pdf")
|
| 33 |
{
|
33 |
{
|
| 34 |
pdf(file=file, width=prm$width, height=prm$height, paper="special",family = "Helvetica")
|
34 |
pdf(file=file, width=prm$width, height=prm$height, paper="special",family = "Helvetica")
|
| 35 |
} else if (any(substr(file,nchars-3,nchars)==".jpg", substr(file,nchars-4,nchars)==".jpeg")) {
|
35 |
} else if (any(substr(file,nchars-3,nchars)==".jpg", substr(file,nchars-4,nchars)==".jpeg")) {
|
| 36 |
cat("Writing to jpeg file\n")
|
36 |
cat("Writing to jpeg file\n")
|
| 37 |
if(is.null(quality))
|
37 |
if(is.null(quality))
|
| 38 |
quality=prm$jpeg.quality
|
38 |
quality=prm$jpeg.quality
|
| 39 |
jpeg(filename=file,width=prm$width,height=prm$height,units=prm$size.unit,quality=quality,res=prm$jpeg.res,type="cairo")
|
39 |
jpeg(filename=file,width=prm$width,height=prm$height,units=prm$size.unit,quality=quality,res=prm$jpeg.res,type="cairo")
|
| 40 |
### bitmap(file=file,type="jpeg",width=prm$width,height=prm$height,units=prm$size.unit,res=prm$jpeg.res,pointsize=.3)
|
40 |
### bitmap(file=file,type="jpeg",width=prm$width,height=prm$height,units=prm$size.unit,res=prm$jpeg.res,pointsize=.3)
|
| 41 |
} else if ( substr(file,nchars-3,nchars)==".tex"){
|
41 |
} else if ( substr(file,nchars-3,nchars)==".tex"){
|
| 42 |
require(tikzDevice)
|
42 |
require(tikzDevice)
|
| 43 |
cat("Writing to tikz file\n")
|
43 |
cat("Writing to tikz file\n")
|
| 44 |
tikz(file=file)
|
44 |
tikz(file=file)
|
| 45 |
}
|
45 |
}
|
| 46 |
} else {
|
46 |
} else {
|
| 47 |
|
47 |
|
| 48 |
if(scale){
|
48 |
if(scale){
|
| 49 |
prm$height <- prm$height*2
|
49 |
prm$height <- prm$height*2
|
| 50 |
prm$width <- prm$width*2
|
50 |
prm$width <- prm$width*2
|
| 51 |
}
|
51 |
}
|
| 52 |
## to X. Note that this doesn't work on win and osx.
|
52 |
## to X. Note that this doesn't work on win and osx.
|
| 53 |
X11(height=prm$height,width=prm$width)
|
53 |
X11(height=prm$height,width=prm$width)
|
| 54 |
}
|
54 |
}
|
| 55 |
|
55 |
|
| 56 |
par(mfrow=mfrow)
|
56 |
par(mfrow=mfrow)
|
| 57 |
}
|
57 |
}
|
| 58 |
|
58 |
|
| 59 |
|
59 |
|