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