Mercurial > pub > dyncall > bindings
diff R/rdyncall/demo/sdlnet.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/rdyncall/demo/sdlnet.R Thu Mar 19 22:26:28 2015 +0100 @@ -0,0 +1,170 @@ +# BUGS: does not work on Mac OS X using R64, needs to use R32. + +library(rdyncall) +dynport(SDL) +dynport(GL) +dynport(SDL_net) +library(mapdata) + +db <- "worldHires" + +PORT <- 1234 +MAX_CLIENT_SOCKETS <- 3 + +tcp <- NULL +socket <- NULL +sockets <- NULL +ctcps <- NULL +csocks <- NULL +world <- NULL +glList <- NULL + +init <- function() { + + if ( SDL_Init(SDL_INIT_VIDEO) == -1 ) { + error("SDL_Init failed") + } + + if ( SDLNet_Init() == -1 ) { + error("SDLNet_Init failed") + } + + ip <- new.struct("IPaddress") + + if ( SDLNet_ResolveHost(ip,NULL,PORT) == -1 ) { + error("SDLNet_ResolveHost failed") + } + + tcp <<- SDLNet_TCP_Open(ip) + + socket <<- as.struct(offsetPtr(tcp,0),"SDLNet_GenericSocket_") + + sockets <<- SDLNet_AllocSocketSet(1+MAX_CLIENT_SOCKETS) + SDLNet_AddSocket(sockets, socket ) + + SDL_SetVideoMode(640,480,32,SDL_OPENGL+SDL_DOUBLEBUF) + + ctcps <<- list() + csocks <<- list() + world <<- map(db,"switzerland",plot=FALSE) + + glList <<- glGenLists(1) +} + + +drawMap3d <- function(m) { + glNewList(glList, GL_COMPILE) + x <- m$x + vb <- rbind(m$x,m$y) + glEnableClientState(GL_VERTEX_ARRAY) + glVertexPointer(2, GL_DOUBLE, 0, vb) + markers <- which(is.na(x)) + begin <- 1 + i <- 1 + while(i <= length(markers)) { + end <- markers[i] - 1 + glDrawArrays(GL_LINE_STRIP, begin - 1, (end-1) - (begin-1) + 1) + begin <- markers[i] + 1 + i <- i + 1 + } + end <- length(x) + glDrawArrays(GL_LINE_STRIP, begin - 1, (end-1) - (begin-1) + 1) + glDisableClientState(GL_VERTEX_ARRAY) + glEndList() +} + +loop <- function() { + drawMap3d(world) + do_loop <- TRUE + cnt <- 0 + evt <- new.struct("SDL_Event") + while(do_loop) { + glClearColor(0.2,0.3,0.1,0) + glClear(GL_COLOR_BUFFER_BIT) + r <- world$range + glMatrixMode(GL_PROJECTION) + glLoadIdentity() + glOrtho(r[[1]],r[[2]],r[[3]],r[[4]],-10000, 10000) + glMatrixMode(GL_MODELVIEW) + glLoadIdentity() + + cx <- r[[1]] + ( r[[2]] - r[[1]] ) * 0.5 + cy <- r[[3]] + ( r[[4]] - r[[3]] ) * 0.5 + + glTranslatef( cx, cy , 0 ) + glRotatef(cnt,0,1,0) ; cnt <- cnt + 1 + glTranslatef( -cx, -cy , 0 ) +#( r[[2]]-r[[1]] )*0.5, (r[[4]]-r[[3]]) *0.5,0) + # glTranslatef(-(r[[2]]-r[[1]])*0.5,-(r[[4]]-r[[3]])*0.5,0) + glEnable(GL_BLEND) + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA) + glColor4f(1.0,0.8,0.5,0.2) + delta <- 0 + for(i in 1:10) { + glLoadIdentity() + glTranslatef( cx, cy , 0 ) + glRotatef(cnt+delta,0,1,0) ; + glTranslatef( -cx, -cy , 0 ) + glCallList(glList) + delta <- delta + 1.0 + } + glFinish() + SDL_GL_SwapBuffers() + + while( SDL_PollEvent(evt) ) { + if ( evt$type == SDL_QUIT ) { + do_loop <- FALSE + } + } + + numready <- SDLNet_CheckSockets(sockets, 0) + if (numready > 0) { + cat("ready\n") + if (socket$ready) { + cat("listener\n\n") + # tcp <- as.struct(tcp,"_TCPsocket") + ctcp <- SDLNet_TCP_Accept(tcp) + if (is.null(ctcp)) { + cat("warning: client is NULL\n") + } else { + csock <- as.struct(offsetPtr(ctcp,0),"SDLNet_GenericSocket_") + ctcps <- c(ctcps, ctcp) + csocks <- c(csocks, csock) + if ( SDLNet_AddSocket(sockets, csock) == -1 ) { + cat("warning: add socket failed\n") + } + } + numready <- numready - 1 + } + while(numready) { + i <- 1 + for(i in 1:length(csocks)) { + csock <- csocks[[i]] + if(csock$ready) { + cat("client ready") + numready <- numready - 1 + buf <- raw(1000) + result <- SDLNet_TCP_Recv(ctcps[[i]], buf, length(buf)) + if (result <= 0) { + cat("ERROR: SDLNet_TCP_Recv result <= 0.\n") + } else { + buf[result] <- as.raw(0) + txt <- ptr2str(offsetPtr(buf,0)) + cat("DATA:'",txt,"'\n") + + tryCatch({ + m <- map(db,txt,plot=FALSE) + world <<- m + drawMap3d(world) + },error= function(x) {}) + } + } + } + } + } + SDL_Delay(20) + } +} +init() +loop() +