From 4f2a527eb9aec9616363c098bc9974db1b5cf3b8 Mon Sep 17 00:00:00 2001 From: jsancho Date: Sun, 19 Sep 2010 11:08:47 +0000 Subject: [PATCH] --- gacela_draw.lisp | 18 +++++++++++++++--- gacela_tetris.lisp | 1 + 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/gacela_draw.lisp b/gacela_draw.lisp index eeaaac9..93575a3 100644 --- a/gacela_draw.lisp +++ b/gacela_draw.lisp @@ -71,13 +71,25 @@ (cond ((/= image 0) (let* ((width (surface-w image)) (height (surface-h image)) (power-2 (nearest-power-of-two (min width height))) - (zoomx (/ power-2 width)) (zoomy (/ power-2 height)) zoomed-image) - (cond ((and (= zoomx 1) (= zoomy 1)) (values image width height)) - (t (setq zoomed-image (zoomSurface image zoomx zoomy 0)) + (cond ((and (= width power-2) (= height power-2)) (values image width height)) + (t (setq zoomed-image (resize-image image power-2 power-2)) (SDL_FreeSurface image) (cond ((/= zoomed-image 0) (values zoomed-image width height)))))))))) +(defun resize-image (image width height) + (let ((old-width (surface-w image)) (old-height (surface-h image))) + (cond ((and (= width old-width) (= height old-height)) image) + (t (let ((zoomx (/ width old-width)) (zoomy (/ height old-height)) zoomed-image) + (setq zoomed-image (zoomSurface image zoomx zoomy 0)) + (let ((new-width (surface-w zoomed-image)) (new-height (surface-h zoomed-image))) + (cond ((or (and (= width new-width) (= height new-height)) + (and (= old-width new-width) (= old-height new-height))) zoomed-image) + (t (let (rezoomed) + (setq rezoomed (resize-image zoomed-image width height)) + (SDL_FreeSurface zoomed-image) + rezoomed))))))))) + (defun load-texture (filename &key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) static) (let ((key (make-resource-texture :filename filename :min-filter min-filter :mag-filter mag-filter))) (cond ((get-resource key) key) diff --git a/gacela_tetris.lisp b/gacela_tetris.lisp index bc1d5e7..9d67a1d 100644 --- a/gacela_tetris.lisp +++ b/gacela_tetris.lisp @@ -120,6 +120,7 @@ (timer (make-timer)) (grid (make-list 20 :initial-element (make-list 14))) (background (draw-image-function "fondo_tetris.png")) +; (background (draw-image-function "../../nehe/lesson06/data/nehe.bmp")) (font (load-font "lazy.ttf" :size 20)) (game-over)) -- 2.39.5