Subversion Repositories bdplot

Rev

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

Rev 7 Rev 11
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 both jpeg and X11,  height  and width are scaled to
4
### In both jpeg and X11,  height  and width are scaled to
5
### jpeg: get a decent resolution (can't get it working with the true distances...)
5
### jpeg: get a decent resolution (can't get it working with the true distances...)
6
### X11: to get a nicer window on the screen.
6
### X11: to get a nicer window on the screen.
7
### This hack is ugly. At least there should be a scaling factor in stead so that all measures are scaled (fonts, etc).
7
### This hack is ugly. At least there should be a scaling factor in stead so that all measures are scaled (fonts, etc).
8
 
8
 
9
bdopen <- function(file=bdp()$file,paper=bdp()$paper,mfrow=bdp()$mfrow)
9
bdopen <- function(file=bdp()$file,paper=bdp()$paper,mfrow=bdp()$mfrow)
10
{
10
{
11
  .bdcalcsizes(paper=paper)
11
  .bdcalcsizes(paper=paper)
12
  prm <- .bdgetpars()
12
  prm <- .bdgetpars()
13
  if( !is.na(prm$file) )
13
  if( !is.na(prm$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
          prm$file <- paste(prm$figdir,prm$file,sep="")
18
          prm$file <- paste(prm$figdir,prm$file,sep="")
19
        }
19
        }
20
      ## determining device driver from filename
20
      ## determining device driver from filename
21
      nchars <- nchar(prm$file)
21
      nchars <- nchar(prm$file)
22
 
22
 
23
      if( any( substr(prm$file,nchars-2,nchars)==".ps",substr(prm$file,nchars-3,nchars)==".eps")){
23
      if( any( substr(prm$file,nchars-2,nchars)==".ps",substr(prm$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=prm$file, width=prm$width, height=prm$height, paper="special", horizontal=FALSE, family = "Helvetica")
26
          postscript(file=prm$file, width=prm$width, height=prm$height, paper="special", family = "Helvetica", horizontal=FALSE)
27
        }
27
        }
28
      } else if ( substr(prm$file,nchars-3,nchars)==".pdf")
28
      } else if ( substr(prm$file,nchars-3,nchars)==".pdf")
29
        {
29
        {
30
          pdf(file=prm$file, width=prm$width, height=prm$height)
30
          pdf(file=prm$file, width=prm$width, height=prm$height, paper="special",family = "Helvetica")
31
        } else if (any(substr(prm$file,nchars-3,nchars)==".jpg", substr(prm$file,nchars-4,nchars)==".jpeg")) {
31
        } else if (any(substr(prm$file,nchars-3,nchars)==".jpg", substr(prm$file,nchars-4,nchars)==".jpeg")) {
32
          cat("Writing to jpeg file\n")
32
          cat("Writing to jpeg file\n")
33
          jpeg(filename=prm$file,width=prm$width*2,height=prm$height*2,units=prm$size.unit,quality=prm$jpeg.quality,res=prm$jpeg.res,type="cairo")
33
          jpeg(filename=prm$file,width=prm$width,height=prm$height,units=prm$size.unit,quality=prm$jpeg.quality,res=prm$jpeg.res,type="cairo")
34
##          bitmap(file=prm$file,type="jpeg",width=prm$width,height=prm$height,units=prm$size.unit,res=prm$jpeg.res,pointsize=.3)
34
### bitmap(file=prm$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
    ## to X. Note that this doesn't work on win and osx.
38
    ## to X. Note that this doesn't work on win and osx.
39
    X11(height=prm$height*2,width=prm$width*2)
39
    X11(height=prm$height*2,width=prm$width*2)
40
    }
40
    }
41
 
41
 
42
  par(mfrow=mfrow)
42
  par(mfrow=mfrow)
43
 }
43
 }
44
 
44