#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
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)
{
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)
{
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);
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);
(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))
(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)))
(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))))
(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)))))))