library(grid)
library(RColorBrewer)
library(scatterplot3d)

# Rotate a matrix 90deg clockwise
rot90 <- function(mat) t(mat[nrow(mat):1,])

# Rotate a matrix 90deg counterclockwise
rotn90 <- function(mat) t(mat[,ncol(mat):1])

# Arbitrary rotation of a matrix in either direction
# mat - matrix to rotate
# deg - A positive deg rotates clockwise, negative counterclockwise
#
# returns the rotated matrix
mat.rot <- function(mat,deg){
        # the modulus %% operator does the right thing with negative degrees
        # thus -90 %% 360 == 270
        ndeg = deg %% 360
        if (ndeg==90)
                return(rot90(mat))
        if (ndeg==180)
                return(rot90(rot90(mat)))
        if (ndeg==270)
                return(rotn90(mat))
        mat
}

# Function for linearly interpolating a matrix in the x (row) dimension
# mat - the matrix to interpolate
# ixdim - the dimension
#
# returns interpolated matrix in x dimension
mat.interp.x <- function(mat,ixdim){
        xdim <- dim(mat)[1]
        ydim <- dim(mat)[2]

        if (!is.na(ixdim) && (ixdim-xdim)>0){
                z <- matrix(nrow=ixdim,ncol=ydim)
                for (i in 1:ydim){
                        z[,i] <- approx(1:xdim,mat[,i],n=ixdim)$y
                }
                return(z)
        }
        mat
}
# Function for interpolating a matrix in the x (row) or y (col) dimension
# mat - the matrix to interpolate
# ix - the x dimension to grow to. If set to NA, then keep same x dimension
# iy - the y dimension to grow to. If set to NA, then keep same y dimension
#
# returns interpolated matrix
mat.interp <- function(mat,ix,iy){
        mdim <- dim(mat)

        # try and interpolate in x direction
        if (!is.na(ix)){
                if ((ix-mdim[1])<=0){
                        warning(sprintf("x dimension is too small: %d<=%d",mdim[1],ix))
                        return(mat)
                }
                newmat <- mat.interp.x(mat,ix)
                mdim <- dim(mat)
        } else {
                newmat <- mat
        }

        if (!is.na(iy)){
                if ((iy-mdim[2])<=0){
                        warning(sprintf("y dimension is too small: %d<=%d",mdim[2],iy))
                        return(mat)
                }
                newmat <- mat.rot(mat.interp.x(mat.rot(newmat,90),iy),-90)
        }
        newmat
}

plotcol2d <- function(cols){
        x <- 1:255
        y <- 1:length(cols)


        pushViewport(plotViewport(c(5.1,4.1,4.1,2.1)))
        pushViewport(dataViewport(x,y))
        grid.rect()
        grid.yaxis(y,label=cols,gp=gpar(fontsize=6))
        grid.xaxis()
        red = col2rgb(cols)[1,]
        green = col2rgb(cols)[2,]
        blue = col2rgb(cols)[3,]
        for (i in y){
                grid.lines(c(0,255),i,default.units="native",gp=gpar(col=cols[i],lwd=20),draw=TRUE)
        }
        grid.points(red,y,pch=16,gp=gpar(col="red"),draw=TRUE)
        grid.points(green,y,pch=16,gp=gpar(col="green"),draw=TRUE)
        grid.points(blue,y,pch=16,gp=gpar(col="blue"),draw=TRUE)
        popViewport(2)
}

# Extends the range of colors in cols by linearly interpolating the red, green, and
# blue components.
extend.colrange <- function (cols,n){
        c <- floor(mat.interp(col2rgb(cols),NA,n))
        rgb(c[1,],c[2,],c[3,],max=255)
}

# Apply a function over cols
# for instance "fun=function(x) length(x)/log(length(x)) * log(x)"
scale.cols <- function(cols,fun=function(x){x}){
        x <- 1:length(cols)
        y <- ceiling(fun(x))

        for (i in x){
                if (is.na(y[i])) y[i] <- 1
                if (y[i] < 1) y[i] <- 1
                if (y[i] > length(y)) y[i] <- length(y)
        }

        cols[y]
}

# From scatterplot3d() R help file
cubedraw <- function(res3d, min = 0, max = 255, cex = 2, text. = FALSE) {
  ## Purpose: Draw nice cube with corners
  cube01 <- rbind(c(0,0,1), 0, c(1,0,0), c(1,1,0), 1, c(0,1,1), # < 6 outer
      c(1,0,1), c(0,1,0)) # <- "inner": fore- & back-ground
  cub <- min + (max-min)* cube01
  ## visibile corners + lines:
  res3d$points3d(cub[c(1:6,1,7,3,7,5) ,], cex = cex, type = 'b', lty = 1)
  ## hidden corner + lines
  res3d$points3d(cub[c(2,8,4,8,6),     ], cex = cex, type = 'b', lty = 3)
  if(text.)## debug
      text(res3d$xyz.convert(cub), labels=1:nrow(cub), col='tomato', cex=2)
}

plotcol3d <- function(cols,angle=1){
    cm <- t(col2rgb(cols))
    p <- scatterplot3d(cm,color=cols, box = FALSE, angle = angle,
            xlim = c(-50, 300), ylim = c(-50, 300), zlim = c(-50, 300))
    p$points3d(cm,col=cols,pch=16)
    cubedraw(p)
}

mov.plotcol3d <- function(cols,dir){
    for (i in 1:180){
        file <- sprintf('%s/plotcol3d%03d.png',dir,i)
        png(filename=file)
        plotcol3d(cols,i)
        dev.off()
    }
}

make.mov.plotcol3d <- function(){
    unlink("plotcol3d.mpg")
    system("convert -delay 10 plotcol3d*.png plotcol3d.mpg")
}