X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=blobdiff_plain;f=gacela%2Fimage.scm;h=40d407560a0b4a06e2aa2f26087569e3dd98a215;hp=cd0d27351277e3a29cfca446b30ba2bb1c6d0e6a;hb=8f33c32a7b23d245493f0879d181ab6661d64a2d;hpb=5f298cad7dceabfa1a8f41bf71ae17b9554c0443 diff --git a/gacela/image.scm b/gacela/image.scm index cd0d273..40d4075 100644 --- a/gacela/image.scm +++ b/gacela/image.scm @@ -22,6 +22,7 @@ #:use-module ((sdl2 image) #:prefix sdl2:) #:use-module ((sdl2 render) #:prefix sdl2:) #:use-module ((sdl2 surface) #:prefix sdl2:) + #:use-module (gl) #:export (bitmap move-xy)) @@ -29,14 +30,26 @@ (make-scene "bitmap" (let ((image (sdl2:load-image filename)) - (texture #f)) - (let ((a 0)) - (lambda* (#:key (xy '(0 0))) - (if (not texture) - (set! texture (sdl2:surface->texture %sdl-renderer image))) - (sdl2:clear-renderer %sdl-renderer) - (sdl2:render-copy %sdl-renderer texture #:dest-rect (sdl2:make-rect (car xy) (cadr xy) (sdl2:surface-width image) (sdl2:surface-height image))) - (sdl2:present-renderer %sdl-renderer)))))) + (texture #f) + (w/2 0) + (h/2 0)) + (lambda* () + (when (not texture) + (set! texture (sdl2:surface->texture %sdl-renderer image)) + (set! w/2 (/ (sdl2:surface-width image) 2)) + (set! h/2 (/ (sdl2:surface-height image) 2))) + (gl-enable (oes-framebuffer-object texture-2d)) + (sdl2:bind-texture texture) + (gl-begin (begin-mode quads) + (gl-texture-coordinates 0 0) + (gl-vertex (- w/2) h/2 0) + (gl-texture-coordinates 1 0) + (gl-vertex w/2 h/2 0) + (gl-texture-coordinates 1 1) + (gl-vertex w/2 (- h/2) 0) + (gl-texture-coordinates 0 1) + (gl-vertex (- w/2) (- h/2) 0)) + (gl-disable (oes-framebuffer-object texture-2d)))))) (define (move-xy x y scene) (define (to-integer n)