Mercurial > pub > dyncall > bindings
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/R/rdyncall/demo/blink.R Thu Mar 19 22:26:28 2015 +0100 @@ -0,0 +1,75 @@ +# Package: rdyncall +# File: demo/blink.R +# Description: Simple SDL,OpenGL demonstration - a blinking screen + +dynport(SDL) +dynport(GL) + +blink <- 0 +surface <- NULL + +init <- function() +{ + SDL_Init(SDL_INIT_VIDEO) + surface <<- SDL_SetVideoMode(640,480,32,SDL_OPENGL+SDL_DOUBLEBUF) + blink <<- 0 +} + + +update <- function() +{ + glFinish() + glClearColor(0,0,blink,0) + glClear(GL_COLOR_BUFFER_BIT) + SDL_GL_SwapBuffers() + glFlush() + blink <<- ( blink + 0.01 ) %% 1 +} + +input <- function() +{ + return(TRUE) +} + +checkGL <- function() +{ + glerror <- glGetError() + if (glerror != 0) + { + cat("GL Error", glerror, "\n") + } + return(glerror == 0) +} + +mainloop <- function() +{ + sdlevent <- new.struct("SDL_Event") + quit <- FALSE + while(!quit) + { + update() + while( SDL_PollEvent(sdlevent) ) + { + if (sdlevent$type == SDL_QUIT ) { + quit <- TRUE + } else if (sdlevent$type == SDL_MOUSEBUTTONDOWN) { + cat("button ", sdlevent$button$button ,"\n") + } + } + if ( !checkGL() ) quit <- TRUE + } +} + +quit <- function() +{ + SDL_Quit() +} + +run <- function() +{ + init() + mainloop() + quit() +} + +run()