]> git.jsancho.org Git - gacela.git/blob - src/gl.c
Starting a new platform game.
[gacela.git] / src / gl.c
1 /* Gacela, a GNU Guile extension for fast games development
2    Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>.
16 */
17
18 #include <libguile.h>
19 #include <GL/gl.h>
20 #include <GL/glu.h>
21
22 struct glTexture
23 {
24   GLuint texture_id;
25   int width, height;
26 };
27
28 static scm_t_bits glTexture_tag;
29
30 SCM
31 make_glTexture (GLuint texture_id)
32 {
33   SCM smob;
34   struct glTexture *glTexture;
35
36   glTexture = (struct glTexture *) scm_gc_malloc (sizeof (struct glTexture), "glTexture");
37
38   glTexture->texture_id = 0;
39
40   SCM_NEWSMOB (smob, glTexture_tag, glTexture);
41
42   glTexture->texture_id = texture_id;
43
44   return smob;
45 }
46
47 GLuint
48 get_glTexture_id (SCM glTexture_smob)
49 {
50   struct glTexture *glTexture;
51
52   scm_assert_smob_type (glTexture_tag, glTexture_smob);
53   glTexture = (struct glTexture *) SCM_SMOB_DATA (glTexture_smob);
54   return glTexture->texture_id;
55 }
56
57 SCM
58 get_glTexture_width (SCM glTexture_smob)
59 {
60   struct glTexture *glTexture;
61
62   scm_assert_smob_type (glTexture_tag, glTexture_smob);
63   glTexture = (struct glTexture *) SCM_SMOB_DATA (glTexture_smob);
64   return scm_from_int (glTexture->width);
65 }
66
67 SCM
68 get_glTexture_height (SCM glTexture_smob)
69 {
70   struct glTexture *glTexture;
71
72   scm_assert_smob_type (glTexture_tag, glTexture_smob);
73   glTexture = (struct glTexture *) SCM_SMOB_DATA (glTexture_smob);
74   return scm_from_int (glTexture->height);
75 }
76
77 SCM
78 set_glTexture_size (SCM glTexture_smob, SCM width, SCM height)
79 {
80   struct glTexture *glTexture;
81
82   scm_assert_smob_type (glTexture_tag, glTexture_smob);
83   glTexture = (struct glTexture *) SCM_SMOB_DATA (glTexture_smob);
84   glTexture->width = scm_to_int (width);
85   glTexture->height = scm_to_int (height);
86   return SCM_UNSPECIFIED;
87 }
88
89 size_t
90 free_glTexture (SCM glTexture_smob)
91 {
92   struct glTexture *glTexture = (struct glTexture *) SCM_SMOB_DATA (glTexture_smob);
93   GLuint text[1];
94
95   text[0] = glTexture->texture_id;
96   glDeleteTextures (1, &text[0]);
97   scm_gc_free (glTexture, sizeof (struct glTexture), "glTexture");
98
99   return 0;
100 }
101
102
103 SCM
104 gacela_glBegin (SCM mode)
105 {
106   glBegin (scm_to_int (mode));
107   return SCM_UNSPECIFIED;
108 }
109
110 SCM
111 gacela_glClear (SCM mask)
112 {
113   glClear (scm_to_int (mask));
114   return SCM_UNSPECIFIED;
115 }
116
117 SCM
118 gacela_glClearColor (SCM red, SCM green, SCM blue, SCM alpha)
119 {
120   glClearColor (scm_to_double (red), scm_to_double (green), scm_to_double (blue), scm_to_double (alpha));
121   return SCM_UNSPECIFIED;
122 }
123
124 SCM
125 gacela_glClearDepth (SCM depth)
126 {
127   glClearDepth (scm_to_double (depth));
128   return SCM_UNSPECIFIED;
129 }
130
131 SCM
132 gacela_glColor3f (SCM red, SCM green, SCM blue)
133 {
134   glColor3f (scm_to_double (red), scm_to_double (green), scm_to_double (blue));
135   return SCM_UNSPECIFIED;
136 }
137
138 SCM
139 gacela_glColor4f (SCM red, SCM green, SCM blue, SCM alpha)
140 {
141   glColor4f (scm_to_double (red), scm_to_double (green), scm_to_double (blue), scm_to_double (alpha));
142   return SCM_UNSPECIFIED;
143 }
144
145 SCM
146 gacela_glDepthFunc (SCM func)
147 {
148   glDepthFunc (scm_to_int (func));
149   return SCM_UNSPECIFIED;
150 }
151
152 SCM
153 gacela_glEnable (SCM cap)
154 {
155   glEnable (scm_to_int (cap));
156   return SCM_UNSPECIFIED;
157 }
158
159 SCM
160 gacela_glDisable (SCM cap)
161 {
162   glDisable (scm_to_int (cap));
163   return SCM_UNSPECIFIED;
164 }
165
166 SCM
167 gacela_glEnd (void)
168 {
169   glEnd ();
170   return SCM_UNSPECIFIED;
171 }
172
173 SCM
174 gacela_glHint (SCM target, SCM mode)
175 {
176   glHint (scm_to_int (target), scm_to_int (mode));
177   return SCM_UNSPECIFIED;
178 }
179
180 SCM
181 gacela_glLoadIdentity (void)
182 {
183   glLoadIdentity ();
184   return SCM_UNSPECIFIED;
185 }
186
187 SCM
188 gacela_glMatrixMode (SCM mode)
189 {
190   glMatrixMode (scm_to_int (mode));
191   return SCM_UNSPECIFIED;
192 }
193
194 SCM
195 gacela_glRotatef (SCM angle, SCM x, SCM y, SCM z)
196 {
197   glRotatef (scm_to_double (angle), scm_to_double (x), scm_to_double (y), scm_to_double (z));
198   return SCM_UNSPECIFIED;
199 }
200
201 SCM
202 gacela_glShadeModel (SCM mode)
203 {
204   glShadeModel (scm_to_int (mode));
205   return SCM_UNSPECIFIED;
206 }
207
208 SCM
209 gacela_glTranslatef (SCM x, SCM y, SCM z)
210 {
211   glTranslatef (scm_to_double (x), scm_to_double (y), scm_to_double (z));
212   return SCM_UNSPECIFIED;
213 }
214
215 SCM
216 gacela_glVertex2f (SCM x, SCM y)
217 {
218   glVertex2f (scm_to_double (x), scm_to_double (y));
219   return SCM_UNSPECIFIED;
220 }
221
222 SCM
223 gacela_glVertex3f (SCM x, SCM y, SCM z)
224 {
225   glVertex3f (scm_to_double (x), scm_to_double (y), scm_to_double (z));
226   return SCM_UNSPECIFIED;
227 }
228
229 SCM
230 gacela_glViewport (SCM x, SCM y, SCM width, SCM height)
231 {
232   glViewport (scm_to_int (x), scm_to_int (y), scm_to_int (width), scm_to_int (height));
233   return SCM_UNSPECIFIED;
234 }
235
236 SCM
237 gacela_glGenTextures (SCM n)
238 {
239   SCM textures;
240   int nint = scm_to_int (n);
241   GLuint text[nint];
242   int i;
243
244   textures = scm_list_n (SCM_UNDEFINED);
245   glGenTextures (nint, &text[0]);
246
247   for (i = nint - 1; i >= 0; i--) {
248     textures = scm_cons (make_glTexture (text[i]), textures);
249   }
250
251   return textures;
252 }
253
254 SCM
255 gacela_glDeleteTextures (SCM n, SCM textures)
256 {
257   int nint = scm_to_int (n);
258   GLuint text[nint];
259   int i;
260
261   for (i = 0; i < nint; i++) {
262     text[i] = scm_to_int (scm_list_ref (textures, scm_from_int (i)));
263   }
264
265   glDeleteTextures (nint, &text[0]);
266   return SCM_UNSPECIFIED;
267 }
268
269 SCM
270 gacela_glBindTexture (SCM target, SCM texture)
271 {
272   glBindTexture (scm_to_int (target), get_glTexture_id (texture));
273   return SCM_UNSPECIFIED;
274 }
275
276 SCM
277 gacela_glTexImage2D (SCM target, SCM level, SCM internalFormat, SCM width, SCM height, SCM border, SCM format, SCM type, SCM pixels)
278 {
279   glTexImage2D (scm_to_int (target), scm_to_int (level), scm_to_int (internalFormat), scm_to_int (width), \
280                 scm_to_int (height), scm_to_int (border), scm_to_int (format), scm_to_int (type), \
281                 (GLvoid *)scm_to_int (pixels));
282   return SCM_UNSPECIFIED;
283 }
284
285 SCM
286 gacela_glTexParameteri (SCM target, SCM pname, SCM param)
287 {
288   glTexParameteri (scm_to_int (target), scm_to_int (pname), scm_to_int (param));
289   return SCM_UNSPECIFIED;
290 }
291
292 SCM
293 gacela_glTexCoord2f (SCM s, SCM t)
294 {
295   glTexCoord2f (scm_to_double (s), scm_to_double (t));
296   return SCM_UNSPECIFIED;
297 }
298
299 SCM
300 gacela_glLightfv (SCM light, SCM pname, SCM params)
301 {
302   int n = scm_to_int (scm_length (params));
303   GLfloat gl_params[n];
304   int i;
305
306   for (i = 0; i < n; i++) {
307     gl_params[i] = scm_to_double (scm_list_ref (params, scm_from_int (i)));
308   }
309
310   glLightfv (scm_to_int (light), scm_to_int (pname), gl_params);
311   return SCM_UNSPECIFIED;
312 }
313
314 SCM
315 gacela_glNormal3f (SCM nx, SCM ny, SCM nz)
316 {
317   glNormal3f (scm_to_double (nx), scm_to_double (ny), scm_to_double (nz));
318   return SCM_UNSPECIFIED;
319 }
320
321 SCM
322 gacela_glBlendFunc (SCM sfactor, SCM dfactor)
323 {
324   glBlendFunc (scm_to_int (sfactor), scm_to_int (dfactor));
325   return SCM_UNSPECIFIED;
326 }
327
328 SCM
329 gacela_glOrtho (SCM left, SCM right, SCM bottom, SCM top, SCM near_val, SCM far_val)
330 {
331   glOrtho (scm_to_double (left), scm_to_double (right), scm_to_double (bottom), scm_to_double (top), \
332            scm_to_double (near_val), scm_to_double (far_val));
333   return SCM_UNSPECIFIED;
334 }
335
336 SCM
337 gacela_glPushMatrix (void)
338 {
339   glPushMatrix ();
340   return SCM_UNSPECIFIED;
341 }
342
343 SCM
344 gacela_glPopMatrix (void)
345 {
346   glPopMatrix ();
347   return SCM_UNSPECIFIED;
348 }
349
350 SCM
351 gacela_gluPerspective (SCM fovy, SCM aspect, SCM zNear, SCM zFar)
352 {
353   gluPerspective (scm_to_double (fovy), scm_to_double (aspect), scm_to_double (zNear), scm_to_double (zFar));
354   return SCM_UNSPECIFIED;
355 }
356
357 SCM
358 gacela_gluBuild2DMipmaps (SCM target, SCM internalFormat, SCM width, SCM height, SCM format, SCM type, SCM data)
359 {
360   return scm_from_int (gluBuild2DMipmaps (scm_to_int (target), scm_to_int (internalFormat), scm_to_int (width), \
361                                           scm_to_int (height), scm_to_int (format), scm_to_int (type), \
362                                           (void *)scm_to_int (data)));
363 }
364
365 SCM
366 gacela_gluLookAt (SCM eyeX, SCM eyeY, SCM eyeZ, SCM centerX, SCM centerY, SCM centerZ, SCM upX, SCM upY, SCM upZ)
367 {
368   gluLookAt (scm_to_double (eyeX), scm_to_double (eyeY), scm_to_double (eyeZ), \
369              scm_to_double (centerX), scm_to_double (centerY), scm_to_double (centerZ), \
370              scm_to_double (upX), scm_to_double (upY), scm_to_double (upZ));
371   return SCM_UNSPECIFIED;
372 }
373
374
375 void
376 init_gacela_gl (void *data)
377 {
378   glTexture_tag = scm_make_smob_type ("glTexture", sizeof (struct glTexture));
379   scm_set_smob_free (glTexture_tag, free_glTexture);
380   scm_c_define_gsubr ("texture-w", 1, 0, 0, get_glTexture_width);
381   scm_c_define_gsubr ("texture-h", 1, 0, 0, get_glTexture_height);
382   scm_c_define_gsubr ("set-texture-size!", 3, 0, 0, set_glTexture_size);
383
384   // Data types
385   scm_c_define ("GL_UNSIGNED_BYTE", scm_from_int (GL_UNSIGNED_BYTE));
386
387   // Primitives
388   scm_c_define ("GL_POINTS", scm_from_int (GL_POINTS));
389   scm_c_define ("GL_LINES", scm_from_int (GL_LINES));
390   scm_c_define ("GL_LINE_LOOP", scm_from_int (GL_LINE_LOOP));
391   scm_c_define ("GL_LINE_STRIP", scm_from_int (GL_LINE_STRIP));
392   scm_c_define ("GL_TRIANGLES", scm_from_int (GL_TRIANGLES));
393   scm_c_define ("GL_TRIANGLE_STRIP", scm_from_int (GL_TRIANGLE_STRIP));
394   scm_c_define ("GL_TRIANGLE_FAN", scm_from_int (GL_TRIANGLE_FAN));
395   scm_c_define ("GL_QUADS", scm_from_int (GL_QUADS));
396   scm_c_define ("GL_QUAD_STRIP", scm_from_int (GL_QUAD_STRIP));
397   scm_c_define ("GL_POLYGON", scm_from_int (GL_POLYGON));
398
399   // Matrix Mode
400   scm_c_define ("GL_MODELVIEW", scm_from_int (GL_MODELVIEW));
401   scm_c_define ("GL_PROJECTION", scm_from_int (GL_PROJECTION));
402
403   // Depth buffer
404   scm_c_define ("GL_LEQUAL", scm_from_int (GL_LEQUAL));
405   scm_c_define ("GL_DEPTH_TEST", scm_from_int (GL_DEPTH_TEST));
406
407   // Lighting
408   scm_c_define ("GL_LIGHTING", scm_from_int (GL_LIGHTING));
409   scm_c_define ("GL_LIGHT1", scm_from_int (GL_LIGHT1));
410   scm_c_define ("GL_AMBIENT", scm_from_int (GL_AMBIENT));
411   scm_c_define ("GL_DIFFUSE", scm_from_int (GL_DIFFUSE));
412   scm_c_define ("GL_POSITION", scm_from_int (GL_POSITION));
413   scm_c_define ("GL_SMOOTH", scm_from_int (GL_SMOOTH));
414
415   // Blending
416   scm_c_define ("GL_BLEND", scm_from_int (GL_BLEND));
417   scm_c_define ("GL_ONE", scm_from_int (GL_ONE));
418   scm_c_define ("GL_ONE_MINUS_SRC_ALPHA", scm_from_int (GL_ONE_MINUS_SRC_ALPHA));
419   scm_c_define ("GL_SRC_ALPHA", scm_from_int (GL_SRC_ALPHA));
420
421   // Fog
422   scm_c_define ("GL_LINEAR", scm_from_int (GL_LINEAR));
423
424   // Buffers, Pixel Drawing/Reading
425   scm_c_define ("GL_RGB", scm_from_int (GL_RGB));
426   scm_c_define ("GL_RGBA", scm_from_int (GL_RGBA));
427
428   // Hints
429   scm_c_define ("GL_PERSPECTIVE_CORRECTION_HINT", scm_from_int (GL_PERSPECTIVE_CORRECTION_HINT));
430   scm_c_define ("GL_NICEST", scm_from_int (GL_NICEST));
431
432   // Texture mapping
433   scm_c_define ("GL_TEXTURE_2D", scm_from_int (GL_TEXTURE_2D));
434   scm_c_define ("GL_TEXTURE_MAG_FILTER", scm_from_int (GL_TEXTURE_MAG_FILTER));
435   scm_c_define ("GL_TEXTURE_MIN_FILTER", scm_from_int (GL_TEXTURE_MIN_FILTER));
436   scm_c_define ("GL_LINEAR_MIPMAP_NEAREST", scm_from_int (GL_LINEAR_MIPMAP_NEAREST));
437   scm_c_define ("GL_NEAREST", scm_from_int (GL_NEAREST));
438
439   // glPush/PopAttrib bits
440   scm_c_define ("GL_DEPTH_BUFFER_BIT", scm_from_int (GL_DEPTH_BUFFER_BIT));
441   scm_c_define ("GL_COLOR_BUFFER_BIT", scm_from_int (GL_COLOR_BUFFER_BIT));
442
443   // OpenGL 1.2
444   scm_c_define ("GL_BGR", scm_from_int (GL_BGR));
445   scm_c_define ("GL_BGRA", scm_from_int (GL_BGRA));
446
447
448   scm_c_define_gsubr ("glBegin", 1, 0, 0, gacela_glBegin);
449   scm_c_define_gsubr ("glClear", 1, 0, 0, gacela_glClear);
450   scm_c_define_gsubr ("glClearColor", 4, 0, 0, gacela_glClearColor);
451   scm_c_define_gsubr ("glClearDepth", 1, 0, 0, gacela_glClearDepth);
452   scm_c_define_gsubr ("glColor3f", 3, 0, 0, gacela_glColor3f);
453   scm_c_define_gsubr ("glColor4f", 4, 0, 0, gacela_glColor4f);
454   scm_c_define_gsubr ("glDepthFunc", 1, 0, 0, gacela_glDepthFunc);
455   scm_c_define_gsubr ("glEnable", 1, 0, 0, gacela_glEnable);
456   scm_c_define_gsubr ("glDisable", 1, 0, 0, gacela_glDisable);
457   scm_c_define_gsubr ("glEnd", 0, 0, 0, gacela_glEnd);
458   scm_c_define_gsubr ("glHint", 2, 0, 0, gacela_glHint);
459   scm_c_define_gsubr ("glLoadIdentity", 0, 0, 0, gacela_glLoadIdentity);
460   scm_c_define_gsubr ("glMatrixMode", 1, 0, 0, gacela_glMatrixMode);
461   scm_c_define_gsubr ("glRotatef", 4, 0, 0, gacela_glRotatef);
462   scm_c_define_gsubr ("glShadeModel", 1, 0, 0, gacela_glShadeModel);
463   scm_c_define_gsubr ("glTranslatef", 3, 0, 0, gacela_glTranslatef);
464   scm_c_define_gsubr ("glVertex2f", 2, 0, 0, gacela_glVertex2f);
465   scm_c_define_gsubr ("glVertex3f", 3, 0, 0, gacela_glVertex3f);
466   scm_c_define_gsubr ("glViewport", 4, 0, 0, gacela_glViewport);
467   scm_c_define_gsubr ("glGenTextures", 1, 0, 0, gacela_glGenTextures);
468   scm_c_define_gsubr ("glDeleteTextures", 2, 0, 0, gacela_glDeleteTextures);
469   scm_c_define_gsubr ("glBindTexture", 2, 0, 0, gacela_glBindTexture);
470   scm_c_define_gsubr ("glTexImage2D", 9, 0, 0, gacela_glTexImage2D);
471   scm_c_define_gsubr ("glTexParameteri", 3, 0, 0, gacela_glTexParameteri);
472   scm_c_define_gsubr ("glTexCoord2f", 2, 0, 0, gacela_glTexCoord2f);
473   scm_c_define_gsubr ("glLightfv", 3, 0, 0, gacela_glLightfv);
474   scm_c_define_gsubr ("glNormal3f", 3, 0, 0, gacela_glNormal3f);
475   scm_c_define_gsubr ("glBlendFunc", 2, 0, 0, gacela_glBlendFunc);
476   scm_c_define_gsubr ("glOrtho", 6, 0, 0, gacela_glOrtho);
477   scm_c_define_gsubr ("glPushMatrix", 0, 0, 0, gacela_glPushMatrix);
478   scm_c_define_gsubr ("glPopMatrix", 0, 0, 0, gacela_glPopMatrix);
479
480   scm_c_define_gsubr ("gluPerspective", 4, 0, 0, gacela_gluPerspective);
481   scm_c_define_gsubr ("gluBuild2DMipmaps", 7, 0, 0, gacela_gluBuild2DMipmaps);
482   scm_c_define_gsubr ("gluLookAt", 9, 0, 0, gacela_gluLookAt);
483 }
484
485 void
486 scm_init_gacela_gl ()
487 {
488   init_gacela_gl (NULL);
489 }