From 6b5631c92ca29a80af99d228b3fe346c5b5e8eee Mon Sep 17 00:00:00 2001
From: jsancho <devnull@localhost>
Date: Sun, 6 Sep 2009 08:32:42 +0000
Subject: [PATCH]

---
 gacela.lisp        | 22 +++++++++++++++-------
 gacela_draw.lisp   | 34 ++++++++++++++++++++++++----------
 gacela_make.lisp   |  2 +-
 gacela_misc.lisp   |  6 ++++++
 gacela_tetris.lisp |  2 +-
 5 files changed, 47 insertions(+), 19 deletions(-)

diff --git a/gacela.lisp b/gacela.lisp
index 9a7e89b..140f0ed 100644
--- a/gacela.lisp
+++ b/gacela.lisp
@@ -322,24 +322,32 @@
 					     (eval (read-from-string (concatenate 'string "(progn " (car comlst) ")")))))))
 		     (run-com running)))))))
 
-(let ((gacela-timer (make-timer)))
-  (defun start-gacela-timer () (start-timer gacela-timer))
-  (defun get-gacela-time () (get-time gacela-timer)))
+(let (time (time-per-frame (/ 1000.0 *frames-per-second*)))
+  (defun set-frames-per-second (fps)
+    (setq time-per-frame (/ 1000.0 fps)))
+
+  (defun init-frame-time ()
+    (setq time (SDL_GetTicks)))
+
+  (defun delay-frame ()
+    (let ((frame-time (- (SDL_GetTicks) time)))
+      (cond ((< frame-time time-per-frame)
+	     (SDL_Delay (- time-per-frame frame-time)))))))
+      
 
 (defmacro run-game (title &body code)
   `(progn
      (init-video-mode)
      (SDL_WM_SetCaption ,title "")
+     (init-frame-time)
      (process-events)
      (do () ((quit?))
-	 (start-gacela-timer)
 	 (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
 	 (glLoadIdentity)
 	 ,@code
 	 (SDL_GL_SwapBuffers)
-	 (let ((frame-time (get-gacela-time)) (time-per-frame (/ 1000.0 *frames-per-second*)))
-	   (cond ((< frame-time time-per-frame)
-		  (SDL_Delay (- time-per-frame frame-time)))))
+	 (delay-frame)
+	 (init-frame-time)
 	 (process-events)
 	 (setq running nil))))
 
diff --git a/gacela_draw.lisp b/gacela_draw.lisp
index 40a6c4c..553ec85 100644
--- a/gacela_draw.lisp
+++ b/gacela_draw.lisp
@@ -54,19 +54,33 @@
 (defun draw-color (color)
   (apply #'glColor3f color))
 
-(defun load-texture (filename &optional (min-filter GL_LINEAR) (mag-filter GL_LINEAR))
-  (init-textures)
+(defun load-image-for-texture (filename)
   (init-video-mode)
   (let ((image (IMG_Load filename)))
     (cond ((/= image 0)
-	   (let ((width (surface-w image)) (height (surface-h image))
-		 (texture (car (glGenTextures 1))))
-	     (glBindTexture GL_TEXTURE_2D texture)
-	     (glTexImage2D GL_TEXTURE_2D 0 3 width height 0 GL_RGB 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)
-	     (SDL_FreeSurface image)
-	     (values texture width height))))))
+	   (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))
+		      (SDL_FreeSurface image)
+		      (cond ((/= zoomed-image 0) (values zoomed-image width height))))))))))
+
+(defun load-texture (filename &optional (min-filter GL_LINEAR) (mag-filter GL_LINEAR))
+  (init-textures)
+  (init-video-mode)
+  (multiple-value-bind
+   (image real-w real-h) (load-image-for-texture filename)
+        (cond (image
+	       (let ((width (surface-w image)) (height (surface-h image))
+		     (texture (car (glGenTextures 1))))
+		 (glBindTexture GL_TEXTURE_2D texture)
+		 (glTexImage2D GL_TEXTURE_2D 0 3 width height 0 GL_RGB 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)
+		 (SDL_FreeSurface image)
+		 (values texture real-w real-h))))))
 
 (defun draw-image-function (filename)
   (multiple-value-bind
diff --git a/gacela_make.lisp b/gacela_make.lisp
index 9366e93..68bf06d 100755
--- a/gacela_make.lisp
+++ b/gacela_make.lisp
@@ -33,7 +33,7 @@
    '("gacela.o" "gacela_SDL.o" "gacela_GL.o" "gacela_draw.o" "gacela_events.o" "gacela_mobs.o" "gacela_widgets.o" "gacela_misc.o")
    "gacela"
    ""
-   "-lSDL -lSDL_image -lSDL_ttf -lSDL_mixer -lSGE -lGL -lGLU"))
+   "-lSDL -lSDL_image -lSDL_ttf -lSDL_mixer -lSDL_gfx -lGL -lGLU"))
 
 (defun build-gacela ()
   (compile-gacela)
diff --git a/gacela_misc.lisp b/gacela_misc.lisp
index 6ebcf38..8a7c2e4 100755
--- a/gacela_misc.lisp
+++ b/gacela_misc.lisp
@@ -63,6 +63,12 @@
 	 (cond ((or (numberp list) (numberp pattern)) (and (numberp list) (numberp pattern)))
 	       (t t)))))
 
+(defun nearest-power-of-two (n)
+  (labels ((power (p n)
+		  (cond ((> (* p 2) n) p)
+			(t (power (* p 2) n)))))
+	  (power 1 n)))
+
 ;Geometry
 (defun dotp (dot)
   (match-pattern dot '(0 0)))
diff --git a/gacela_tetris.lisp b/gacela_tetris.lisp
index 6403e2c..d6bf14a 100644
--- a/gacela_tetris.lisp
+++ b/gacela_tetris.lisp
@@ -103,7 +103,7 @@
       (next (random-tetramine))
       (timer (make-timer))
       (grid (make-list 20 :initial-element (make-list 14)))
-      (background (draw-image-function "fondo_tetris2.png")))
+      (background (draw-image-function "fondo_tetris.png")))
   (defun tetramine ()
     (cond ((eq (timer-state timer) 'stopped) (start-timer timer)))
 
-- 
2.39.5