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 }