--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/R/rdyncall/demo/randomfield2.R	Thu Mar 19 22:26:28 2015 +0100
@@ -0,0 +1,228 @@
+# Package: rdyncall 
+# File: demo/randomfield.R
+# Description: Scientific Computations using OpenGL: Rendering 512x512 random field by blending 5000 point sprites (dynport demo)
+require(rdyncall)
+library(lattice)
+dynport(SDL)
+dynport(GL)
+
+# ----------------------------------------------------------------------------
+# Parameters:
+
+# Framebuffer size
+fb.size <- 512
+
+# Texture size
+tex.size <- 512
+
+# Blending color
+colorunit <- 0.02
+
+# ----------------------------------------------------------------------------
+# 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)
+  
+  glColor3d( colorunit,colorunit,colorunit )
+  
+}
+
+cleanup <- function()
+{
+  glDeleteTextures( length(tex.ids), tex.ids)
+  SDL_Quit()
+}
+
+sim <- function(N = 5000)
+  return(list(
+    x = runif(N,-1.1,+1.1),
+    y = runif(N,-1.1,+1.1),
+    r = runif(N, 0.1, 0.2)
+  ))
+
+render <- function(o) {
+  glClear(GL_COLOR_BUFFER_BIT)
+  drawTexCirclesVertexArray(o$x,o$y,o$r)
+  glFinish()
+  SDL_GL_SwapBuffers()
+}
+  
+event <- new.struct("SDL_Event")
+quit  <- FALSE
+pollEvents <- function() {  
+  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 
+    }
+  }    
+}
+
+# --- Read Pixels ------------------------------------------------------------
+
+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)
+}
+
+ 
+# --- FPS Counter ------------------------------------------------------------
+ 
+fpsInit <- function() 
+  return(list(
+    tbase = SDL_GetTicks(),
+    frames = 0
+  ))
+
+fpsUpdate <- function(o) {
+  tnow <- SDL_GetTicks()  
+  if ((tnow - o$tbase) > 1000)
+  {
+    o$tbase <- tnow
+    SDL_WM_SetCaption(paste("FPS:", o$frames),NULL)
+    o$frames <- 0
+  } else {
+    o$frames <- o$frames + 1
+  }
+  return(o)
+}
+
+# --- Main Loop --------------------------------------------------------------
+
+main <- function()
+{
+  init()
+  # disable interactive plot device.      
+  oldpars <- par(ask=FALSE,mfrow=c(1,1))
+  # user notice
+  cat("Click on window to import current random field and plot in R.\nClose window to quit mainloop.\n")
+  
+  fps <- fpsInit()
+  quit <<- FALSE
+  while(!quit) 
+  {
+    sim <- sim(5000) 
+    render(sim)
+    pollEvents()
+    fps <- fpsUpdate(fps)
+  }
+
+  par(oldpars)
+}
+
+main()
+