(no commit message)

[gacela.git] / gacela.lisp

diff --git a/gacela.lisp b/gacela.lisp
index 140f0edbcdbd5dcccbb337261786f023e9a7c648..cd29c3e7e8a1a4a3c758eae9d975f275cba00cb9 100644 (file)
--- 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,15 +126,13 @@
     (glLoadIdentity)
     t))
 
-(defun copy-surface (source)
-  (cond ((surface-p source)
-        (let ((new-surface
-               (make-surface :address (copy-SDL_Surface (surface-address source))
-                             :clip-w (surface-clip-w source)
-                             :clip-h (surface-clip-h source)
-                             :shape (surface-shape source))))
-          (set-resource 'image new-surface (gentemp))
-          new-surface))))
+(let ((current-color '(1 1 1 1)))
+  (defun get-current-color ()
+    current-color)
+
+  (defun set-current-color (red green blue &optional (alpha 1))
+    (setq current-color (list red green blue alpha))
+    (glColor4f red green blue alpha)))
 
 (defun load-image (image-file &key (transparent-color nil))
   (init-video-mode)
@@ -246,39 +252,26 @@
 
 
 ;;; Resources Manager
-(defstruct resource address free-function object)
+(defstruct resource plist free-function time)
+
+(defun make-texture (&key filename min-filter mag-filter)
+  `(:type texture :filename ,filename :min-filter ,min-filter :mag-filter ,mag-filter))
 
 (let ((resources-table (make-hash-table :test 'equal)))
 
-  (defun set-resource (type object &rest key)
-    (let ((res
-          (cond ((surface-p object)
-                 (make-resource :address (surface-address object)
-                                :free-function #'SDL_FreeSurface
-                                :object object))
-                ((font-p object)
-                 (make-resource :address (font-address object)
-                                :free-function #'TTF_CloseFont
-                                :object object))
-                ((cp-space-p object)
-                 (make-resource :address (cp-space-address object)
-                                :free-function #'cpSpaceFree
-                                :object object))
-                ((cp-body-p object)
-                 (make-resource :address (cp-body-address object)
-                                :free-function #'cpBodyFree
-                                :object object))
-                ((cp-shape-p object)
-                 (make-resource :address (cp-shape-address object)
-                                :free-function #'cpShapeFree
-                                :object object))
-                (t nil))))
-      (cond (res (setf (gethash `(,type ,@key) resources-table) res)))))
-
-  (defun get-resource (type &rest key)
-    (let ((resource (gethash `(,type ,@key) resources-table)))
+  (defun set-resource (key plist free-function &key static)
+    (setf (gethash key resources-table)
+         (make-resource :plist plist
+                        :free-function free-function
+                        :time (if static -1 (SDL_GetTicks)))))
+
+  (defun get-resource (key)
+    (let ((resource (gethash key resources-table)))
       (cond ((null resource) nil)
-           (t (resource-object resource)))))
+           (t (cond ((/= (resource-time resource) -1)
+                     (setf (resource-time resource) (SDL_GetTicks))
+                     (setf (gethash key resources-table) resource)))
+              (resource-plist resource)))))
 
   (defun free-all-resources ()
     (maphash (lambda (key res) (funcall (resource-free-function res) (resource-address res)))
@@ -296,18 +289,6 @@
 
 
 ;;; GaCeLa Functions
-;(defun game-loop (code)
-;  (process-events)
-;  (cond ((quit?) nil)
-;      (t
-;       (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
-;       (glLoadIdentity)
-;       (translate 0 0 *zoom*)
-;       (funcall code)
-;       (SDL_GL_SwapBuffers)
-;       (SDL_Delay (- *gacela-freq* (rem (SDL_GetTicks) *gacela-freq*)))
-;       (game-loop code))))
-
 (let (commands)
   (defun prog-command (command)
     (setq commands (cons command commands)))
@@ -351,19 +332,6 @@
         (process-events)
         (setq running nil))))
 
-;(defun run-game ()
-;  (init-video-mode)
-;  (SDL_WM_SetCaption *title-screen* "")
-;  (refresh-active-procs)
-;  (enjoy!)
-;  (do () ((quit?))
-;      (process-events)
-;      (logic-procs)
-;      (motion-procs)
-;      (refresh-active-procs)
-;      (refresh-screen)
-;      (SDL_Delay (- *gacela-freq* (rem (SDL_GetTicks) *gacela-freq*)))))
-
 (defun quit-game ()
 ;  (free-all-resources)
 ;  (quit-audio)