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 }