/R/painter-utils.R
R | 125 lines | 95 code | 8 blank | 22 comment | 3 complexity | 1282a1883972bcf93a6f7c57bf102f1f MD5 | raw file
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