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