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