Mercurial > pub > dyncall > bindings
diff R/rdc/demo/sdl.R @ 0:0cfcc391201f
initial from svn dyncall-1745
author | Daniel Adler |
---|---|
date | Thu, 19 Mar 2015 22:26:28 +0100 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/R/rdc/demo/sdl.R Thu Mar 19 22:26:28 2015 +0100 @@ -0,0 +1,443 @@ +library(rdc) +# ---------------------------------------------------------------------------- +# Platform specific issues + +if (.Platform$OS.type == "windows") { + OS <- "windows" +} else if ( Sys.info()[["sysname"]] == "Darwin" ) { + OS <- "darwin" +} else { + OS <- "unix" +} + +# ---------------------------------------------------------------------------- +# dynbind environment + +.cdecl <- dcNewCallVM(1024) +.stdcall <- dcNewCallVM(1024) +dcMode(.stdcall, rdc:::DC_CALL_C_X86_WIN32_STD ) + +# ---------------------------------------------------------------------------- +# C memory allocation +.callC <- .cdecl +.callSDL <- .cdecl +.callGL <- .cdecl +.callGLU <- .cdecl +.callR <- .cdecl +if (OS == "windows") { + .libC <- "/windows/system32/msvcrt" + .libSDL <- "/dll/sdl" + .libGL <- "/windows/system32/OPENGL32" + .libGLU <- "/windows/system32/GLU32" + .libR <- "R" + .callGL <- .stdcall +} else if (OS == "darwin") { + .libCocoa <- "/System/Library/Frameworks/Cocoa.framework/Cocoa" + dyn.load(.libCocoa) + .NSApplicationLoad <- getNativeSymbolInfo("NSApplicationLoad")$address + NSApplicationLoad <- function() rdcCall(.NSApplicationLoad, ")B" ) + # dyn.load("rdc") + .newPool <- getNativeSymbolInfo("newPool")$address + .releasePool <- getNativeSymbolInfo("releasePool")$address + releasePool <- function(x) + { + rdcCall( .releasePool, "p)v", x ) + } + newPool <- function() + { + x <- rdcCall( .newPool, ")p" ) + reg.finalizer( x, releasePool ) + return(x) + } + .pool <- newPool() + .libC <- "/usr/lib/libc.dylib" + .libSDL <- "/Library/Framworks/SDL.framework/SDL" + .libGL <- "/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib" + .libGLU <- "/System/Library/Frameworks/OpenGL.framework/Libraries/libGLU.dylib" + .libR <- Sys.getenv("R_HOME") + .libR <- paste(.libR,"/lib/libR.dylib",sep="") +} else { # unix + .libC <- "/lib/libc.so.6" + .libSDL <- "/usr/lib/libSDL.so" + .libGL <- "/usr/lib/libGL.so" + .libGLU <- "/usr/lib/libGLU.so" + .libR <- paste(R.home(),"/lib/libR.so",sep="") +} + +#dyn.load(.libC) +#.malloc <- getNativeSymbolInfo("malloc")$address +#.free <- getNativeSymbolInfo("free")$free +#malloc <- function(size) rdcCall(.malloc, "i)p", as.integer(size) ) +#free <- function(ptr) rdcCall(.free, "p)v", ptr) + +.importsR <- " +R_chk_calloc(ii)p; +R_chk_realloc(ii)p; +R_chk_free(p)v; +" + +rdcBind(.libR,.importsR,.callR) + +malloc <- function(size) R_chk_calloc(as.integer(size),1L) +free <- function(ptr) R_chk_free(ptr) + + +# ---------------------------------------------------------------------------- +# SDL library +dyn.load(.libSDL) + +.SDL_Init <- getNativeSymbolInfo("SDL_Init")$address +.SDL_Quit <- getNativeSymbolInfo("SDL_Quit")$address +.SDL_SetVideoMode <- getNativeSymbolInfo("SDL_SetVideoMode")$address +.SDL_WM_SetCaption <- getNativeSymbolInfo("SDL_WM_SetCaption")$address +.SDL_GL_SwapBuffers <- getNativeSymbolInfo("SDL_GL_SwapBuffers")$address +.SDL_PollEvent <- getNativeSymbolInfo("SDL_PollEvent")$address +.SDL_GetTicks <- getNativeSymbolInfo("SDL_GetTicks")$address +.SDL_Delay <- getNativeSymbolInfo("SDL_Delay")$address +# init flags: +SDL_INIT_TIMER = 0x00000001L +SDL_INIT_AUDIO = 0x00000010L +SDL_INIT_VIDEO = 0x00000020L +SDL_INIT_CDROM = 0x00000100L +SDL_INIT_JOYSTICK = 0x00000200L +SDL_INIT_NOPARACHUTE = 0x00100000L +SDL_INIT_EVENTTHREAD = 0x01000000L +SDL_INIT_EVERYTHING = 0x0000FFFFL +# SDL_Init(flags): +SDL_Init <- function(flags) rdcCall(.SDL_Init, "i)i", as.integer(flags) ) +# SDL_Quit(): +SDL_Quit <- function() rdcCall(.SDL_Quit, ")v" ) +# video flags: +SDL_SWSURFACE = 0x00000000L +SDL_HWSURFACE = 0x00000001L +SDL_ASYNCBLIT = 0x00000004L +SDL_ANYFORMAT = 0x10000000L +SDL_HWPALETTE = 0x20000000L +SDL_DOUBLEBUF = 0x40000000L +SDL_FULLSCREEN = 0x80000000 +SDL_OPENGL = 0x00000002L +SDL_OPENGLBLIT = 0x0000000AL +SDL_RESIZABLE = 0x00000010L +SDL_NOFRAME = 0x00000020L +SDL_HWACCEL = 0x00000100L +SDL_SRCCOLORKEY = 0x00001000L +SDL_RLEACCELOK = 0x00002000L +SDL_RLEACCEL = 0x00004000L +SDL_SRCALPHA = 0x00010000L +SDL_PREALLOC = 0x01000000L +# SDL_SetVideoMode(): +SDL_SetVideoMode <- function(width,height,bpp,flags) rdcCall(.SDL_SetVideoMode,"iiii)p",width,height,bpp,flags) +SDL_WM_SetCaption <- function(title, icon) rdcCall(.SDL_WM_SetCaption,"SS)v",as.character(title), as.character(icon)) +SDL_PollEvent <- function(eventptr) rdcCall(.SDL_PollEvent,"p)i", eventptr) +SDL_GL_SwapBuffers <- function() rdcCall(.SDL_GL_SwapBuffers,")v") +SDL_GetTicks <- function() rdcCall(.SDL_GetTicks,")i") +SDL_Delay <- function(ms) rdcCall(.SDL_Delay,"i)v",ms) + +SDL_NOEVENT = 0 +SDL_ACTIVEEVENT = 1 +SDL_KEYDOWN = 2 +SDL_KEYUP = 3 +SDL_MOUSEMOTION = 4 +SDL_MOUSEBUTTONDOWN = 5 +SDL_MOUSEBUTTONUP = 6 +SDL_JOYAXISMOTION = 7 +SDL_JOYBALLMOTION = 8 +SDL_JOYHATMOTION = 9 +SDL_JOYBUTTONDOWN = 10 +SDL_JOYBUTTONUP = 11 +SDL_QUIT = 12 +SDL_SYSWMEVENT = 13 +SDL_EVENT_RESERVEDA = 14 +SDL_EVENT_RESERVEDB = 15 +SDL_VIDEORESIZE = 16 +SDL_VIDEOEXPOSE = 17 +SDL_EVENT_RESERVED2 = 18 +SDL_EVENT_RESERVED3 = 19 +SDL_EVENT_RESERVED4 = 20 +SDL_EVENT_RESERVED5 = 21 +SDL_EVENT_RESERVED6 = 22 +SDL_EVENT_RESERVED7 = 23 +SDL_USEREVENT = 24 +SDL_NUMEVENTS = 32 + + +SDL_EventType <- function(event) offset(event, 0, "integer", 1) + + + +# ---------------------------------------------------------------------------- +# OpenGL bindings +dyn.load(.libGL) + +.importsGL <- " + glGetError()i; + glClearColor(ffff)v; + glClear(i)v; + glMatrixMode(i)v; + glLoadIdentity()v; + glBegin(i)v; + glEnd()v; + glVertex3d(ddd)v; + glRotated(dddd)v; + glGenLists(i)i; + glNewList(ii)v; + glEnableClientState(i)v; + glVertexPointer(iiip)v; + glColorPointer(iiip)v; + glDrawElements(iiip)v; + glDisableClientState(i)v; + glEndList()v; + glCallList(i)v; +" + +if (OS == "windows") { + .callGL <- .stdcall + .callGLU <- .stdcall +} else { + .callGL <- .cdecl + .callGLU <- .cdecl +} + +# Import OpenGL symbols +rdcBind(.libGL,.importsGL, .callGL) + +GL_FALSE = 0x0L +GL_TRUE = 0x1L + +GL_BYTE = 0x1400L +GL_UNSIGNED_BYTE = 0x1401L +GL_SHORT = 0x1402L +GL_UNSIGNED_SHORT = 0x1403L +GL_INT = 0x1404L +GL_UNSIGNED_INT = 0x1405L +GL_FLOAT = 0x1406L +GL_DOUBLE = 0x140AL +GL_2_BYTES = 0x1407L +GL_3_BYTES = 0x1408L +GL_4_BYTES = 0x1409L + + +GL_COMPILE = 0x1300L +GL_COMPILE_AND_EXECUTE = 0x1301L +GL_LIST_BASE = 0x0B32L +GL_LIST_INDEX = 0x0B33L +GL_LIST_MODE = 0x0B30L + +GL_VERTEX_ARRAY = 0x8074L + GL_NORMAL_ARRAY = 0x8075L + GL_COLOR_ARRAY = 0x8076L + GL_INDEX_ARRAY = 0x8077L + GL_TEXTURE_COORD_ARRAY = 0x8078L + GL_EDGE_FLAG_ARRAY = 0x8079L + GL_VERTEX_ARRAY_SIZE = 0x807AL + GL_VERTEX_ARRAY_TYPE = 0x807BL + GL_VERTEX_ARRAY_STRIDE = 0x807CL + GL_NORMAL_ARRAY_TYPE = 0x807EL + GL_NORMAL_ARRAY_STRIDE = 0x807FL + GL_COLOR_ARRAY_SIZE = 0x8081L + GL_COLOR_ARRAY_TYPE = 0x8082L + GL_COLOR_ARRAY_STRIDE = 0x8083L + GL_INDEX_ARRAY_TYPE = 0x8085L + GL_INDEX_ARRAY_STRIDE = 0x8086L + GL_TEXTURE_COORD_ARRAY_SIZE = 0x8088L + GL_TEXTURE_COORD_ARRAY_TYPE = 0x8089L + GL_TEXTURE_COORD_ARRAY_STRIDE = 0x808AL + GL_EDGE_FLAG_ARRAY_STRIDE = 0x808CL + GL_VERTEX_ARRAY_POINTER = 0x808EL + GL_NORMAL_ARRAY_POINTER = 0x808FL + GL_COLOR_ARRAY_POINTER = 0x8090L + GL_INDEX_ARRAY_POINTER = 0x8091L + GL_TEXTURE_COORD_ARRAY_POINTER = 0x8092L + GL_EDGE_FLAG_ARRAY_POINTER = 0x8093L + GL_V2F = 0x2A20L + GL_V3F = 0x2A21L + GL_C4UB_V2F = 0x2A22L + GL_C4UB_V3F = 0x2A23L + GL_C3F_V3F = 0x2A24L + GL_N3F_V3F = 0x2A25L + GL_C4F_N3F_V3F = 0x2A26L + GL_T2F_V3F = 0x2A27L + GL_T4F_V4F = 0x2A28L + GL_T2F_C4UB_V3F = 0x2A29L + GL_T2F_C3F_V3F = 0x2A2AL + GL_T2F_N3F_V3F = 0x2A2BL + GL_T2F_C4F_N3F_V3F = 0x2A2CL + GL_T4F_C4F_N3F_V4F = 0x2A2DL + + +GL_COLOR_BUFFER_BIT = 0x00004000L + +GL_MODELVIEW = 0x1700L +GL_PROJECTION = 0x1701L +GL_TEXTURE = 0x1702L + +GL_POINTS = 0x0000L +GL_LINES = 0x0001L +GL_LINE_LOOP = 0x0002L +GL_LINE_STRIP = 0x0003L +GL_TRIANGLES = 0x0004L +GL_TRIANGLE_STRIP = 0x0005L +GL_TRIANGLE_FAN = 0x0006L +GL_QUADS = 0x0007L +GL_QUAD_STRIP = 0x0008L +GL_POLYGON = 0x0009L + +# ---------------------------------------------------------------------------- +# OpenGL utility library + +.importsGLU <- " + gluLookAt(ddddddddd)v; + gluPerspective(dddd)v; +" +rdcBind(.libGLU,.importsGLU, .callGLU) + +#dyn.load(.libGLU) +#.gluLookAt <- getNativeSymbolInfo("gluLookAt")$address +#.gluPerspective <- getNativeSymbolInfo("gluPerspective")$address +#luLookAt <- function(eyeX,eyeY,eyeZ,centerX,centerY,centerZ,upX,upY,upZ) +# rdcCall(.gluLookAt,"ddddddddd)v", eyeX,eyeY,eyeZ,centerX,centerY,centerZ,upX,upY,upZ) +#gluPerspective <- function(fovy,aspect,znear,zfar) +# rdcCall(.gluPerspective,"dddd)v",fovy,aspect,znear,zfar) + +# ---------------------------------------------------------------------------- +# demo +init <- function() +{ + if (OS == "darwin") + { + NSApplicationLoad() + } + err <- SDL_Init(SDL_INIT_VIDEO) + if (err != 0) error("SDL_Init failed") + surface <- SDL_SetVideoMode(512,512,32,SDL_DOUBLEBUF+SDL_OPENGL) +} + +makeCubeDisplaylist <- function() +{ + vertices <- c( + -1,-1,-1, + 1,-1,-1, + -1, 1,-1, + 1, 1,-1, + -1,-1, 1, + 1,-1, 1, + -1, 1, 1, + 1, 1, 1 + ) + + colors <- as.raw( col2rgb( rainbow(8) ) ) + + triangleIndices <- as.integer(c( + 0, 2, 1, + 2, 3, 1, + 1, 3, 7, + 1, 7, 5, + 4, 5, 7, + 4, 7, 6, + 6, 2, 0, + 6, 0, 4, + 2, 7, 3, + 2, 6, 7, + 4, 0, 5, + 0, 1, 5 + )) + + glEnableClientState(GL_VERTEX_ARRAY) + glVertexPointer(3, GL_DOUBLE, 0, rdcDataPtr(vertices) ) + + glEnableClientState(GL_COLOR_ARRAY) + glColorPointer(3, GL_UNSIGNED_BYTE, 0, rdcDataPtr(colors) ) + + displaylistId <- glGenLists(1) + glNewList( displaylistId, GL_COMPILE ) + glDrawElements(GL_TRIANGLES, 36L, GL_UNSIGNED_INT, rdcDataPtr(triangleIndices)) + glEndList() + + glDisableClientState(GL_VERTEX_ARRAY) + glDisableClientState(GL_COLOR_ARRAY) + + return(displaylistId) +} +#buffers <- integer(2) +#glGenBuffersARG(length(buffers), rdcDataPtr(buffers)) +#glBindBufferARB(GL_ARRAY_BUFFER_ARB, buffers[[1]] ) +#glBufferDataARB(GL_ARRAY_BUFFER_ARB, rdcSizeOf(typeof(vertices)) * length(vertices) , rdcDataPtr(vertices) ) + + +mainloop <- function() +{ + displaylistId <- makeCubeDisplaylist() + eventobj <- malloc(256) + blink <- 0 + tbase <- SDL_GetTicks() + quit <- FALSE + while(!quit) + { + tnow <- SDL_GetTicks() + tdemo <- ( tnow - tbase ) / 1000 + + glClearColor(0,0,blink,0) + glClear(GL_COLOR_BUFFER_BIT) + + glMatrixMode(GL_PROJECTION) + glLoadIdentity() + aspect <- 512/512 + gluPerspective(60, aspect, 3, 1000) + + glMatrixMode(GL_MODELVIEW) + glLoadIdentity() + gluLookAt(0,0,5,0,0,0,0,1,0) + glRotated(sin(tdemo)*60.0, 0, 1, 0); + glRotated(cos(tdemo)*90.0, 1, 0, 0); + + glCallList(displaylistId) + + #glBegin(GL_TRIANGLES) + #glVertex3d(-1,-1,-1) + #glVertex3d( 1,-1,-1) + #glVertex3d( 1, 1,-1) + #glVertex3d(-1,-1,-1) + #glVertex3d( 1, 1,-1) + #glVertex3d(-1, 1,-1) + #glEnd() + + SDL_GL_SwapBuffers() + + SDL_WM_SetCaption(paste("time:", tdemo),0) + blink <- blink + 0.01 + while (blink > 1) blink <- blink - 1 + while( SDL_PollEvent(eventobj) != 0 ) + { + eventType <- rdcUnpack1(eventobj, 0L, "c") + if (eventType == SDL_QUIT) + quit <- TRUE + else if (eventType == SDL_MOUSEBUTTONDOWN) + { + button <- rdcUnpack1(eventobj, 1L, "c") + cat("button down: ",button,"\n") + } + } + glerr <- glGetError() + if (glerr != 0) + { + cat("GL Error:", glerr) + quit <- 1 + } + SDL_Delay(30) + } + free(eventobj) + #glDeleteLists(displaylistId, 1) +} + +cleanup <- function() +{ + SDL_Quit() +} + +run <- function() +{ + init() + mainloop() +} +# run() +