/R/painter-utils.R

  1##----------------------------------------------------------------------
  2##  These utils should be moved to qtpaint later
  3##----------------------------------------------------------------------
  4##' .. content for \description{} (no empty lines) ..
  5##'
  6##' .. content for \details{} ..
  7##' @title 
  8##' @param x Size of the arrow
  9##' @param direction Direction of the arrow
 10##' @examples scene <- qscene()
 11##' layer <- qlayer(scene, function(layer, painter){
 12##' arr <- qglyphArrow()
 13##' qdrawGlyph(painter, arr, 1:10, 10)
 14##' }, limits = qrect(c(0, 15),c(0,20)))
 15##' qplotView(scene)$show()
 16##' @return A \code{QPainterPath} object
 17##' @author tengfei
 18qglyphArrow <- function(x = 5, direction = c("left", "right")){
 19  dirs <- match.arg(direction)
 20  if(direction == "right")
 21    x = -x
 22  glyph <- Qt$QPainterPath()
 23  glyph$moveTo(x,x)
 24  glyph$lineTo(0,0)
 25  glyph$lineTo(x,-x)
 26  glyph
 27}
 28
 29qpathSector <- function(x,y,length,width,startAngle,sweepLength){
 30  len <- (length+width)*2
 31  r <- length+width
 32  x0 <- x-r
 33  y0 <- y-r
 34  glyph <- Qt$QPainterPath()
 35  movex <- x+r*cos(startAngle/180*pi)
 36  movey <- y+r*sin(startAngle/180*pi)
 37  glyph$moveTo(movex,movey)
 38  glyph$arcTo(x0,y0,len,len,-startAngle,-sweepLength)
 39  r <- r-width
 40  x0 <- x-r
 41  y0 <- y-r
 42  glyph$arcTo(x0,y0,2*r,2*r,-(startAngle+sweepLength),sweepLength)
 43  glyph$closeSubpath()
 44  glyph
 45}
 46
 47qpathArc <- function(x,y,r,startAngle,sweepLength){
 48  x0 <- x-r
 49  y0 <- y-r
 50  len <- 2*r
 51  glyph <- Qt$QPainterPath()
 52  movex <- x+r*cos(startAngle/180*pi)
 53  movey <- y+r*sin(startAngle/180*pi)
 54  glyph$moveTo(movex,movey)
 55  glyph$arcTo(x0,y0,len,len,-startAngle,-sweepLength)
 56  glyph
 57}
 58
 59qpathQuadCurve <- function(startpoint,controlpoint,endpoint){
 60  glyph <- Qt$QPainterPath()
 61  glyph$moveTo(startpoint[1],startpoint[2])
 62  glyph$quadTo(controlpoint[1],controlpoint[2],endpoint[1],endpoint[2])
 63  glyph
 64}
 65
 66qpathCurveBundle <- function(startpoint1,controlpoint1,endpoint1,
 67                              startpoint2,controlpoint2,endpoint2){
 68  glyph <- Qt$QPainterPath()
 69  glyph$moveTo(startpoint1[1],startpoint1[2])
 70  glyph$qCuadTo(controlpoint1[1],controlpoint1[2],endpoint1[1],endpoint1[2])
 71  glyph$lineTo(startpoint2[1],startpoint2[2])
 72  glyph$quadTo(controlpoint2[1],controlpoint2[2],endpoint2[1],endpoint2[2])
 73  glyph$lineTo(startpoint1[1],startpoint1[2])
 74  glyph$closeSubpath()
 75  glyph
 76}
 77
 78##----------------------------------------------------------------------
 79##  own defined palletes
 80##----------------------------------------------------------------------
 81bluered_pal <- function(){
 82  function(x){
 83    x <- cscale(x,rescale_pal())
 84    x <- x-0.5
 85    idx <- x>=0
 86    col.red <- cscale(x[idx],rescale_pal())
 87    col.red <- rgb(col.red,0,0)
 88    col.blue <- cscale(abs(x[!idx]),rescale_pal())
 89    col.blue <- rgb(0,0,col.blue)
 90    col <- vector("numeric",length(x))
 91    col[idx] <- col.red
 92    col[!idx] <- col.blue
 93    col
 94  }
 95}
 96
 97blackred_pal <- function(){
 98  function(x){
 99    x <- cscale(x,rescale_pal())
100    x <- 1-x
101    col <- rgb(x,0,0)
102  }
103}
104## used for heatmap
105
106div_prox_pal <- function(low = "blue", mid = "white", high = "red",
107                    to = c(0, 1), proxylen = 100){
108  function(x){
109    if(length(x)>proxylen)
110      proxylen <- 100
111    else
112      proxylen <- length(x)
113    vals <- x
114    to = c(0, 1)
115    vals <- rescale_mid(vals, to = to, mid = 0)
116    ## cols <- cscale(vals, div_gradient_pal("blue", "white", "red"))
117    bks <- seq(0, 1, length = proxylen)
118    ints <- as.character(cut(vals, bks))
119    lvs <- as.list(by(vals, ints, mean))
120    vls <- unname(unlist(lvs))
121    cols <- cscale(vls, div_gradient_pal(low = low, mid = mid, high = high))
122    colss <- cols[match(ints, names(lvs))]
123  }
124}
125