]> git.jsancho.org Git - gacela.git/commitdiff
(no commit message)
authorjsancho <devnull@localhost>
Thu, 16 Jun 2011 16:57:18 +0000 (16:57 +0000)
committerjsancho <devnull@localhost>
Thu, 16 Jun 2011 16:57:18 +0000 (16:57 +0000)
Makefile
configure.ac
src/gacela_GL.c
src/gacela_SDL.c
src/gacela_draw.scm
src/gacela_mobs.scm

index e8951dd5d0678e2f5e556ae3d2adf512eda9b374..70014bcca4c1922e23029afe9cd97a54ed0129c2 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -152,7 +152,7 @@ INSTALL_SCRIPT = ${INSTALL}
 INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
 LDFLAGS = 
 LIBOBJS = 
-LIBS =  -lSDL -lSDL_image -lSDL_mixer -lGL -lGLU -lftgl
+LIBS =  -lSDL -lSDL_image -lSDL_gfx -lSDL_mixer -lGL -lGLU -lftgl
 LTLIBOBJS = 
 MAKEINFO = ${SHELL} /home/jsancho/proyectos/guile/missing --run makeinfo
 MKDIR_P = /bin/mkdir -p
index b86920cf059aaf8696b6c9f7510053dd5d5b4527..92b9bdb5ce15d539f7e46827f48d45154b216f65 100644 (file)
@@ -13,6 +13,11 @@ AC_CHECK_LIB(SDL_image,
        LIBS="$LIBS -lSDL_image",
        AC_MSG_ERROR([*** SDL_image library not found!])
 )
+AC_CHECK_LIB(SDL_gfx,
+       main,
+       LIBS="$LIBS -lSDL_gfx",
+       AC_MSG_ERROR([*** SDL_gfx library not found!])
+)
 AC_CHECK_LIB(SDL_mixer,
        main,
        LIBS="$LIBS -lSDL_mixer",
index a031dbae69bd7f6ab1edcfc0a32654b11a555940..7e232bb99e832f548dfe046d80d4ff602ebc2c71 100644 (file)
@@ -235,7 +235,7 @@ gacela_glGenTextures (SCM n)
   glGenTextures (nint, &text[0]);
 
   for (i = nint - 1; i >= 0; i--) {
-    textures = scm_cons (scm_from_int (text[i]), textures);
+    textures = scm_cons (make_glTexture (text[i]), textures);
   }
 
   return textures;
index ce2f2cc9f0f94166c2d09565ded2754176af2dd9..ba473284216251687cc4fabe6db5feba70a51e18 100644 (file)
@@ -20,6 +20,7 @@
 #include <SDL/SDL_events.h>
 #include <SDL/SDL_image.h>
 #include <SDL/SDL_mixer.h>
+#include <SDL/SDL_rotozoom.h>
 #include "gacela_SDL.h"
 
 struct surface
@@ -59,6 +60,16 @@ get_surface_address (SCM surface_smob)
   return surface->surface_address;
 }
 
+SCM
+get_surface_filename (SCM surface_smob)
+{
+  struct surface *surface;
+
+  scm_assert_smob_type (surface_tag, surface_smob);
+  surface = (struct surface *) SCM_SMOB_DATA (surface_smob);
+  return surface->filename;
+}
+
 SCM
 get_surface_width (SCM surface_smob)
 {
@@ -278,6 +289,19 @@ gacela_SDL_EnableKeyRepeat (SCM delay, SCM interval)
   return scm_from_int (SDL_EnableKeyRepeat (scm_to_int (delay), scm_to_int (interval)));
 }
 
