diff R/rdyncall/demo/ttf.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/ttf.R	Thu Mar 19 22:26:28 2015 +0100
@@ -0,0 +1,92 @@
+# Package: rdyncall
+# File: demo/ttf.R
+# Description: TrueType Font loading and drawing via SDL and SDL_ttf.
+
+dynport(SDL_ttf)
+
+fbSurf <- NULL
+textSurf <- NULL
+
+numTexts <- 10
+
+init <- function() 
+{
+  status <- TTF_Init()
+
+  if (status != 0) {
+    stop(paste("TTF_Init failed: ", TTF_GetError(), sep=""))
+  } 
+  
+  # tryPaths <- c("/Library/Fonts","/usr/X11R7","/usr/X11R6")
+  # tryFonts <- c("Sathu.ttf", "Vera.ttf")
+
+  font <- TTF_OpenFont("/usr/X11R7/lib/X11/fonts/TTF/Vera.ttf",48)
+  # Library/Fonts/Sathu.ttf",48)
+  if (is.nullptr(font)) {
+    stop(paste("TTF_OpenFont failed: ", TTF_GetError(), sep=""))
+  }
+  
+  color <- new.struct(SDL_Color)
+  color$r <- color$g <- color$b <- 255
+  textSurf <<- TTF_RenderText_Solid(font, "Hello World.")
+
+  SDL_Init(SDL_INIT_VIDEO)
+  fbSurf <<- SDL_SetVideoMode(256,256,32,SDL_DOUBLEBUF)
+  
+  displace <<- rnorm(numTexts*2)
+}
+
+main <- function()
+{
+
+  rect <- new.struct(SDL_Rect)
+
+  rect$x <- 0
+  rect$y <- 0
+  rect$w <- textSurf$w
+  rect$h <- textSurf$h
+
+  rect2 <- rect
+
+  evt <- new.struct(SDL_Event)
+
+  quit <- FALSE
+
+  distance <- 0
+
+  while(!quit) {
+
+    SDL_FillRect(fbSurf, as.struct( as.extptr(NULL), "SDL_Rect" ), 0xFFFFFFL)
+    rect
+    i <- 1
+    while(i < numTexts*2) {
+      rect2$x <- rect$x + distance * displace[i]
+      rect2$y <- rect$y + distance * displace[i+1]
+      i <- i + 2
+      SDL_BlitSurface(textSurf, as.struct(as.extptr(NULL),"SDL_Rect"),fbSurf,rect2)
+    } 
+    SDL_Flip(fbSurf)
+    
+    distance <- distance + 1
+
+    while ( SDL_PollEvent(evt) ) {
+      if ( evt$type == SDL_QUIT )
+        quit <- TRUE
+      else if (evt$type == SDL_MOUSEBUTTONDOWN ) {
+        rect$x <- evt$button$x
+        rect$y <- evt$button$y
+        distance <- 0
+      }
+    }
+
+  }
+
+}
+
+run <- function()
+{
+  init()
+  main()
+}
+
+