X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_draw.scm;h=5fbc92e6f65e2c7f6e2da579861f97da276b56fa;hb=556fd6c80969ab9a474f2c66ae1aceec3866f16a;hp=c30d25e9ded0d36fe41ad50c3ed2f9410a4901af;hpb=34d7fb9e3b5125539be506237fbe41854ed174bd;p=gacela.git diff --git a/src/gacela_draw.scm b/src/gacela_draw.scm index c30d25e..5fbc92e 100644 --- a/src/gacela_draw.scm +++ b/src/gacela_draw.scm @@ -26,12 +26,12 @@ (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)) @@ -60,15 +60,18 @@ (else (glVertex2f x y)))) (define (load-image-for-texture filename) - (init-video-mode) + (init-sdl) (let ((image (IMG_Load filename))) (cond (image + (SDL_SetAlpha image 0 0) (let* ((width (surface-w image)) (height (surface-h image)) (power-2 (nearest-power-of-two (min width height))) (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,16 +84,17 @@ (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) - (if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA) - (if (= (surface-format-BytesPerPixel image) 3) GL_RGB GL_RGBA))) + (let ((width (surface-w image)) (height (surface-h image)) + (byteorder (if (= SDL_BYTEORDER SDL_LIL_ENDIAN) + (if (= (surface-format-BytesPerPixel image) 3) GL_RGB GL_RGBA) + (if (= (surface-format-BytesPerPixel image) 3) GL_BGR GL_BGRA))) (texture (car (glGenTextures 1)))) (glBindTexture GL_TEXTURE_2D texture) (glTexImage2D GL_TEXTURE_2D 0 3 width height 0 byteorder GL_UNSIGNED_BYTE (surface-pixels image)) (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER min-filter) (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER mag-filter) + (set-texture-size! texture real-w real-h) texture)))))) (define* (draw-image filename #:optional (zoom 1)) @@ -119,12 +123,13 @@ (draw v1 v2 v3 v4)))) (define* (draw-rectangle width height #:key texture color) - (draw-quad (list (- width) height 0) - (list width height 0) - (list width (- height) 0) - (list (- width) (- height) 0) - #:texture texture - #:color color)) + (let ((w (/ width 2)) (h (/ height 2))) + (draw-quad (list (- w) h 0) + (list w h 0) + (list w (- h) 0) + (list (- w) (- h) 0) + #:texture texture + #:color color))) (define* (draw-square #:key (size 1) texture color) (draw-rectangle size size #:texture texture #:color color))