Subversion Repositories bdplot

Rev

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

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