Now using OpenGL-VBOs.

[uxul-world.git] / animation.lisp

diff --git a/animation.lisp b/animation.lisp
index c64a20a..fdec198 100755 (executable)
--- a/animation.lisp
+++ b/animation.lisp
@@ -1,12 +1,9 @@
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
 
-;; Basic definitions for animations. Needs lispbuilder-sdl.
+;; Basic definitions for animations.
 
 (in-package :uxul-world)
 
-(defparameter *zoom-ash* -1)
-(defmacro zoom-trans (x) `(ash ,x *zoom-ash*))
-
 (defparameter *graphics-table* nil)
 
 ;; the functions may assume that the contents of a graphics-file -
@@ -20,22 +17,18 @@
 ;;                  :accessor images
 ;; ;                :type (simple-array 'sdl:surface (*))
 ;;                  :documentation "Array with the images")
-   (images-2x :initarg :images-2x
-             :initform (make-array (list 0) :element-type 'sdl:surface)
-             :accessor images-2x
-             :documentation "Array of double-sized images")
-   (images-1x :initarg :images-1x
-             :initform (make-array (list 0) :element-type 'sdl:surface)
-             :accessor images-1x
-             :documentation "Array of normal-sized images")
-   (images-.5x :initarg :images-.5x
-              :initform (make-array (list 0) :element-type 'sdl:surface)
-              :accessor images-.5x
-              :documentation "Array of half-sized images")
-   (images-.25x :initarg :images-.25x
-               :initform (make-array (list 0) :element-type 'sdl:surface)
-               :accessor images-.25x
-               :documentation "Array of quarter-sized images")       
+   (full-widths :initarg :full-widths
+               :initform (make-array (list 0))
+               :accessor full-widths
+               :documentation "Widths of images")
+   (full-heights :initarg :full-heights
+               :initform (make-array (list 0))
+               :accessor full-heights
+               :documentation "Heights of images")
+   (images :initarg :images
+          :initform (make-array (list 0))
+          :accessor images
+          :documentation "Array of images")
    (sprite-image-number :initform 0
                        :initarg :sprite-image-number
                        :accessor sprite-image-number
@@ -75,18 +68,6 @@ will be used to minimize the number of file-accesses for loading
 animations. For any animation created from a file by the api from
 below, this will refer to an animation in the *graphics-table*." )))
 
-(defmethod images ((obj animation))
-  (cond
-    ((= *zoom-ash* 0)
-     (images-2x obj))
-    ((= *zoom-ash* -1)
-     (images-1x obj))
-    ((= *zoom-ash* -2)
-     (images-.5x obj))
-    ((= *zoom-ash* -3)
-     (images-.25x obj))))
-
-
 (defmethod draw ((obj animation))
   (when (not (<= (sprite-delay obj) 0)) ;<=, because -a means "paused,
                                        ;but a is the delay when
@@ -97,9 +78,11 @@ below, this will refer to an animation in the *graphics-table*." )))
       (setf (already-jumped obj) 0)
       (setf (sprite-image-number obj) (mod (+ 1 (sprite-image-number obj)) (length (images obj))))))
   (when (visible obj)
-    (sdl:draw-surface-at-* (elt (images obj) (sprite-image-number obj))
-                          (zoom-trans (+ *current-translation-x* (round (x obj))))
-                          (zoom-trans (+ *current-translation-y* (round (y obj)))))))
+    (make-quad (elt (images obj) (sprite-image-number obj))
+              (round (x obj))
+              (round (y obj))
+              (elt (full-widths obj) (sprite-image-number obj))
+              (elt (full-heights obj) (sprite-image-number obj)))))
 
 ;additional methods to make life easier
 (defmethod pause ((obj animation))
@@ -126,46 +109,12 @@ below, this will refer to an animation in the *graphics-table*." )))
   "rewind the animation"
   (setf (slot-value obj 'sprite-image-number) 0))
 
-#|(defun load-png-image (filename)
-  (sdl-image:load-image (gethash filename *file-table*) :image-type :PNG :alpha 1 )) ;; :alpha t))
-
-(defun hashed-load-image (filename)
-  "loads an image by its filename, if it wasnt loaded yet. returns a
-reference, if the current filename already exists."
-  (let ((ret (gethash filename *graphics-table* nil)))
-    (cond
-      (ret ret)
-      (T
-       (setf ret (load-png-image filename))
-       (setf (gethash filename *graphics-table*) ret)
-       ret))))|#
-
 (defun make-animation (frame-skip &rest image-list)
   "Create an animation from the list of animation-names given in the
 images-variable."
+  ;(format t "make-animation is being called~%")
   (make-instance 'animation
-                :images-2x (mapcar
-                            #'(lambda (x)
-                                (sdl:convert-surface :surface (sdl-image:load-image
-                                                               (car x)
-                                                               :image-type :PNG :alpha 1 )))
-                            image-list)
-                :images-1x (mapcar
-                            #'(lambda (x)
-                                (sdl:convert-surface :surface (sdl-image:load-image
-                                                               (cadr x)
-                                                               :image-type :PNG :alpha 1 )))
-                            image-list)
-                :images-.5x (mapcar
-                            #'(lambda (x)
-                                (sdl:convert-surface :surface (sdl-image:load-image
-                                                               (caddr x)
-                                                               :image-type :PNG :alpha 1 )))
-                            image-list)
-                :images-.25x (mapcar
-                            #'(lambda (x)
-                                (sdl:convert-surface :surface (sdl-image:load-image
-                                                               (cadddr x)
-                                                               :image-type :PNG :alpha 1 )))
-                            image-list)
+                :full-widths (mapcar #'car image-list)
+                :full-heights (mapcar #'cadr image-list)
+                :images (mapcar #'cddr image-list)
                 :sprite-delay frame-skip))
\ No newline at end of file