Mercurial > pub > dyncall > bindings

comparison R/rdyncall/demo/intro.R @ 0:0cfcc391201f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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/intro.R
3 # Description: Texture-mapped scroll-text, playing music 'Hybrid Song' composed in jan. -96 by Quazar of Sanxion
4
5 s <- NULL
6 texId <- NULL
7 music <- NULL
8
9 checkGL <- function()
10 {
11 glerror <- glGetError()
12 if (glerror != 0)
13 {
14 cat("GL Error", glerror, "\n")
15 }
16 return(glerror == 0)
17 }
18
19 init <- function()
20 {
21 require(rdyncall)
22 dynport(SDL)
23 SDL_Init(SDL_INIT_VIDEO+SDL_INIT_AUDIO)
24 dynport(GL)
25 dynport(SDL_image)
26 s <<- SDL_SetVideoMode(640,480,32,SDL_OPENGL+SDL_DOUBLEBUF)
27 stopifnot( IMG_Init(IMG_INIT_PNG) == IMG_INIT_PNG )
28 texId <<- loadTexture("chromefont.png")
29 # texId <<- loadTexture("nuskool_krome_64x64.png")
30 dynport(SDL_mixer)
31 # stopifnot( Mix_Init(MIX_INIT_MOD) == MIX_INIT_MOD )
32 Mix_OpenAudio(MIX_DEFAULT_FREQUENCY, MIX_DEFAULT_FORMAT, 2, 4096)
33 music <<- Mix_LoadMUS(rsrc("external.xm"))
34 }
35
36 rsrc <- function(name) system.file(paste("demo-files",name,sep=.Platform$file.sep), package="rdyncall")
37
38 loadTexture <- function(name)
39 {
40 checkGL()
41 glEnable(GL_TEXTURE_2D)
42 x <- rsrc(name)
43 img <- IMG_Load(x)
44 # glPixelStorei(GL_UNPACK_ALIGNMENT,4)
45 texid <- integer(1)
46 glGenTextures(1, texid)
47 glBindTexture(GL_TEXTURE_2D, texid)
48 SDL_LockSurface(img)
49 maxS <- integer(1)
50 glGetIntegerv(GL_MAX_TEXTURE_SIZE, maxS)
51 stopifnot( (img$w <= maxS) && (img$h <= maxS) )
52 glTexImage2D(GL_TEXTURE_2D, 0, 4, img$w, img$h, 0, GL_BGRA, GL_UNSIGNED_BYTE, img$pixels)
53 SDL_UnlockSurface(img)
54 SDL_FreeSurface(img)
55 # gluBuild2DMipmaps(GL_TEXTURE_2D, 4, img$w, img$h)
56 return(texid)
57 }
58
59 drawScroller <- function(codes,time)
60 {
61 glBindTexture(GL_TEXTURE_2D, texId)
62 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR)
63 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
64 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT)
65 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT)
66 glEnable(GL_BLEND)
67 glBlendFunc( GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)
68 glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE)
69
70 glMatrixMode(GL_MODELVIEW)
71 glLoadIdentity()
72 glMatrixMode(GL_PROJECTION)
73 glLoadIdentity()
74
75 x <- 1-time*0.5
76 y <- 0
77 w <- 0.3+0.1*sin(6.24*time)
78 h <- 0.2
79 for (i in 1:length(codes)) {
80 t <- codes[i]
81 s0 <- (t%%8)/8
82 t0 <- as.integer(t/8)/8
83 s1 <- s0+1/8
84 t1 <- t0+1/8
85
86 # s0 <- 0
87 # s1 <- 1
88 # t0 <- 0
89 # t1 <- 1
90
91 glBegin(GL_QUADS)
92 glTexCoord2f(s0,t1) ; glVertex3f(x ,y ,0)
93 glTexCoord2f(s1,t1) ; glVertex3f(x+w,y ,0)
94 glTexCoord2f(s1,t0) ; glVertex3f(x+w,y+h,0)
95 glTexCoord2f(s0,t0) ; glVertex3f(x ,y+h,0)
96 glEnd()
97 x <- x + w
98 }
99 }
100
101 codes <- utf8ToInt("DO YOU SOMETIMES WANT FOR YOUR OLD HOME COMPUTER?! - I DO") - 32
102
103 mainloop <- function()
104 {
105 Mix_PlayMusic(music, 1)
106 quit <- FALSE
107 blink <- 0
108 tbase <- SDL_GetTicks()
109 evt <- new.struct(SDL_Event)
110 while(!quit)
111 {
112 tnow <- SDL_GetTicks()
113 tdemo <- ( tnow - tbase ) / 1000
114 glClearColor(0,0,blink,0)
115 glClear(GL_COLOR_BUFFER_BIT+GL_DEPTH_BUFFER_BIT)
116 blink <- blink + 0.01
117 drawScroller(codes,tdemo)
118 SDL_GL_SwapBuffers()
119 while( SDL_PollEvent(evt) != 0 )
120 {
121 type <- evt$type
122 if (
123 type == SDL_QUIT
124 || ( type == SDL_KEYDOWN && evt$key$keysym$sym == SDLK_ESCAPE )
125 ) {
126 quit <- TRUE
127 }
128 }
129 SDL_Delay(20)
130 }
131 }
132
133 cleanup <- function()
134 {
135 Mix_CloseAudio()
136 # Mix_Quit()
137 IMG_Quit()
138 SDL_Quit()
139 }
140
141 run <- function()
142 {
143 init()
144 mainloop()
145 cleanup()
146 }
147
148 run()
149