0
|
1 library(rdc)
|
|
2 # ----------------------------------------------------------------------------
|
|
3 # Platform specific issues
|
|
4
|
|
5 if (.Platform$OS.type == "windows") {
|
|
6 OS <- "windows"
|
|
7 } else if ( Sys.info()[["sysname"]] == "Darwin" ) {
|
|
8 OS <- "darwin"
|
|
9 } else {
|
|
10 OS <- "unix"
|
|
11 }
|
|
12
|
|
13 # ----------------------------------------------------------------------------
|
|
14 # dynbind environment
|
|
15
|
|
16 .cdecl <- dcNewCallVM(1024)
|
|
17 .stdcall <- dcNewCallVM(1024)
|
|
18 dcMode(.stdcall, rdc:::DC_CALL_C_X86_WIN32_STD )
|
|
19
|
|
20 # ----------------------------------------------------------------------------
|
|
21 # C memory allocation
|
|
22 .callC <- .cdecl
|
|
23 .callSDL <- .cdecl
|
|
24 .callGL <- .cdecl
|
|
25 .callGLU <- .cdecl
|
|
26 .callR <- .cdecl
|
|
27 if (OS == "windows") {
|
|
28 .libC <- "/windows/system32/msvcrt"
|
|
29 .libSDL <- "/dll/sdl"
|
|
30 .libGL <- "/windows/system32/OPENGL32"
|
|
31 .libGLU <- "/windows/system32/GLU32"
|
|
32 .libR <- "R"
|
|
33 .callGL <- .stdcall
|
|
34 } else if (OS == "darwin") {
|
|
35 .libCocoa <- "/System/Library/Frameworks/Cocoa.framework/Cocoa"
|
|
36 dyn.load(.libCocoa)
|
|
37 .NSApplicationLoad <- getNativeSymbolInfo("NSApplicationLoad")$address
|
|
38 NSApplicationLoad <- function() rdcCall(.NSApplicationLoad, ")B" )
|
|
39 # dyn.load("rdc")
|
|
40 .newPool <- getNativeSymbolInfo("newPool")$address
|
|
41 .releasePool <- getNativeSymbolInfo("releasePool")$address
|
|
42 releasePool <- function(x)
|
|
43 {
|
|
44 rdcCall( .releasePool, "p)v", x )
|
|
45 }
|
|
46 newPool <- function()
|
|
47 {
|
|
48 x <- rdcCall( .newPool, ")p" )
|
|
49 reg.finalizer( x, releasePool )
|
|
50 return(x)
|
|
51 }
|
|
52 .pool <- newPool()
|
|
53 .libC <- "/usr/lib/libc.dylib"
|
|
54 .libSDL <- "/Library/Framworks/SDL.framework/SDL"
|
|
55 .libGL <- "/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib"
|
|
56 .libGLU <- "/System/Library/Frameworks/OpenGL.framework/Libraries/libGLU.dylib"
|
|
57 .libR <- Sys.getenv("R_HOME")
|
|
58 .libR <- paste(.libR,"/lib/libR.dylib",sep="")
|
|
59 } else { # unix
|
|
60 .libC <- "/lib/libc.so.6"
|
|
61 .libSDL <- "/usr/lib/libSDL.so"
|
|
62 .libGL <- "/usr/lib/libGL.so"
|
|
63 .libGLU <- "/usr/lib/libGLU.so"
|
|
64 .libR <- paste(R.home(),"/lib/libR.so",sep="")
|
|
65 }
|
|
66
|
|
67 #dyn.load(.libC)
|
|
68 #.malloc <- getNativeSymbolInfo("malloc")$address
|
|
69 #.free <- getNativeSymbolInfo("free")$free
|
|
70 #malloc <- function(size) rdcCall(.malloc, "i)p", as.integer(size) )
|
|
71 #free <- function(ptr) rdcCall(.free, "p)v", ptr)
|
|
72
|
|
73 .importsR <- "
|
|
74 R_chk_calloc(ii)p;
|
|
75 R_chk_realloc(ii)p;
|
|
76 R_chk_free(p)v;
|
|
77 "
|
|
78
|
|
79 rdcBind(.libR,.importsR,.callR)
|
|
80
|
|
81 malloc <- function(size) R_chk_calloc(as.integer(size),1L)
|
|
82 free <- function(ptr) R_chk_free(ptr)
|
|
83
|
|
84
|
|
85 # ----------------------------------------------------------------------------
|
|
86 # SDL library
|
|
87 dyn.load(.libSDL)
|
|
88
|
|
89 .SDL_Init <- getNativeSymbolInfo("SDL_Init")$address
|
|
90 .SDL_Quit <- getNativeSymbolInfo("SDL_Quit")$address
|
|
91 .SDL_SetVideoMode <- getNativeSymbolInfo("SDL_SetVideoMode")$address
|
|
92 .SDL_WM_SetCaption <- getNativeSymbolInfo("SDL_WM_SetCaption")$address
|
|
93 .SDL_GL_SwapBuffers <- getNativeSymbolInfo("SDL_GL_SwapBuffers")$address
|
|
94 .SDL_PollEvent <- getNativeSymbolInfo("SDL_PollEvent")$address
|
|
95 .SDL_GetTicks <- getNativeSymbolInfo("SDL_GetTicks")$address
|
|
96 .SDL_Delay <- getNativeSymbolInfo("SDL_Delay")$address
|
|
97 # init flags:
|
|
98 SDL_INIT_TIMER = 0x00000001L
|
|
99 SDL_INIT_AUDIO = 0x00000010L
|
|
100 SDL_INIT_VIDEO = 0x00000020L
|
|
101 SDL_INIT_CDROM = 0x00000100L
|
|
102 SDL_INIT_JOYSTICK = 0x00000200L
|
|
103 SDL_INIT_NOPARACHUTE = 0x00100000L
|
|
104 SDL_INIT_EVENTTHREAD = 0x01000000L
|
|
105 SDL_INIT_EVERYTHING = 0x0000FFFFL
|
|
106 # SDL_Init(flags):
|
|
107 SDL_Init <- function(flags) rdcCall(.SDL_Init, "i)i", as.integer(flags) )
|
|
108 # SDL_Quit():
|
|
109 SDL_Quit <- function() rdcCall(.SDL_Quit, ")v" )
|
|
110 # video flags:
|
|
111 SDL_SWSURFACE = 0x00000000L
|
|
112 SDL_HWSURFACE = 0x00000001L
|
|
113 SDL_ASYNCBLIT = 0x00000004L
|
|
114 SDL_ANYFORMAT = 0x10000000L
|
|
115 SDL_HWPALETTE = 0x20000000L
|
|
116 SDL_DOUBLEBUF = 0x40000000L
|
|
117 SDL_FULLSCREEN = 0x80000000
|
|
118 SDL_OPENGL = 0x00000002L
|
|
119 SDL_OPENGLBLIT = 0x0000000AL
|
|
120 SDL_RESIZABLE = 0x00000010L
|
|
121 SDL_NOFRAME = 0x00000020L
|
|
122 SDL_HWACCEL = 0x00000100L
|
|
123 SDL_SRCCOLORKEY = 0x00001000L
|
|
124 SDL_RLEACCELOK = 0x00002000L
|
|
125 SDL_RLEACCEL = 0x00004000L
|
|
126 SDL_SRCALPHA = 0x00010000L
|
|
127 SDL_PREALLOC = 0x01000000L
|
|
128 # SDL_SetVideoMode():
|
|
129 SDL_SetVideoMode <- function(width,height,bpp,flags) rdcCall(.SDL_SetVideoMode,"iiii)p",width,height,bpp,flags)
|
|
130 SDL_WM_SetCaption <- function(title, icon) rdcCall(.SDL_WM_SetCaption,"SS)v",as.character(title), as.character(icon))
|
|
131 SDL_PollEvent <- function(eventptr) rdcCall(.SDL_PollEvent,"p)i", eventptr)
|
|
132 SDL_GL_SwapBuffers <- function() rdcCall(.SDL_GL_SwapBuffers,")v")
|
|
133 SDL_GetTicks <- function() rdcCall(.SDL_GetTicks,")i")
|
|
134 SDL_Delay <- function(ms) rdcCall(.SDL_Delay,"i)v",ms)
|
|
135
|
|
136 SDL_NOEVENT = 0
|
|
137 SDL_ACTIVEEVENT = 1
|
|
138 SDL_KEYDOWN = 2
|
|
139 SDL_KEYUP = 3
|
|
140 SDL_MOUSEMOTION = 4
|
|
141 SDL_MOUSEBUTTONDOWN = 5
|
|
142 SDL_MOUSEBUTTONUP = 6
|
|
143 SDL_JOYAXISMOTION = 7
|
|
144 SDL_JOYBALLMOTION = 8
|
|
145 SDL_JOYHATMOTION = 9
|
|
146 SDL_JOYBUTTONDOWN = 10
|
|
147 SDL_JOYBUTTONUP = 11
|
|
148 SDL_QUIT = 12
|
|
149 SDL_SYSWMEVENT = 13
|
|
150 SDL_EVENT_RESERVEDA = 14
|
|
151 SDL_EVENT_RESERVEDB = 15
|
|
152 SDL_VIDEORESIZE = 16
|
|
153 SDL_VIDEOEXPOSE = 17
|
|
154 SDL_EVENT_RESERVED2 = 18
|
|
155 SDL_EVENT_RESERVED3 = 19
|
|
156 SDL_EVENT_RESERVED4 = 20
|
|
157 SDL_EVENT_RESERVED5 = 21
|
|
158 SDL_EVENT_RESERVED6 = 22
|
|
159 SDL_EVENT_RESERVED7 = 23
|
|
160 SDL_USEREVENT = 24
|
|
161 SDL_NUMEVENTS = 32
|
|
162
|
|
163
|
|
164 SDL_EventType <- function(event) offset(event, 0, "integer", 1)
|
|
165
|
|
166
|
|
167
|
|
168 # ----------------------------------------------------------------------------
|
|
169 # OpenGL bindings
|
|
170 dyn.load(.libGL)
|
|
171
|
|
172 .importsGL <- "
|
|
173 glGetError()i;
|
|
174 glClearColor(ffff)v;
|
|
175 glClear(i)v;
|
|
176 glMatrixMode(i)v;
|
|
177 glLoadIdentity()v;
|
|
178 glBegin(i)v;
|
|
179 glEnd()v;
|
|
180 glVertex3d(ddd)v;
|
|
181 glRotated(dddd)v;
|
|
182 glGenLists(i)i;
|
|
183 glNewList(ii)v;
|
|
184 glEnableClientState(i)v;
|
|
185 glVertexPointer(iiip)v;
|
|
186 glColorPointer(iiip)v;
|
|
187 glDrawElements(iiip)v;
|
|
188 glDisableClientState(i)v;
|
|
189 glEndList()v;
|
|
190 glCallList(i)v;
|
|
191 "
|
|
192
|
|
193 if (OS == "windows") {
|
|
194 .callGL <- .stdcall
|
|
195 .callGLU <- .stdcall
|
|
196 } else {
|
|
197 .callGL <- .cdecl
|
|
198 .callGLU <- .cdecl
|
|
199 }
|
|
200
|
|
201 # Import OpenGL symbols
|
|
202 rdcBind(.libGL,.importsGL, .callGL)
|
|
203
|
|
204 GL_FALSE = 0x0L
|
|
205 GL_TRUE = 0x1L
|
|
206
|
|
207 GL_BYTE = 0x1400L
|
|
208 GL_UNSIGNED_BYTE = 0x1401L
|
|
209 GL_SHORT = 0x1402L
|
|
210 GL_UNSIGNED_SHORT = 0x1403L
|
|
211 GL_INT = 0x1404L
|
|
212 GL_UNSIGNED_INT = 0x1405L
|
|
213 GL_FLOAT = 0x1406L
|
|
214 GL_DOUBLE = 0x140AL
|
|
215 GL_2_BYTES = 0x1407L
|
|
216 GL_3_BYTES = 0x1408L
|
|
217 GL_4_BYTES = 0x1409L
|
|
218
|
|
219
|
|
220 GL_COMPILE = 0x1300L
|
|
221 GL_COMPILE_AND_EXECUTE = 0x1301L
|
|
222 GL_LIST_BASE = 0x0B32L
|
|
223 GL_LIST_INDEX = 0x0B33L
|
|
224 GL_LIST_MODE = 0x0B30L
|
|
225
|
|
226 GL_VERTEX_ARRAY = 0x8074L
|
|
227 GL_NORMAL_ARRAY = 0x8075L
|
|
228 GL_COLOR_ARRAY = 0x8076L
|
|
229 GL_INDEX_ARRAY = 0x8077L
|
|
230 GL_TEXTURE_COORD_ARRAY = 0x8078L
|
|
231 GL_EDGE_FLAG_ARRAY = 0x8079L
|
|
232 GL_VERTEX_ARRAY_SIZE = 0x807AL
|
|
233 GL_VERTEX_ARRAY_TYPE = 0x807BL
|
|
234 GL_VERTEX_ARRAY_STRIDE = 0x807CL
|
|
235 GL_NORMAL_ARRAY_TYPE = 0x807EL
|
|
236 GL_NORMAL_ARRAY_STRIDE = 0x807FL
|
|
237 GL_COLOR_ARRAY_SIZE = 0x8081L
|
|
238 GL_COLOR_ARRAY_TYPE = 0x8082L
|
|
239 GL_COLOR_ARRAY_STRIDE = 0x8083L
|
|
240 GL_INDEX_ARRAY_TYPE = 0x8085L
|
|
241 GL_INDEX_ARRAY_STRIDE = 0x8086L
|
|
242 GL_TEXTURE_COORD_ARRAY_SIZE = 0x8088L
|
|
243 GL_TEXTURE_COORD_ARRAY_TYPE = 0x8089L
|
|
244 GL_TEXTURE_COORD_ARRAY_STRIDE = 0x808AL
|
|
245 GL_EDGE_FLAG_ARRAY_STRIDE = 0x808CL
|
|
246 GL_VERTEX_ARRAY_POINTER = 0x808EL
|
|
247 GL_NORMAL_ARRAY_POINTER = 0x808FL
|
|
248 GL_COLOR_ARRAY_POINTER = 0x8090L
|
|
249 GL_INDEX_ARRAY_POINTER = 0x8091L
|
|
250 GL_TEXTURE_COORD_ARRAY_POINTER = 0x8092L
|
|
251 GL_EDGE_FLAG_ARRAY_POINTER = 0x8093L
|
|
252 GL_V2F = 0x2A20L
|
|
253 GL_V3F = 0x2A21L
|
|
254 GL_C4UB_V2F = 0x2A22L
|
|
255 GL_C4UB_V3F = 0x2A23L
|
|
256 GL_C3F_V3F = 0x2A24L
|
|
257 GL_N3F_V3F = 0x2A25L
|
|
258 GL_C4F_N3F_V3F = 0x2A26L
|
|
259 GL_T2F_V3F = 0x2A27L
|
|
260 GL_T4F_V4F = 0x2A28L
|
|
261 GL_T2F_C4UB_V3F = 0x2A29L
|
|
262 GL_T2F_C3F_V3F = 0x2A2AL
|
|
263 GL_T2F_N3F_V3F = 0x2A2BL
|
|
264 GL_T2F_C4F_N3F_V3F = 0x2A2CL
|
|
265 GL_T4F_C4F_N3F_V4F = 0x2A2DL
|
|
266
|
|
267
|
|
268 GL_COLOR_BUFFER_BIT = 0x00004000L
|
|
269
|
|
270 GL_MODELVIEW = 0x1700L
|
|
271 GL_PROJECTION = 0x1701L
|
|
272 GL_TEXTURE = 0x1702L
|
|
273
|
|
274 GL_POINTS = 0x0000L
|
|
275 GL_LINES = 0x0001L
|
|
276 GL_LINE_LOOP = 0x0002L
|
|
277 GL_LINE_STRIP = 0x0003L
|
|
278 GL_TRIANGLES = 0x0004L
|
|
279 GL_TRIANGLE_STRIP = 0x0005L
|
|
280 GL_TRIANGLE_FAN = 0x0006L
|
|
281 GL_QUADS = 0x0007L
|
|
282 GL_QUAD_STRIP = 0x0008L
|
|
283 GL_POLYGON = 0x0009L
|
|
284
|
|
285 # ----------------------------------------------------------------------------
|
|
286 # OpenGL utility library
|
|
287
|
|
288 .importsGLU <- "
|
|
289 gluLookAt(ddddddddd)v;
|
|
290 gluPerspective(dddd)v;
|
|
291 "
|
|
292 rdcBind(.libGLU,.importsGLU, .callGLU)
|
|
293
|
|
294 #dyn.load(.libGLU)
|
|
295 #.gluLookAt <- getNativeSymbolInfo("gluLookAt")$address
|
|
296 #.gluPerspective <- getNativeSymbolInfo("gluPerspective")$address
|
|
297 #luLookAt <- function(eyeX,eyeY,eyeZ,centerX,centerY,centerZ,upX,upY,upZ)
|
|
298 # rdcCall(.gluLookAt,"ddddddddd)v", eyeX,eyeY,eyeZ,centerX,centerY,centerZ,upX,upY,upZ)
|
|
299 #gluPerspective <- function(fovy,aspect,znear,zfar)
|
|
300 # rdcCall(.gluPerspective,"dddd)v",fovy,aspect,znear,zfar)
|
|
301
|
|
302 # ----------------------------------------------------------------------------
|
|
303 # demo
|
|
304 init <- function()
|
|
305 {
|
|
306 if (OS == "darwin")
|
|
307 {
|
|
308 NSApplicationLoad()
|
|
309 }
|
|
310 err <- SDL_Init(SDL_INIT_VIDEO)
|
|
311 if (err != 0) error("SDL_Init failed")
|
|
312 surface <- SDL_SetVideoMode(512,512,32,SDL_DOUBLEBUF+SDL_OPENGL)
|
|
313 }
|
|
314
|
|
315 makeCubeDisplaylist <- function()
|
|
316 {
|
|
317 vertices <- c(
|
|
318 -1,-1,-1,
|
|
319 1,-1,-1,
|
|
320 -1, 1,-1,
|
|
321 1, 1,-1,
|
|
322 -1,-1, 1,
|
|
323 1,-1, 1,
|
|
324 -1, 1, 1,
|
|
325 1, 1, 1
|
|
326 )
|
|
327
|
|
328 colors <- as.raw( col2rgb( rainbow(8) ) )
|
|
329
|
|
330 triangleIndices <- as.integer(c(
|
|
331 0, 2, 1,
|
|
332 2, 3, 1,
|
|
333 1, 3, 7,
|
|
334 1, 7, 5,
|
|
335 4, 5, 7,
|
|
336 4, 7, 6,
|
|
337 6, 2, 0,
|
|
338 6, 0, 4,
|
|
339 2, 7, 3,
|
|
340 2, 6, 7,
|
|
341 4, 0, 5,
|
|
342 0, 1, 5
|
|
343 ))
|
|
344
|
|
345 glEnableClientState(GL_VERTEX_ARRAY)
|
|
346 glVertexPointer(3, GL_DOUBLE, 0, rdcDataPtr(vertices) )
|
|
347
|
|
348 glEnableClientState(GL_COLOR_ARRAY)
|
|
349 glColorPointer(3, GL_UNSIGNED_BYTE, 0, rdcDataPtr(colors) )
|
|
350
|
|
351 displaylistId <- glGenLists(1)
|
|
352 glNewList( displaylistId, GL_COMPILE )
|
|
353 glDrawElements(GL_TRIANGLES, 36L, GL_UNSIGNED_INT, rdcDataPtr(triangleIndices))
|
|
354 glEndList()
|
|
355
|
|
356 glDisableClientState(GL_VERTEX_ARRAY)
|
|
357 glDisableClientState(GL_COLOR_ARRAY)
|
|
358
|
|
359 return(displaylistId)
|
|
360 }
|
|
361 #buffers <- integer(2)
|
|
362 #glGenBuffersARG(length(buffers), rdcDataPtr(buffers))
|
|
363 #glBindBufferARB(GL_ARRAY_BUFFER_ARB, buffers[[1]] )
|
|
364 #glBufferDataARB(GL_ARRAY_BUFFER_ARB, rdcSizeOf(typeof(vertices)) * length(vertices) , rdcDataPtr(vertices) )
|
|
365
|
|
366
|
|
367 mainloop <- function()
|
|
368 {
|
|
369 displaylistId <- makeCubeDisplaylist()
|
|
370 eventobj <- malloc(256)
|
|
371 blink <- 0
|
|
372 tbase <- SDL_GetTicks()
|
|
373 quit <- FALSE
|
|
374 while(!quit)
|
|
375 {
|
|
376 tnow <- SDL_GetTicks()
|
|
377 tdemo <- ( tnow - tbase ) / 1000
|
|
378
|
|
379 glClearColor(0,0,blink,0)
|
|
380 glClear(GL_COLOR_BUFFER_BIT)
|
|
381
|
|
382 glMatrixMode(GL_PROJECTION)
|
|
383 glLoadIdentity()
|
|
384 aspect <- 512/512
|
|
385 gluPerspective(60, aspect, 3, 1000)
|
|
386
|
|
387 glMatrixMode(GL_MODELVIEW)
|
|
388 glLoadIdentity()
|
|
389 gluLookAt(0,0,5,0,0,0,0,1,0)
|
|
390 glRotated(sin(tdemo)*60.0, 0, 1, 0);
|
|
391 glRotated(cos(tdemo)*90.0, 1, 0, 0);
|
|
392
|
|
393 glCallList(displaylistId)
|
|
394
|
|
395 #glBegin(GL_TRIANGLES)
|
|
396 #glVertex3d(-1,-1,-1)
|
|
397 #glVertex3d( 1,-1,-1)
|
|
398 #glVertex3d( 1, 1,-1)
|
|
399 #glVertex3d(-1,-1,-1)
|
|
400 #glVertex3d( 1, 1,-1)
|
|
401 #glVertex3d(-1, 1,-1)
|
|
402 #glEnd()
|
|
403
|
|
404 SDL_GL_SwapBuffers()
|
|
405
|
|
406 SDL_WM_SetCaption(paste("time:", tdemo),0)
|
|
407 blink <- blink + 0.01
|
|
408 while (blink > 1) blink <- blink - 1
|
|
409 while( SDL_PollEvent(eventobj) != 0 )
|
|
410 {
|
|
411 eventType <- rdcUnpack1(eventobj, 0L, "c")
|
|
412 if (eventType == SDL_QUIT)
|
|
413 quit <- TRUE
|
|
414 else if (eventType == SDL_MOUSEBUTTONDOWN)
|
|
415 {
|
|
416 button <- rdcUnpack1(eventobj, 1L, "c")
|
|
417 cat("button down: ",button,"\n")
|
|
418 }
|
|
419 }
|
|
420 glerr <- glGetError()
|
|
421 if (glerr != 0)
|
|
422 {
|
|
423 cat("GL Error:", glerr)
|
|
424 quit <- 1
|
|
425 }
|
|
426 SDL_Delay(30)
|
|
427 }
|
|
428 free(eventobj)
|
|
429 #glDeleteLists(displaylistId, 1)
|
|
430 }
|
|
431
|
|
432 cleanup <- function()
|
|
433 {
|
|
434 SDL_Quit()
|
|
435 }
|
|
436
|
|
437 run <- function()
|
|
438 {
|
|
439 init()
|
|
440 mainloop()
|
|
441 }
|
|
442 # run()
|
|
443
|