--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/R/rdyncall/demo/randomfield.R	Thu Mar 19 22:26:28 2015 +0100
@@ -0,0 +1,201 @@
+# 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()