X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_draw.scm;h=595efe9ae92f1074927dc7f15bfa45c59d229a18;hb=500b68bdf16918b05f859830cc83d5a429d5b447;hp=5fbc92e6f65e2c7f6e2da579861f97da276b56fa;hpb=556fd6c80969ab9a474f2c66ae1aceec3866f16a;p=gacela.git diff --git a/src/gacela_draw.scm b/src/gacela_draw.scm index 5fbc92e..595efe9 100644 --- a/src/gacela_draw.scm +++ b/src/gacela_draw.scm @@ -39,7 +39,8 @@ (glEnd)) (define (begin-draw number-of-points) - (cond ((= number-of-points 3) (glBegin GL_TRIANGLES)) + (cond ((= number-of-points 2) (glBegin GL_LINES)) + ((= number-of-points 3) (glBegin GL_TRIANGLES)) ((= number-of-points 4) (glBegin GL_QUADS)))) (define (draw-vertexes vertexes) @@ -59,11 +60,16 @@ (cond ((3d-mode?) (glVertex3f x y z)) (else (glVertex2f x y)))) -(define (load-image-for-texture filename) +(define (load-image filename) (init-sdl) (let ((image (IMG_Load filename))) (cond (image - (SDL_SetAlpha image 0 0) + (SDL_DisplayFormatAlpha image))))) + +(define (load-image-for-texture filename) + (init-sdl) + (let ((image (load-image filename))) + (cond (image (let* ((width (surface-w image)) (height (surface-h image)) (power-2 (nearest-power-of-two (min width height))) (resized-image #f)) @@ -80,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_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)))))) + (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))) @@ -107,6 +118,13 @@ (height (texture-h texture))) (draw-rectangle (* zoom width) (* zoom height) #:texture texture))))) +(define* (draw-line length #:optional color) + (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 (progn-textures