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