1##==============================================================================
2##
3## Spheres/Cylindres/Ellipses/Arrows
4##    Karline Soetaert
5##
6##==============================================================================
7
8##==============================================================================
9## INTERNAL FUNCTION
10##==============================================================================
11
12val2col <- function (values,zlim,col)  {
13
14  if (! is.null(values)) {  # a matrix of radius, z-values
15
16    if (min(values[,1])<0)
17      stop ("cannot draw shape: radiusses in first column of *values* are not positive")
18    values <- values [sort(values[,1],index=TRUE)$ix,]   # sort on first column (radiusses)
19
20    if (is.null(zlim)) {
21      zlim<-range(values[,2])
22    } else {
23      values[,2]<-pmin(values[,2],zlim[2])
24      values[,2]<-pmax(values[,2],zlim[1])
25    }
26
27    x.to   <- (values[,2]-zlim[1])/(diff(zlim))
28    Col    <- intpalette (inputcol=col,x.to = x.to)
29    nrad   <- nrow(values)
30    values[,1] <- values[,1]/values[nrad,1]
31    intrad <- c(0,values[,1])
32  } else {
33    Col <- col
34    nrad <- length(Col)
35    intrad <- c(0, 1:nrad)/nrad
36
37    ncol <- length(col)
38    if (ncol < nrad)
39      Col <- intpalette(col, nrad)
40  }
41  return(list(Col=Col,intrad=intrad,nrad=nrad))
42}
43