|
0
|
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
|
