-;;; 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 -
;; :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
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
(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))
"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 #'bmp-width image-list)
+ :full-heights (mapcar #'bmp-height image-list)
+ :images (mapcar #'load-bmp-blob-into-texture
+ image-list)
:sprite-delay frame-skip))
\ No newline at end of file