Mercurial > pub > dyncall > bindings
comparison R/rdyncall/demo/blink.R @ 0:0cfcc391201f
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 # Package: rdyncall | |
2 # File: demo/blink.R | |
3 # Description: Simple SDL,OpenGL demonstration - a blinking screen | |
4 | |
5 dynport(SDL) | |
6 dynport(GL) | |
7 | |
8 blink <- 0 | |
9 surface <- NULL | |
10 | |
11 init <- function() | |
12 { | |
13 SDL_Init(SDL_INIT_VIDEO) | |
14 surface <<- SDL_SetVideoMode(640,480,32,SDL_OPENGL+SDL_DOUBLEBUF) | |
15 blink <<- 0 | |
16 } | |
17 | |
18 | |
19 update <- function() | |
20 { | |
21 glFinish() | |
22 glClearColor(0,0,blink,0) | |
23 glClear(GL_COLOR_BUFFER_BIT) | |
24 SDL_GL_SwapBuffers() | |
25 glFlush() | |
26 blink <<- ( blink + 0.01 ) %% 1 | |
27 } | |
28 | |
29 input <- function() | |
30 { | |
31 return(TRUE) | |
32 } | |
33 | |
34 checkGL <- function() | |
35 { | |
36 glerror <- glGetError() | |
37 if (glerror != 0) | |
38 { | |
39 cat("GL Error", glerror, "\n") | |
40 } | |
41 return(glerror == 0) | |
42 } | |
43 | |
44 mainloop <- function() | |
45 { | |
46 sdlevent <- new.struct("SDL_Event") | |
47 quit <- FALSE | |
48 while(!quit) | |
49 { | |
50 update() | |
51 while( SDL_PollEvent(sdlevent) ) | |
52 { | |
53 if (sdlevent$type == SDL_QUIT ) { | |
54 quit <- TRUE | |
55 } else if (sdlevent$type == SDL_MOUSEBUTTONDOWN) { | |
56 cat("button ", sdlevent$button$button ,"\n") | |
57 } | |
58 } | |
59 if ( !checkGL() ) quit <- TRUE | |
60 } | |
61 } | |
62 | |
63 quit <- function() | |
64 { | |
65 SDL_Quit() | |
66 } | |
67 | |
68 run <- function() | |
69 { | |
70 init() | |
71 mainloop() | |
72 quit() | |
73 } | |
74 | |
75 run() |