X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela.lisp;h=fb8438b9c9ff674edb540cbbbd7fd0a7cf47ae7e;hb=377bf34ac61998549b24e339e3a3eea80734b6e3;hp=6ad199f314623426210e823ef26e4555b20a1391;hpb=d672794dd75f5607aa8b60d5b67474887cd6ae73;p=gacela.git diff --git a/gacela.lisp b/gacela.lisp index 6ad199f..fb8438b 100644 --- a/gacela.lisp +++ b/gacela.lisp @@ -81,14 +81,6 @@ (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-lighting () (init-video-mode) (glEnable GL_LIGHTING)) @@ -161,42 +153,67 @@ (defun make-resource-texture (&key filename min-filter mag-filter) `(:type texture :filename ,filename :min-filter ,min-filter :mag-filter ,mag-filter)) -(defun make-resource-font (&key filename size encoding) - `(:type font :filename ,filename :size ,size :enconding ,encoding)) +(defun make-resource-font (&key filename encoding) + `(:type font :filename ,filename :enconding ,encoding)) + +(defmacro get-rtime (key) + `(resource-time (gethash ,key resources-table))) + +(defmacro get-rplist (key) + `(resource-plist (gethash ,key resources-table))) + +(defmacro get-rconstructor (key) + `(resource-constructor (gethash ,key resources-table))) -(let ((resources-table (make-hash-table :test 'equal))) +(defmacro get-rdestructor (key) + `(resource-destructor (gethash ,key resources-table))) + +(let ((resources-table (make-hash-table :test 'equal)) + (expiration-time 50000)) + + (defun set-expiration-time (new-time) + (setq expiration-time new-time)) (defun set-resource (key plist constructor destructor &key static) + (expire-resources) (setf (gethash key resources-table) (make-resource :plist plist :constructor constructor :destructor destructor - :free-function free-function :time (if static t (SDL_GetTicks))))) (defun get-resource (key) - (let ((resource (gethash key resources-table))) - (cond ((null resource) nil) - (t (cond ((/= (resource-time resource) -1) - (setf (resource-time resource) (SDL_GetTicks)) - (setf (gethash key resources-table) resource))) - (resource-plist resource))))) + (cond ((null (gethash key resources-table)) nil) + (t (let ((time (get-rtime key))) + (cond ((null time) (funcall (get-rconstructor key))) + ((numberp time) (setf (get-rtime key) (SDL_GetTicks)))) + (get-rplist key))))) (defun free-resource (key) - (funcall (resource-destructor (gethash key resources-table))) - (setf (resource-time (gethash key resources-table)) nil)) + (funcall (get-rdestructor key)) + (setf (get-rtime key) nil)) + + (defun expire-resource (key &optional (now (SDL_GetTicks))) + (let ((time (get-rtime key))) + (cond ((and (numberp time) (> (- now time) expiration-time)) (free-resource key))))) + + (defun expire-resources () + (maphash (lambda (key res) (expire-resource key)) resources-table)) (defun free-all-resources () (maphash (lambda (key res) (free-resource key)) resources-table))) -;;; Connection with the GUI -(let (socket) - (defun connect-to-gui () - (setq socket (si::socket 1984 :host "localhost"))) +;;; Gacela Server for development mode +(let (socket clients) + (defun start-server (port) + (when (null socket) (setq socket (si::socket port :server #'eval-from-clients)))) + + (defun check-server-connections () + (when (and socket (si::listen socket)) (push (si:accept socket) clients))) - (defun eval-from-gui () - (cond ((and socket (listen socket)) (eval (read socket)))))) + (defun eval-from-clients () + (dolist (cli clients) (when (si::listen cli) (eval (read cli)))))) ;;; GaCeLa Functions @@ -232,23 +249,30 @@ (init-video-mode) (SDL_WM_SetCaption ,title "") (init-frame-time) + (check-server-connections) + (eval-from-clients) + (refresh-running-mobs) (process-events) (do () ((quit?)) (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) + (logic-mobs) + (render-mobs) (glLoadIdentity) ,@code (SDL_GL_SwapBuffers) (delay-frame) (init-frame-time) + (check-server-connections) + (eval-from-clients) + (refresh-running-mobs) (process-events) (setq running nil)))) (defun quit-game () -; (free-all-resources) + (free-all-resources) ; (quit-audio) -; (quit-ttf) (quit-video-mode) -; (quit-all-procs) + (quit-all-mobs) ; (clear-events) ; (quit-events) (quit-sdl))