Subversion Repositories bdplot

Rev

Rev 53 | Rev 66 | Go to most recent revision | Only display areas with differences | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 53 Rev 61
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)
7
bdopen <- function(file=bdp()$file,paper=bdp()$paper,mfrow=bdp()$mfrow,scale=TRUE,quality=NULL,scaleheight=1)
8
{
8
{
9
  .bdcalcsizes(paper=paper,mfrow=mfrow,scaleheight=scaleheight)
9
  .bdcalcsizes(paper=paper,mfrow=mfrow,scaleheight=scaleheight)
10
  prm <- .bdgetpars()
10
  prm <- .bdgetpars()
11
  if(prm$debug)
11
  if(prm$debug)
12
    print(prm$height)
12
    print(prm$height)
13
  if( !is.na(file) )
13
  if( !is.na(file) )
14
    {
14
    {
15
      ## If figdir is supplied, prepending it to filename.
15
      ## If figdir is supplied, prepending it to filename.
16
      if(!is.null(prm$figdir)&!is.na(prm$figdir))
16
      if(!is.null(prm$figdir)&!is.na(prm$figdir))
17
        {
17
        {
18
          file <- paste(prm$figdir,file,sep="/")
18
          file <- paste(prm$figdir,file,sep="/")
19
        }
19
        }
20
      ## determining device driver from filename
20
      ## determining device driver from filename
21
      nchars <- nchar(file)
21
      nchars <- nchar(file)
22
 
-
 
-
 
22
##### should switch be used here?
23
      if( any( substr(file,nchars-2,nchars)==".ps",substr(file,nchars-3,nchars)==".eps")){
23
      if( any( substr(file,nchars-2,nchars)==".ps",substr(file,nchars-3,nchars)==".eps")){
24
        m <- {
24
        m <- {
25
          cat("B/D plotting writing to postscript file\n")
25
          cat("B/D plotting writing to postscript file\n")
26
          postscript(file=file, width=prm$width, height=prm$height, paper="special", family = "Helvetica", horizontal=FALSE)
26
          postscript(file=file, width=prm$width, height=prm$height, paper="special", family = "Helvetica", horizontal=FALSE)
27
        }
27
        }
28
      } else if ( substr(file,nchars-3,nchars)==".pdf")
28
      } else if ( substr(file,nchars-3,nchars)==".pdf")
29
        {
29
        {
30
          pdf(file=file, width=prm$width, height=prm$height, paper="special",family = "Helvetica")
30
          pdf(file=file, width=prm$width, height=prm$height, paper="special",family = "Helvetica")
31
        } else if (any(substr(file,nchars-3,nchars)==".jpg", substr(file,nchars-4,nchars)==".jpeg")) {
31
        } else if (any(substr(file,nchars-3,nchars)==".jpg", substr(file,nchars-4,nchars)==".jpeg")) {
32
          cat("Writing to jpeg file\n")
32
          cat("Writing to jpeg file\n")
33
          if(is.null(quality))
33
          if(is.null(quality))
34
            quality=prm$jpeg.quality
34
            quality=prm$jpeg.quality
35
          jpeg(filename=file,width=prm$width,height=prm$height,units=prm$size.unit,quality=quality,res=prm$jpeg.res,type="cairo")
35
          jpeg(filename=file,width=prm$width,height=prm$height,units=prm$size.unit,quality=quality,res=prm$jpeg.res,type="cairo")
36
### bitmap(file=file,type="jpeg",width=prm$width,height=prm$height,units=prm$size.unit,res=prm$jpeg.res,pointsize=.3)
36
### bitmap(file=file,type="jpeg",width=prm$width,height=prm$height,units=prm$size.unit,res=prm$jpeg.res,pointsize=.3)
-
 
37
        } else if ( substr(file,nchars-3,nchars)==".tex"){
-
 
38
          require(tikzDevice)
-
 
39
          cat("Writing to tikz file\n")
-
 
40
          tikz(file=file)
37
        }
41
        }
38
    }
-
 
39
  else {
42
    } else {
40
 
43
 
41
    if(scale){
44
    if(scale){
42
      prm$height <- prm$height*2
45
      prm$height <- prm$height*2
43
      prm$width <- prm$width*2
46
      prm$width <- prm$width*2
44
    }
47
    }
45
    ## to X. Note that this doesn't work on win and osx.
48
    ## to X. Note that this doesn't work on win and osx.
46
    X11(height=prm$height,width=prm$width)
49
    X11(height=prm$height,width=prm$width)
47
  }
50
  }
48
 
51
 
49
  par(mfrow=mfrow)
52
  par(mfrow=mfrow)
50
}
53
}
51
 
54
 
52
 
55