X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela.lisp;h=dcbddde6836162300ffa5a89af9c8512c9da1975;hb=31db8863bd1281f94f426aac5936fb897351362f;hp=9a7e89b309a770da2f8bf0d4eaa6fb410d2b2462;hpb=bb90258fa03aa649956bffcfc9b62ba35d3ec0bb;p=gacela.git diff --git a/gacela.lisp b/gacela.lisp index 9a7e89b..dcbddde 100644 --- a/gacela.lisp +++ b/gacela.lisp @@ -98,6 +98,14 @@ (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST) t) +(defmacro progn-textures (&body code) + `(let (values) + (init-video-mode) + (glEnable GL_TEXTURE_2D) + (setq values (multiple-value-list (progn ,@code))) + (glDisable GL_TEXTURE_2D) + (apply #'values values))) + (defun init-textures () (init-video-mode) (glEnable GL_TEXTURE_2D)) @@ -118,6 +126,14 @@ (glLoadIdentity) t)) +(let ((current-color '(1 1 1 1))) + (defun get-color () + current-color) + + (defun set-color (red green blue (&optional (alpha 1))) + (setq current-color color) + (glColor4f red green blue alpha))) + (defun copy-surface (source) (cond ((surface-p source) (let ((new-surface @@ -322,24 +338,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))))