(no commit message)

diff --git a/gacela.lisp b/gacela.lisp
index 9a7e89b309a770da2f8bf0d4eaa6fb410d2b2462..140f0edbcdbd5dcccbb337261786f023e9a7c648 100644 (file)
--- 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 40a6c4ccf0a5e7bbab41da7f4a01f587f000b267..553ec8570f06663dfa8257297b8ed260c95852ce 100644 (file)
--- 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 9366e937ab20044b3e0daf633d4117d9e389f328..68bf06d1b5fd862326593a280a782b11b74bee0a 100755 (executable)
--- 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 6ebcf38ddde8e1e299c8cd68c335a22df38f17d0..8a7c2e433242b551ee3fbc6c2c229d142aaf436a 100755 (executable)
--- 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 6403e2c72fc4c3329740e7a537d246a1de406318..d6bf14a19f2b8606776613e36da8740efc7fdfdf 100644 (file)
--- 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)))