Subversion Repositories bdplot

Rev

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

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