Mercurial > pub > dyncall > bindings
view R/rdyncall/demo/blink.R @ 66:7a61dd082341 default tip
pydc:
- fix double free triggered by capsule destructor, when freeing pydc and callback objects, manually
author | Tassilo Philipp |
---|---|
date | Fri, 24 May 2024 18:16:29 +0200 |
parents | 0cfcc391201f |
children |
line wrap: on
line source
# 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()