Mercurial > pub > dyncall > bindings

comparison R/rdyncall/demo/sdlnet.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 # BUGS: does not work on Mac OS X using R64, needs to use R32.
2
3 library(rdyncall)
4 dynport(SDL)
5 dynport(GL)
6 dynport(SDL_net)
7 library(mapdata)
8
9 db <- "worldHires"
10
11 PORT <- 1234
12 MAX_CLIENT_SOCKETS <- 3
13
14 tcp <- NULL
15 socket <- NULL
16 sockets <- NULL
17 ctcps <- NULL
18 csocks <- NULL
19 world <- NULL
20 glList <- NULL
21
22 init <- function() {
23
24 if ( SDL_Init(SDL_INIT_VIDEO) == -1 ) {
25 error("SDL_Init failed")
26 }
27
28 if ( SDLNet_Init() == -1 ) {
29 error("SDLNet_Init failed")
30 }
31
32 ip <- new.struct("IPaddress")
33
34 if ( SDLNet_ResolveHost(ip,NULL,PORT) == -1 ) {
35 error("SDLNet_ResolveHost failed")
36 }
37
38 tcp <<- SDLNet_TCP_Open(ip)
39
40 socket <<- as.struct(offsetPtr(tcp,0),"SDLNet_GenericSocket_")
41
42 sockets <<- SDLNet_AllocSocketSet(1+MAX_CLIENT_SOCKETS)
43 SDLNet_AddSocket(sockets, socket )
44
45 SDL_SetVideoMode(640,480,32,SDL_OPENGL+SDL_DOUBLEBUF)
46
47 ctcps <<- list()
48 csocks <<- list()
49 world <<- map(db,"switzerland",plot=FALSE)
50
51 glList <<- glGenLists(1)
52 }
53
54
55 drawMap3d <- function(m) {
56 glNewList(glList, GL_COMPILE)
57 x <- m$x
58 vb <- rbind(m$x,m$y)
59 glEnableClientState(GL_VERTEX_ARRAY)
60 glVertexPointer(2, GL_DOUBLE, 0, vb)
61 markers <- which(is.na(x))
62 begin <- 1
63 i <- 1
64 while(i <= length(markers)) {
65 end <- markers[i] - 1
66 glDrawArrays(GL_LINE_STRIP, begin - 1, (end-1) - (begin-1) + 1)
67 begin <- markers[i] + 1
68 i <- i + 1
69 }
70 end <- length(x)
71 glDrawArrays(GL_LINE_STRIP, begin - 1, (end-1) - (begin-1) + 1)
72 glDisableClientState(GL_VERTEX_ARRAY)
73 glEndList()
74 }
75
76 loop <- function() {
77 drawMap3d(world)
78 do_loop <- TRUE
79 cnt <- 0
80 evt <- new.struct("SDL_Event")
81 while(do_loop) {
82 glClearColor(0.2,0.3,0.1,0)
83 glClear(GL_COLOR_BUFFER_BIT)
84 r <- world$range
85 glMatrixMode(GL_PROJECTION)
86 glLoadIdentity()
87 glOrtho(r[[1]],r[[2]],r[[3]],r[[4]],-10000, 10000)
88 glMatrixMode(GL_MODELVIEW)
89 glLoadIdentity()
90
91 cx <- r[[1]] + ( r[[2]] - r[[1]] ) * 0.5
92 cy <- r[[3]] + ( r[[4]] - r[[3]] ) * 0.5
93
94 glTranslatef( cx, cy , 0 )
95 glRotatef(cnt,0,1,0) ; cnt <- cnt + 1
96 glTranslatef( -cx, -cy , 0 )
97 #( r[[2]]-r[[1]] )*0.5, (r[[4]]-r[[3]]) *0.5,0)
98 # glTranslatef(-(r[[2]]-r[[1]])*0.5,-(r[[4]]-r[[3]])*0.5,0)
99 glEnable(GL_BLEND)
100 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)
101 glColor4f(1.0,0.8,0.5,0.2)
102 delta <- 0
103 for(i in 1:10) {
104 glLoadIdentity()
105 glTranslatef( cx, cy , 0 )
106 glRotatef(cnt+delta,0,1,0) ;
107 glTranslatef( -cx, -cy , 0 )
108 glCallList(glList)
109 delta <- delta + 1.0
110 }
111 glFinish()
112 SDL_GL_SwapBuffers()
113
114 while( SDL_PollEvent(evt) ) {
115 if ( evt$type == SDL_QUIT ) {
116 do_loop <- FALSE
117 }
118 }
119
120 numready <- SDLNet_CheckSockets(sockets, 0)
121 if (numready > 0) {
122 cat("ready\n")
123 if (socket$ready) {
124 cat("listener\n\n")
125 # tcp <- as.struct(tcp,"_TCPsocket")
126 ctcp <- SDLNet_TCP_Accept(tcp)
127 if (is.null(ctcp)) {
128 cat("warning: client is NULL\n")
129 } else {
130 csock <- as.struct(offsetPtr(ctcp,0),"SDLNet_GenericSocket_")
131 ctcps <- c(ctcps, ctcp)
132 csocks <- c(csocks, csock)
133 if ( SDLNet_AddSocket(sockets, csock) == -1 ) {
134 cat("warning: add socket failed\n")
135 }
136 }
137 numready <- numready - 1
138 }
139 while(numready) {
140 i <- 1
141 for(i in 1:length(csocks)) {
142 csock <- csocks[[i]]
143 if(csock$ready) {
144 cat("client ready")
145 numready <- numready - 1
146 buf <- raw(1000)
147 result <- SDLNet_TCP_Recv(ctcps[[i]], buf, length(buf))
148 if (result <= 0) {
149 cat("ERROR: SDLNet_TCP_Recv result <= 0.\n")
150 } else {
151 buf[result] <- as.raw(0)
152 txt <- ptr2str(offsetPtr(buf,0))
153 cat("DATA:'",txt,"'\n")
154
155 tryCatch({
156 m <- map(db,txt,plot=FALSE)
157 world <<- m
158 drawMap3d(world)
159 },error= function(x) {})
160 }
161 }
162 }
163 }
164 }
165 SDL_Delay(20)
166 }
167 }
168 init()
169 loop()
170