Subversion Repositories bdplot

Rev

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

Rev 51 Rev 53
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
  print(prm$height)
12
    print(prm$height)
12
  if( !is.na(file) )
13
  if( !is.na(file) )
13
    {
14
    {
14
      ## If figdir is supplied, prepending it to filename.
15
      ## If figdir is supplied, prepending it to filename.
15
      if(!is.null(prm$figdir)&!is.na(prm$figdir))
16
      if(!is.null(prm$figdir)&!is.na(prm$figdir))
16
        {
17
        {
17
          file <- paste(prm$figdir,file,sep="/")
18
          file <- paste(prm$figdir,file,sep="/")
18
        }
19
        }
19
      ## determining device driver from filename
20
      ## determining device driver from filename
20
      nchars <- nchar(file)
21
      nchars <- nchar(file)
21
 
22
 
22
      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")){
23
        m <- {
24
        m <- {
24
          cat("B/D plotting writing to postscript file\n")
25
          cat("B/D plotting writing to postscript file\n")
25
          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)
26
        }
27
        }
27
      } else if ( substr(file,nchars-3,nchars)==".pdf")
28
      } else if ( substr(file,nchars-3,nchars)==".pdf")
28
        {
29
        {
29
          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")
30
        } 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")) {
31
          cat("Writing to jpeg file\n")
32
          cat("Writing to jpeg file\n")
32
          if(is.null(quality))
33
          if(is.null(quality))
33
            quality=prm$jpeg.quality
34
            quality=prm$jpeg.quality
34
          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")
35
### 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)
36
        }
37
        }
37
    }
38
    }
38
  else {
39
  else {
39
 
40
 
40
    if(scale){
41
    if(scale){
41
      prm$height <- prm$height*2
42
      prm$height <- prm$height*2
42
      prm$width <- prm$width*2
43
      prm$width <- prm$width*2
43
    }
44
    }
44
    ## to X. Note that this doesn't work on win and osx.
45
    ## to X. Note that this doesn't work on win and osx.
45
    X11(height=prm$height,width=prm$width)
46
    X11(height=prm$height,width=prm$width)
46
  }
47
  }
47
 
48
 
48
  par(mfrow=mfrow)
49
  par(mfrow=mfrow)
49
}
50
}
50
 
51
 
51
 
52