Mercurial > pub > dyncall > bindings
comparison 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 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:0cfcc391201f |
---|---|
1 # Package: rdyncall | |
2 # File: demo/ttf.R | |
3 # Description: TrueType Font loading and drawing via SDL and SDL_ttf. | |
4 | |
5 dynport(SDL_ttf) | |
6 | |
7 fbSurf <- NULL | |
8 textSurf <- NULL | |
9 | |
10 numTexts <- 10 | |
11 | |
12 init <- function() | |
13 { | |
14 status <- TTF_Init() | |
15 | |
16 if (status != 0) { | |
17 stop(paste("TTF_Init failed: ", TTF_GetError(), sep="")) | |
18 } | |
19 | |
20 # tryPaths <- c("/Library/Fonts","/usr/X11R7","/usr/X11R6") | |
21 # tryFonts <- c("Sathu.ttf", "Vera.ttf") | |
22 | |
23 font <- TTF_OpenFont("/usr/X11R7/lib/X11/fonts/TTF/Vera.ttf",48) | |
24 # Library/Fonts/Sathu.ttf",48) | |
25 if (is.nullptr(font)) { | |
26 stop(paste("TTF_OpenFont failed: ", TTF_GetError(), sep="")) | |
27 } | |
28 | |
29 color <- new.struct(SDL_Color) | |
30 color$r <- color$g <- color$b <- 255 | |
31 textSurf <<- TTF_RenderText_Solid(font, "Hello World.") | |
32 | |
33 SDL_Init(SDL_INIT_VIDEO) | |
34 fbSurf <<- SDL_SetVideoMode(256,256,32,SDL_DOUBLEBUF) | |
35 | |
36 displace <<- rnorm(numTexts*2) | |
37 } | |
38 | |
39 main <- function() | |
40 { | |
41 | |
42 rect <- new.struct(SDL_Rect) | |
43 | |
44 rect$x <- 0 | |
45 rect$y <- 0 | |
46 rect$w <- textSurf$w | |
47 rect$h <- textSurf$h | |
48 | |
49 rect2 <- rect | |
50 | |
51 evt <- new.struct(SDL_Event) | |
52 | |
53 quit <- FALSE | |
54 | |
55 distance <- 0 | |
56 | |
57 while(!quit) { | |
58 | |
59 SDL_FillRect(fbSurf, as.struct( as.extptr(NULL), "SDL_Rect" ), 0xFFFFFFL) | |
60 rect | |
61 i <- 1 | |
62 while(i < numTexts*2) { | |
63 rect2$x <- rect$x + distance * displace[i] | |
64 rect2$y <- rect$y + distance * displace[i+1] | |
65 i <- i + 2 | |
66 SDL_BlitSurface(textSurf, as.struct(as.extptr(NULL),"SDL_Rect"),fbSurf,rect2) | |
67 } | |
68 SDL_Flip(fbSurf) | |
69 | |
70 distance <- distance + 1 | |
71 | |
72 while ( SDL_PollEvent(evt) ) { | |
73 if ( evt$type == SDL_QUIT ) | |
74 quit <- TRUE | |
75 else if (evt$type == SDL_MOUSEBUTTONDOWN ) { | |
76 rect$x <- evt$button$x | |
77 rect$y <- evt$button$y | |
78 distance <- 0 | |
79 } | |
80 } | |
81 | |
82 } | |
83 | |
84 } | |
85 | |
86 run <- function() | |
87 { | |
88 init() | |
89 main() | |
90 } | |
91 | |
92 |