X-Git-Url: http://uxul.de/gitweb/?p=uxul-world.git;a=blobdiff_plain;f=animation.lisp;fp=animation.lisp;h=a4da80a62574e27140ca07fe384fe718d6220c25;hp=ec09fc44a737db3d477b3c0b88a0629c8674e72f;hb=32d336f81c7ba63968f935b66d6b601ecf9d400b;hpb=074a5863f985bd9a078f41af96310fd55828df3f

diff --git a/animation.lisp b/animation.lisp
index ec09fc4..a4da80a 100755
--- a/animation.lisp
+++ b/animation.lisp
@@ -1,6 +1,6 @@
-;;; Copyright 2009 Christoph Senjak
+;;; Copyright 2009-2011 Christoph Senjak
 
-;; Basic definitions for animations. Needs lispbuilder-sdl.
+;; Basic definitions for animations.
 
 (in-package :uxul-world)
 
@@ -20,20 +20,28 @@
 ;; 		     :accessor images
 ;; ;		     :type (simple-array 'sdl:surface (*))
 ;; 		     :documentation "Array with the images")
+   (full-widths :initarg :full-widths
+		:initform (make-array (list 0))
+		:accessor full-widths
+		:documentation "Widths of images-1x")
+   (full-heights :initarg :full-heights
+		:initform (make-array (list 0))
+		:accessor full-heights
+		:documentation "Heights of images-1x")
    (images-2x :initarg :images-2x
-	      :initform (make-array (list 0) :element-type 'sdl:surface)
+	      :initform (make-array (list 0))
 	      :accessor images-2x
 	      :documentation "Array of double-sized images")
    (images-1x :initarg :images-1x
-	      :initform (make-array (list 0) :element-type 'sdl:surface)
+	      :initform (make-array (list 0))
 	      :accessor images-1x
 	      :documentation "Array of normal-sized images")
    (images-.5x :initarg :images-.5x
-	       :initform (make-array (list 0) :element-type 'sdl:surface)
+	       :initform (make-array (list 0))
 	       :accessor images-.5x
 	       :documentation "Array of half-sized images")
    (images-.25x :initarg :images-.25x
-		:initform (make-array (list 0) :element-type 'sdl:surface)
+		:initform (make-array (list 0))
 		:accessor images-.25x
 		:documentation "Array of quarter-sized images")	      
    (sprite-image-number :initform 0
@@ -97,9 +105,16 @@ 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))
+	       (zoom-trans (round (x obj)))
+	       (zoom-trans (round (y obj)))
+	       
+	       (ash (elt (full-widths obj)
+				(sprite-image-number obj)) (+ 2 *zoom-ash*))
+	       (ash (elt (full-heights obj)
+				(sprite-image-number obj)) (+ 2 *zoom-ash*))
+
+)))
 
 ;additional methods to make life easier
 (defmethod pause ((obj animation))
@@ -129,28 +144,22 @@ below, this will refer to an animation in the *graphics-table*." )))
 (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
+		 :full-widths (mapcar
+			       #'(lambda (x) (bmp-width (cadr x))) image-list)
+		 :full-heights (mapcar
+				#'(lambda (x) (bmp-height (cadr x))) image-list)
 		 :images-2x (mapcar
-			     #'(lambda (x)
-				 (sdl:convert-surface :surface (sdl:load-image
-								(car x) :alpha 1 )))
+			     #'(lambda (x) (load-bmp-blob-into-texture (car x)))
 			     image-list)
 		 :images-1x (mapcar
-			     #'(lambda (x)
-				 (sdl:convert-surface :surface (sdl:load-image
-								(cadr x)
-								:alpha 1 )))
+			     #'(lambda (x) (load-bmp-blob-into-texture (cadr x)))
 			     image-list)
 		 :images-.5x (mapcar
-			     #'(lambda (x)
-				 (sdl:convert-surface :surface (sdl:load-image
-								(caddr x)
-								:alpha 1 )))
+			     #'(lambda (x) (load-bmp-blob-into-texture (caddr x)))
 			     image-list)
 		 :images-.25x (mapcar
-			     #'(lambda (x)
-				 (sdl:convert-surface :surface (sdl:load-image
-								(cadddr x)
-								:alpha 1 )))
+			     #'(lambda (x) (load-bmp-blob-into-texture (cadddr x)))
 			     image-list)
 		 :sprite-delay frame-skip))
\ No newline at end of file