Nothing
# Package: rdyncall
# File: demo/randomfield.R
# Description: Scientific Computations using OpenGL: Rendering 512x512 random field by blending 5000 point sprites (dynport demo)
dynport(SDL)
dynport(GL)
# ----------------------------------------------------------------------------
# Parameters:
# framebuffer size
fb.size <- 512
# texture size
tex.size <- 512
# ----------------------------------------------------------------------------
# texture setup
genTex.circle <- function(n)
{
m <- matrix(data=FALSE,nr=n,nc=n)
r <- n/2
for(i in 1:n)
{
for(j in 1:n)
{
m[[i,j]] <- ifelse((i-r)^2+(j-r)^2 > r^2,0L,255L)
}
}
return(m)
}
genTex.bnorm <- function(n)
{
x <- seq(-3,3,len=n)
y <- dnorm(x)
return( outer(y,y) )
}
# ----------------------------------------------------------------------------
# draw circle using OpenGL Vertex Arrays
drawTexCirclesVertexArray <- function(x,y,r)
{
n <- max( length(x), length(y), length(r) )
x1 <- x-r
x2 <- x+r
y1 <- y-r
y2 <- y+r
vertexArray <- as.vector(rbind(x1,y1,x2, y1, x2, y2, x1, y2))
texCoordArray <- rep( as.double(c(0,0,1,0,1,1,0,1)), n )
glEnableClientState(GL_VERTEX_ARRAY)
glEnableClientState(GL_TEXTURE_COORD_ARRAY)
glVertexPointer(2,GL_DOUBLE,0,vertexArray)
glTexCoordPointer(2,GL_DOUBLE,0,texCoordArray)
glDrawArrays(GL_QUADS, 0, n*4)
glDisableClientState(GL_VERTEX_ARRAY)
glDisableClientState(GL_TEXTURE_COORD_ARRAY)
}
#drawPointSprite <- function()
#{
# glEnable(GL_POINT_SPRITE)
# glTexEnvi(GL_POINT_SPRITE,GL_COORD_REPLACE,GL_TRUE)
# glPointParameter(GL_POINT_SPRITE_COORD_ORIGIN, GL_LOWER_LEFT)
# glPointSize
#}
# ----------------------------------------------------------------------------
# initialize SDL, OpenGL
max.tex.size <- integer(1)
max.tex.units <- integer(1)
tex.ids <- integer(1)
init <- function()
{
# initialize SDL
SDL_Init(SDL_INIT_VIDEO)
surface <<- SDL_SetVideoMode(fb.size,fb.size,32,SDL_OPENGL+SDL_DOUBLEBUF)
# initialize OpenGL
glGetIntegerv(GL_MAX_TEXTURE_SIZE, max.tex.size)
glGetIntegerv(GL_MAX_TEXTURE_UNITS, max.tex.units)
glClearColor(0,0,0,0)
glColor4f(0.1,0.1,0.1,0)
# img <- genTex.circle(tex.size)
# texdata <- as.raw(img)
img <- genTex.bnorm(tex.size)
m <- max(img)
texdata <- as.raw( ( img/m ) * 255 )
glGenTextures( length(tex.ids),tex.ids)
glBindTexture(GL_TEXTURE_2D, tex.ids[[1]])
glPixelStorei(GL_UNPACK_ALIGNMENT, 1)
glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, tex.size, tex.size, 0, GL_ALPHA, GL_UNSIGNED_BYTE, texdata)
# glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, tex.size, tex.size, 0, GL_ALPHA, GL_DOUBLE, as.vector(img))
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S,GL_CLAMP_TO_BORDER)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T,GL_CLAMP_TO_BORDER)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST)
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE)
glEnable(GL_TEXTURE_2D)
# blending setup
glBlendFunc(GL_SRC_ALPHA, GL_ONE)
glEnable(GL_BLEND)
}
cleanup <- function()
{
glDeleteTextures( length(tex.ids), tex.ids)
SDL_Quit()
}
pixels <- NULL
main <- function()
{
cat("Click on window to import current random field and plot in R.\nClose window to quit mainloop.\n")
N <- 5000
colorunit <- 0.02
glColor3d( colorunit,colorunit,colorunit )
tbase <- SDL_GetTicks()
frames <- 0
x <- runif(N,-1.1,1.1)
y <- runif(N,-1.1,1.1)
r <- runif(N,0.1,0.2)
event <- new.struct("SDL_Event")
# disable interactive plot device.
oldpars <- par(ask=FALSE,mfrow=c(1,1))
quit <- FALSE
while(!quit)
{
glClear(GL_COLOR_BUFFER_BIT)
drawTexCirclesVertexArray(x,y,r)
x <- runif(N,-1.1,1.1)
y <- runif(N,-1.1,1.1)
r <- runif(N,0.1,0.2)
glFinish()
SDL_GL_SwapBuffers()
tnow <- SDL_GetTicks()
if ((tnow - tbase) > 1000)
{
tbase <- tnow
SDL_WM_SetCaption(paste("FPS:", frames),NULL)
frames <- 0
}
while( SDL_PollEvent(event) != 0 )
{
type <- event$type
if (type == SDL_MOUSEBUTTONDOWN) {
cat("Read pixels via OpenGL into an R integer matrix..")
pixels <<- readpixels()
cat("done.\nPlot image results with R plotting device. This may take a while - please be patient..")
image(pixels)
cat("done.\nContinue..\n")
} else if (type == SDL_QUIT) {
cat("Read pixels via OpenGL into an R integer matrix 'pixels'..")
pixels <<- readpixels()
cat("done.\nRe-run by 'run()'\n")
quit <- TRUE
}
}
frames <- frames + 1
}
par(oldpars)
}
readpixels <- function()
{
array <- matrix(NA_integer_,fb.size,fb.size)
glPixelStorei(GL_PACK_ALIGNMENT,1)
glReadPixels(0,0,fb.size,fb.size, GL_LUMINANCE, GL_INT, array)
return(array)
}
run <- function()
{
init()
main()
}
run()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.