Mercurial > pub > dyncall > bindings

comparison R/rdc/demo/sdl.R @ 0:0cfcc391201f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial from svn dyncall-1745
author Daniel Adler
date Thu, 19 Mar 2015 22:26:28 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:0cfcc391201f
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