|
0
|
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
|
