/R/painter-utils.R

http://github.com/tengfei/visnab · 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
  18. qglyphArrow <- 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. qpathSector <- function(x,y,length,width,startAngle,sweepLength){
  29. len <- (length+width)*2
  30. r <- length+width
  31. x0 <- x-r
  32. y0 <- y-r
  33. glyph <- Qt$QPainterPath()
  34. movex <- x+r*cos(startAngle/180*pi)
  35. movey <- y+r*sin(startAngle/180*pi)
  36. glyph$moveTo(movex,movey)
  37. glyph$arcTo(x0,y0,len,len,-startAngle,-sweepLength)
  38. r <- r-width
  39. x0 <- x-r
  40. y0 <- y-r
  41. glyph$arcTo(x0,y0,2*r,2*r,-(startAngle+sweepLength),sweepLength)
  42. glyph$closeSubpath()
  43. glyph
  44. }
  45. qpathArc <- function(x,y,r,startAngle,sweepLength){
  46. x0 <- x-r
  47. y0 <- y-r
  48. len <- 2*r
  49. glyph <- Qt$QPainterPath()
  50. movex <- x+r*cos(startAngle/180*pi)
  51. movey <- y+r*sin(startAngle/180*pi)
  52. glyph$moveTo(movex,movey)
  53. glyph$arcTo(x0,y0,len,len,-startAngle,-sweepLength)
  54. glyph
  55. }
  56. qpathQuadCurve <- function(startpoint,controlpoint,endpoint){
  57. glyph <- Qt$QPainterPath()
  58. glyph$moveTo(startpoint[1],startpoint[2])
  59. glyph$quadTo(controlpoint[1],controlpoint[2],endpoint[1],endpoint[2])
  60. glyph
  61. }
  62. qpathCurveBundle <- function(startpoint1,controlpoint1,endpoint1,
  63. startpoint2,controlpoint2,endpoint2){
  64. glyph <- Qt$QPainterPath()
  65. glyph$moveTo(startpoint1[1],startpoint1[2])
  66. glyph$qCuadTo(controlpoint1[1],controlpoint1[2],endpoint1[1],endpoint1[2])
  67. glyph$lineTo(startpoint2[1],startpoint2[2])
  68. glyph$quadTo(controlpoint2[1],controlpoint2[2],endpoint2[1],endpoint2[2])
  69. glyph$lineTo(startpoint1[1],startpoint1[2])
  70. glyph$closeSubpath()
  71. glyph
  72. }
  73. ##----------------------------------------------------------------------
  74. ## own defined palletes
  75. ##----------------------------------------------------------------------
  76. bluered_pal <- function(){
  77. function(x){
  78. x <- cscale(x,rescale_pal())
  79. x <- x-0.5
  80. idx <- x>=0
  81. col.red <- cscale(x[idx],rescale_pal())
  82. col.red <- rgb(col.red,0,0)
  83. col.blue <- cscale(abs(x[!idx]),rescale_pal())
  84. col.blue <- rgb(0,0,col.blue)
  85. col <- vector("numeric",length(x))
  86. col[idx] <- col.red
  87. col[!idx] <- col.blue
  88. col
  89. }
  90. }
  91. blackred_pal <- function(){
  92. function(x){
  93. x <- cscale(x,rescale_pal())
  94. x <- 1-x
  95. col <- rgb(x,0,0)
  96. }
  97. }
  98. ## used for heatmap
  99. div_prox_pal <- function(low = "blue", mid = "white", high = "red",
  100. to = c(0, 1), proxylen = 100){
  101. function(x){
  102. if(length(x)>proxylen)
  103. proxylen <- 100
  104. else
  105. proxylen <- length(x)
  106. vals <- x
  107. to = c(0, 1)
  108. vals <- rescale_mid(vals, to = to, mid = 0)
  109. ## cols <- cscale(vals, div_gradient_pal("blue", "white", "red"))
  110. bks <- seq(0, 1, length = proxylen)
  111. ints <- as.character(cut(vals, bks))
  112. lvs <- as.list(by(vals, ints, mean))
  113. vls <- unname(unlist(lvs))
  114. cols <- cscale(vls, div_gradient_pal(low = low, mid = mid, high = high))
  115. colss <- cols[match(ints, names(lvs))]
  116. }
  117. }