Subversion Repositories bdplot

Rev

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

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