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