diff R/rdyncall/demo/intro.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/intro.R	Thu Mar 19 22:26:28 2015 +0100
@@ -0,0 +1,149 @@
+# Package: rdyncall
+# File: demo/intro.R
+# Description: Texture-mapped scroll-text, playing music 'Hybrid Song' composed in jan. -96 by Quazar of Sanxion 
+
+s     <- NULL
+texId <- NULL
+music <- NULL
+
+checkGL <- function()
+{
+  glerror <- glGetError()
+  if (glerror != 0)
+  {
+    cat("GL Error", glerror, "\n")
+  }
+  return(glerror == 0)
+}
+
+init <- function()
+{
+  require(rdyncall)
+  dynport(SDL)
+  SDL_Init(SDL_INIT_VIDEO+SDL_INIT_AUDIO)
+  dynport(GL)
+  dynport(SDL_image)
+  s <<- SDL_SetVideoMode(640,480,32,SDL_OPENGL+SDL_DOUBLEBUF)
+  stopifnot( IMG_Init(IMG_INIT_PNG) == IMG_INIT_PNG )
+  texId <<- loadTexture("chromefont.png")
+  # texId <<- loadTexture("nuskool_krome_64x64.png")
+  dynport(SDL_mixer)
+  # stopifnot( Mix_Init(MIX_INIT_MOD) == MIX_INIT_MOD )
+  Mix_OpenAudio(MIX_DEFAULT_FREQUENCY, MIX_DEFAULT_FORMAT, 2, 4096)
+  music <<- Mix_LoadMUS(rsrc("external.xm"))
+}
+  
+rsrc <- function(name) system.file(paste("demo-files",name,sep=.Platform$file.sep), package="rdyncall")
+
+loadTexture <- function(name)
+{
+  checkGL()
+  glEnable(GL_TEXTURE_2D)
+  x <- rsrc(name)
+  img <- IMG_Load(x)
+#  glPixelStorei(GL_UNPACK_ALIGNMENT,4)
+  texid <- integer(1)
+  glGenTextures(1, texid)
+  glBindTexture(GL_TEXTURE_2D, texid)
+  SDL_LockSurface(img)
+  maxS <- integer(1)
+  glGetIntegerv(GL_MAX_TEXTURE_SIZE, maxS)
+  stopifnot( (img$w <= maxS) && (img$h <= maxS) )
+  glTexImage2D(GL_TEXTURE_2D, 0, 4, img$w, img$h, 0, GL_BGRA, GL_UNSIGNED_BYTE, img$pixels)
+  SDL_UnlockSurface(img)
+  SDL_FreeSurface(img) 
+#  gluBuild2DMipmaps(GL_TEXTURE_2D, 4, img$w, img$h)
+  return(texid)
+}
+
+drawScroller <- function(codes,time)
+{
+  glBindTexture(GL_TEXTURE_2D, texId)
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR)
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT)
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT)
+  glEnable(GL_BLEND)
+  glBlendFunc( GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)
+  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE)
+
+  glMatrixMode(GL_MODELVIEW)
+  glLoadIdentity()  
+  glMatrixMode(GL_PROJECTION)
+  glLoadIdentity()
+
+  x <- 1-time*0.5
+  y <- 0
+  w <- 0.3+0.1*sin(6.24*time)
+  h <- 0.2
+  for (i in 1:length(codes)) {
+    t  <- codes[i] 
+    s0 <- (t%%8)/8
+    t0 <- as.integer(t/8)/8
+    s1 <- s0+1/8
+    t1 <- t0+1/8
+
+    # s0 <- 0
+    # s1 <- 1
+    # t0 <- 0
+    # t1 <- 1
+    
+    glBegin(GL_QUADS)
+    glTexCoord2f(s0,t1) ; glVertex3f(x  ,y  ,0)
+    glTexCoord2f(s1,t1) ; glVertex3f(x+w,y  ,0)
+    glTexCoord2f(s1,t0) ; glVertex3f(x+w,y+h,0)
+    glTexCoord2f(s0,t0) ; glVertex3f(x  ,y+h,0)
+    glEnd()
+    x <- x + w
+  } 
+}
+  
+codes <- utf8ToInt("DO YOU SOMETIMES WANT FOR YOUR OLD HOME COMPUTER?! - I DO") - 32
+
+mainloop <- function()
+{
+  Mix_PlayMusic(music, 1)
+  quit <- FALSE
+  blink <- 0
+  tbase <- SDL_GetTicks()
+  evt <- new.struct(SDL_Event)
+  while(!quit)
+  {
+    tnow <- SDL_GetTicks()
+    tdemo <- ( tnow - tbase ) / 1000
+    glClearColor(0,0,blink,0)
+    glClear(GL_COLOR_BUFFER_BIT+GL_DEPTH_BUFFER_BIT)
+    blink <- blink + 0.01
+    drawScroller(codes,tdemo)
+    SDL_GL_SwapBuffers()
+    while( SDL_PollEvent(evt) != 0 )
+    {
+      type <- evt$type
+      if ( 
+           type == SDL_QUIT 
+      || ( type == SDL_KEYDOWN && evt$key$keysym$sym == SDLK_ESCAPE )
+      ) {
+        quit <- TRUE
+      }
+    }
+    SDL_Delay(20)
+  }
+}
+
+cleanup <- function()
+{
+  Mix_CloseAudio()
+#  Mix_Quit()
+  IMG_Quit()
+  SDL_Quit()
+}
+
+run <- function()
+{
+  init()
+  mainloop()
+  cleanup()
+}
+
+run()
+