+SCM
+gacela_zoomSurface (SCM src, SCM zoomx, SCM zoomy, SCM smooth)
+{
+  SDL_Surface *image = zoomSurface (get_surface_address (src), scm_to_double (zoomx), scm_to_double (zoomy), scm_to_int (smooth));
+
+  if (image) {
+    return make_surface (get_surface_filename (src), image);
+  }
+  else {
+    return SCM_BOOL_F;
+  }
+}
+
 SCM
 gacela_Mix_OpenAudio (SCM frequency, SCM format, SCM channels, SCM chunksize)
 {
@@ -369,6 +393,7 @@ SDL_register_functions (void* data)
   scm_set_smob_mark (surface_tag, mark_surface);
   scm_set_smob_free (surface_tag, free_surface);
   scm_set_smob_print (surface_tag, print_surface);
+  scm_c_define_gsubr ("surface-file", 1, 0, 0, get_surface_filename);
   scm_c_define_gsubr ("surface-w", 1, 0, 0, get_surface_width);
   scm_c_define_gsubr ("surface-h", 1, 0, 0, get_surface_height);
   scm_c_define_gsubr ("surface-pixels", 1, 0, 0, get_surface_pixels);
@@ -454,6 +479,7 @@ SDL_register_functions (void* data)
   scm_c_define_gsubr ("SDL_PollEvent", 0, 0, 0, gacela_SDL_PollEvent);
   scm_c_define_gsubr ("SDL_GL_SwapBuffers", 0, 0, 0, gacela_SDL_GL_SwapBuffers);
   scm_c_define_gsubr ("SDL_EnableKeyRepeat", 2, 0, 0, gacela_SDL_EnableKeyRepeat);
+  scm_c_define_gsubr ("zoomSurface", 4, 0, 0, gacela_zoomSurface);
   scm_c_define_gsubr ("Mix_OpenAudio", 4, 0, 0, gacela_Mix_OpenAudio);
   scm_c_define_gsubr ("Mix_LoadMUS", 1, 0, 0, gacela_Mix_LoadMUS);
   scm_c_define_gsubr ("Mix_LoadWAV", 1, 0, 0, gacela_Mix_LoadWAV);
index c30d25e9ded0d36fe41ad50c3ed2f9410a4901af..196473529bbb005ea82d67b263f216c17cf6ba83 100644 (file)
        (else `(begin ,@code))))
 
 (define-macro (progn-textures . code)
-  `(let (values)
+  `(let ((result #f))
      (init-video-mode)
      (glEnable GL_TEXTURE_2D)
-     (set! values (multiple-value-list (begin ,@code)))
+     (set! result (begin ,@code))
      (glDisable GL_TEXTURE_2D)
-     (apply values values)))
+     result))
 
 (define (draw . vertexes)
   (begin-draw (length vertexes))
@@ -68,7 +68,9 @@
                  (resized-image #f))
             (cond ((and (= width power-2) (= height power-2)) (values image width height))
                   (else (set! resized-image (resize-surface image power-2 power-2))
-                        (if resized-image (values resized-image width height)))))))))
+                        (if resized-image (values resized-image width height))))))
+         (else
+          (values #f 0 0)))))
 
 (define (resize-surface surface width height)
   (let ((old-width (surface-w surface)) (old-height (surface-h surface)))
@@ -81,8 +83,8 @@
    (receive
     (image real-w real-h) (load-image-for-texture filename)
     (cond (image
-          (let ((width (get-surface-width image)) (height (get-surface-height image))
-                (byteorder (if (= (SDL_ByteOrder) SDL_LIL_ENDIAN)
+          (let ((width (surface-w image)) (height (surface-h image))
+                (byteorder (if (= SDL_BYTEORDER SDL_LIL_ENDIAN)
                                (if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA)
                                (if (= (surface-format-BytesPerPixel image) 3) GL_RGB GL_RGBA)))
                 (texture (car (glGenTextures 1))))
index c9371784fef713383a137617b1297a596f1395ed..cbeb721137abc0bf76dfaa966a08df4f7458e913 100755 (executable)
           (let ((line (car look)))
             (receive (lines images) (process-look (cdr look))
                      (cond ((string? line)
-                            (values (cons `(draw-texture ,line) lines)
-                                    (cons line images)))
+                            (let ((var (gensym)))
+                              (values (cons `(draw-texture ,var) lines)
+                                      (cons `(,var (load-texture ,line)) images))))
                            (else
                             (values (cons line lines)
                                     images))))))))
 
   (receive (look-lines look-images) (process-look look)
-          `(let ((attr ',attr))
+          `(let ,(cons `(attr ',attr) look-images)
              (lambda (option)
                (case option
                  ((#:render)
                   (glPushMatrix)
                   ,@look-lines
-;          ,@(map (lambda (x) (if (string? x) `(draw-texture ,x) x)) look)
                   (glPopMatrix)))))))