From: jsancho Date: Sun, 6 Sep 2009 08:32:42 +0000 (+0000) Subject: (no commit message) X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=6b5631c92ca29a80af99d228b3fe346c5b5e8eee;p=gacela.git --- 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)))