|
0
|
1 # Package: rdyncall
|
|
|
2 # File: demo/randomfield.R
|
|
|
3 # Description: Scientific Computations using OpenGL: Rendering 512x512 random field by blending 5000 point sprites (dynport demo)
|
|
|
4 require(rdyncall)
|
|
|
5 library(lattice)
|
|
|
6 dynport(SDL)
|
|
|
7 dynport(GL)
|
|
|
8
|
|
|
9 # ----------------------------------------------------------------------------
|
|
|
10 # Parameters:
|
|
|
11
|
|
|
12 # Framebuffer size
|
|
|
13 fb.size <- 512
|
|
|
14
|
|
|
15 # Texture size
|
|
|
16 tex.size <- 512
|
|
|
17
|
|
|
18 # Blending color
|
|
|
19 colorunit <- 0.02
|
|
|
20
|
|
|
21 # ----------------------------------------------------------------------------
|
|
|
22 # texture setup
|
|
|
23
|
|
|
24 genTex.circle <- function(n)
|
|
|
25 {
|
|
|
26 m <- matrix(data=FALSE,nr=n,nc=n)
|
|
|
27 r <- n/2
|
|
|
28 for(i in 1:n)
|
|
|
29 {
|
|
|
30 for(j in 1:n)
|
|
|
31 {
|
|
|
32 m[[i,j]] <- ifelse((i-r)^2+(j-r)^2 > r^2,0L,255L)
|
|
|
33 }
|
|
|
34 }
|
|
|
35 return(m)
|
|
|
36 }
|
|
|
37
|
|
|
38 genTex.bnorm <- function(n)
|
|
|
39 {
|
|
|
40 x <- seq(-3,3,len=n)
|
|
|
41 y <- dnorm(x)
|
|
|
42 return( outer(y,y) )
|
|
|
43 }
|
|
|
44
|
|
|
45 # ----------------------------------------------------------------------------
|
|
|
46 # draw circle using OpenGL Vertex Arrays
|
|
|
47
|
|
|
48 drawTexCirclesVertexArray <- function(x,y,r)
|
|
|
49 {
|
|
|
50 n <- max( length(x), length(y), length(r) )
|
|
|
51 x1 <- x-r
|
|
|
52 x2 <- x+r
|
|
|
53 y1 <- y-r
|
|
|
54 y2 <- y+r
|
|
|
55
|
|
|
56 vertexArray <- as.vector(rbind(x1,y1,x2, y1, x2, y2, x1, y2))
|
|
|
57 texCoordArray <- rep( as.double(c(0,0,1,0,1,1,0,1)), n )
|
|
|
58
|
|
|
59 glEnableClientState(GL_VERTEX_ARRAY)
|
|
|
60 glEnableClientState(GL_TEXTURE_COORD_ARRAY)
|
|
|
61 glVertexPointer(2,GL_DOUBLE,0,vertexArray)
|
|
|
62 glTexCoordPointer(2,GL_DOUBLE,0,texCoordArray)
|
|
|
63
|
|
|
64 glDrawArrays(GL_QUADS, 0, n*4)
|
|
|
65
|
|
|
66 glDisableClientState(GL_VERTEX_ARRAY)
|
|
|
67 glDisableClientState(GL_TEXTURE_COORD_ARRAY)
|
|
|
68 }
|
|
|
69
|
|
|
70 #drawPointSprite <- function()
|
|
|
71 #{
|
|
|
72 # glEnable(GL_POINT_SPRITE)
|
|
|
73 # glTexEnvi(GL_POINT_SPRITE,GL_COORD_REPLACE,GL_TRUE)
|
|
|
74 # glPointParameter(GL_POINT_SPRITE_COORD_ORIGIN, GL_LOWER_LEFT)
|
|
|
75 # glPointSize
|
|
|
76 #}
|
|
|
77
|
|
|
78 # ----------------------------------------------------------------------------
|
|
|
79 # initialize SDL, OpenGL
|
|
|
80
|
|
|
81 max.tex.size <- integer(1)
|
|
|
82 max.tex.units <- integer(1)
|
|
|
83 tex.ids <- integer(1)
|
|
|
84
|
|
|
85 init <- function()
|
|
|
86 {
|
|
|
87 # initialize SDL
|
|
|
88
|
|
|
89 SDL_Init(SDL_INIT_VIDEO)
|
|
|
90 surface <<- SDL_SetVideoMode(fb.size,fb.size,32,SDL_OPENGL+SDL_DOUBLEBUF)
|
|
|
91
|
|
|
92 # initialize OpenGL
|
|
|
93
|
|
|
94 glGetIntegerv(GL_MAX_TEXTURE_SIZE, max.tex.size)
|
|
|
95 glGetIntegerv(GL_MAX_TEXTURE_UNITS, max.tex.units)
|
|
|
96
|
|
|
97 glClearColor(0,0,0,0)
|
|
|
98 glColor4f(0.1,0.1,0.1,0)
|
|
|
99
|
|
|
100 # img <- genTex.circle(tex.size)
|
|
|
101 # texdata <- as.raw(img)
|
|
|
102
|
|
|
103 img <- genTex.bnorm(tex.size)
|
|
|
104 m <- max(img)
|
|
|
105 texdata <- as.raw( ( img/m ) * 255 )
|
|
|
106
|
|
|
107
|
|
|
108 glGenTextures( length(tex.ids),tex.ids)
|
|
|
109 glBindTexture(GL_TEXTURE_2D, tex.ids[[1]])
|
|
|
110 glPixelStorei(GL_UNPACK_ALIGNMENT, 1)
|
|
|
111 glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, tex.size, tex.size, 0, GL_ALPHA, GL_UNSIGNED_BYTE, texdata)
|
|
|
112 # glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, tex.size, tex.size, 0, GL_ALPHA, GL_DOUBLE, as.vector(img))
|
|
|
113
|
|
|
114 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S,GL_CLAMP_TO_BORDER)
|
|
|
115 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T,GL_CLAMP_TO_BORDER)
|
|
|
116 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST)
|
|
|
117 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST)
|
|
|
118
|
|
|
119 glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE)
|
|
|
120 glEnable(GL_TEXTURE_2D)
|
|
|
121
|
|
|
122 # blending setup
|
|
|
123
|
|
|
124 glBlendFunc(GL_SRC_ALPHA, GL_ONE)
|
|
|
125 glEnable(GL_BLEND)
|
|
|
126
|
|
|
127 glColor3d( colorunit,colorunit,colorunit )
|
|
|
128
|
|
|
129 }
|
|
|
130
|
|
|
131 cleanup <- function()
|
|
|
132 {
|
|
|
133 glDeleteTextures( length(tex.ids), tex.ids)
|
|
|
134 SDL_Quit()
|
|
|
135 }
|
|
|
136
|
|
|
137 sim <- function(N = 5000)
|
|
|
138 return(list(
|
|
|
139 x = runif(N,-1.1,+1.1),
|
|
|
140 y = runif(N,-1.1,+1.1),
|
|
|
141 r = runif(N, 0.1, 0.2)
|
|
|
142 ))
|
|
|
143
|
|
|
144 render <- function(o) {
|
|
|
145 glClear(GL_COLOR_BUFFER_BIT)
|
|
|
146 drawTexCirclesVertexArray(o$x,o$y,o$r)
|
|
|
147 glFinish()
|
|
|
148 SDL_GL_SwapBuffers()
|
|
|
149 }
|
|
|
150
|
|
|
151 event <- new.struct("SDL_Event")
|
|
|
152 quit <- FALSE
|
|
|
153 pollEvents <- function() {
|
|
|
154 while( SDL_PollEvent(event) != 0 )
|
|
|
155 {
|
|
|
156 type <- event$type
|
|
|
157 if (type == SDL_MOUSEBUTTONDOWN) {
|
|
|
158 cat("Read pixels via OpenGL into an R integer matrix..")
|
|
|
159 pixels <<- readpixels()
|
|
|
160 cat("done.\nPlot image results with R plotting device. This may take a while - please be patient..")
|
|
|
161 image(pixels)
|
|
|
162 cat("done.\nContinue..\n")
|
|
|
163 } else if (type == SDL_QUIT) {
|
|
|
164 cat("Read pixels via OpenGL into an R integer matrix 'pixels'..")
|
|
|
165 pixels <<- readpixels()
|
|
|
166 cat("done.\nRe-run by 'run()'\n")
|
|
|
167 quit <<- TRUE
|
|
|
168 }
|
|
|
169 }
|
|
|
170 }
|
|
|
171
|
|
|
172 # --- Read Pixels ------------------------------------------------------------
|
|
|
173
|
|
|
174 readpixels <- function()
|
|
|
175 {
|
|
|
176 array <- matrix(NA_integer_,fb.size,fb.size)
|
|
|
177 glPixelStorei(GL_PACK_ALIGNMENT,1)
|
|
|
178 glReadPixels(0,0,fb.size,fb.size, GL_LUMINANCE, GL_INT, array)
|
|
|
179 return(array)
|
|
|
180 }
|
|
|
181
|
|
|
182
|
|
|
183 # --- FPS Counter ------------------------------------------------------------
|
|
|
184
|
|
|
185 fpsInit <- function()
|
|
|
186 return(list(
|
|
|
187 tbase = SDL_GetTicks(),
|
|
|
188 frames = 0
|
|
|
189 ))
|
|
|
190
|
|
|
191 fpsUpdate <- function(o) {
|
|
|
192 tnow <- SDL_GetTicks()
|
|
|
193 if ((tnow - o$tbase) > 1000)
|
|
|
194 {
|
|
|
195 o$tbase <- tnow
|
|
|
196 SDL_WM_SetCaption(paste("FPS:", o$frames),NULL)
|
|
|
197 o$frames <- 0
|
|
|
198 } else {
|
|
|
199 o$frames <- o$frames + 1
|
|
|
200 }
|
|
|
201 return(o)
|
|
|
202 }
|
|
|
203
|
|
|
204 # --- Main Loop --------------------------------------------------------------
|
|
|
205
|
|
|
206 main <- function()
|
|
|
207 {
|
|
|
208 init()
|
|
|
209 # disable interactive plot device.
|
|
|
210 oldpars <- par(ask=FALSE,mfrow=c(1,1))
|
|
|
211 # user notice
|
|
|
212 cat("Click on window to import current random field and plot in R.\nClose window to quit mainloop.\n")
|
|
|
213
|
|
|
214 fps <- fpsInit()
|
|
|
215 quit <<- FALSE
|
|
|
216 while(!quit)
|
|
|
217 {
|
|
|
218 sim <- sim(5000)
|
|
|
219 render(sim)
|
|
|
220 pollEvents()
|
|
|
221 fps <- fpsUpdate(fps)
|
|
|
222 }
|
|
|
223
|
|
|
224 par(oldpars)
|
|
|
225 }
|
|
|
226
|
|
|
227 main()
|
|
|
228
|
