X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_draw.scm;h=595efe9ae92f1074927dc7f15bfa45c59d229a18;hb=2dd62c9397803ff96e72f9e27f138b58273b5976;hp=9500429965ded61b0d3abf4f17c354426038c084;hpb=f52afe4d66f4708213e5823ce4d383e82bedce44;p=gacela.git diff --git a/src/gacela_draw.scm b/src/gacela_draw.scm index 9500429..595efe9 100644 --- a/src/gacela_draw.scm +++ b/src/gacela_draw.scm @@ -86,22 +86,27 @@ (zoomSurface surface zoomx zoomy 0)))))) (define* (load-texture filename #:key (min-filter GL_LINEAR) (mag-filter GL_LINEAR)) - (progn-textures - (receive - (image real-w real-h) (load-image-for-texture filename) - (cond (image - (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)))) - - (glBindTexture GL_TEXTURE_2D texture) - (glTexImage2D GL_TEXTURE_2D 0 4 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)))))) + (let* ((key (list filename min-filter mag-filter)) + (res (get-resource-from-cache key))) + (cond (res res) + (else + (progn-textures + (receive + (image real-w real-h) (load-image-for-texture filename) + (cond (image + (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)))) + + (glBindTexture GL_TEXTURE_2D texture) + (glTexImage2D GL_TEXTURE_2D 0 4 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) + (insert-resource-into-cache key texture) + texture))))))))) (define* (draw-image filename #:optional (zoom 1)) (let ((texture (load-texture filename))) @@ -114,11 +119,11 @@ (draw-rectangle (* zoom width) (* zoom height) #:texture texture))))) (define* (draw-line length #:optional color) - (let ((l - (cond (color - (with-color color (draw v1 v2))) - (else - (draw v1 v2)))) + (let ((l (/ length 2))) + (cond (color + (with-color color (draw (list 0 l) (list 0 (- l))))) + (else + (draw (list 0 l) (list 0 (- l))))))) (define* (draw-quad v1 v2 v3 v4 #:key texture color) (cond (texture