From 470725f4a2f682d02fb15183cc596c7fa5c7b761 Mon Sep 17 00:00:00 2001 From: christoph Date: Sun, 2 Jan 2011 20:27:03 +0100 Subject: [PATCH] Removed some boilerplate. --- animation.lisp | 72 ++++++++++-------------------------------------- draw.lisp | 4 +-- files.lisp | 11 ++------ leveleditor.lisp | 2 +- opengl.lisp | 4 +-- 5 files changed, 21 insertions(+), 72 deletions(-) diff --git a/animation.lisp b/animation.lisp index a4da80a..f2825aa 100755 --- a/animation.lisp +++ b/animation.lisp @@ -4,9 +4,6 @@ (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 - @@ -23,27 +20,15 @@ (full-widths :initarg :full-widths :initform (make-array (list 0)) :accessor full-widths - :documentation "Widths of images-1x") + :documentation "Widths of images") (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)) - :accessor images-2x - :documentation "Array of double-sized images") - (images-1x :initarg :images-1x - :initform (make-array (list 0)) - :accessor images-1x - :documentation "Array of normal-sized images") - (images-.5x :initarg :images-.5x - :initform (make-array (list 0)) - :accessor images-.5x - :documentation "Array of half-sized images") - (images-.25x :initarg :images-.25x - :initform (make-array (list 0)) - :accessor images-.25x - :documentation "Array of quarter-sized images") + :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 @@ -83,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 @@ -106,15 +79,10 @@ below, this will refer to an animation in the *graphics-table*." ))) (setf (sprite-image-number obj) (mod (+ 1 (sprite-image-number obj)) (length (images obj)))))) (when (visible 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*)) - -))) + (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)) @@ -146,20 +114,8 @@ below, this will refer to an animation in the *graphics-table*." ))) 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) (load-bmp-blob-into-texture (car x))) - image-list) - :images-1x (mapcar - #'(lambda (x) (load-bmp-blob-into-texture (cadr x))) - image-list) - :images-.5x (mapcar - #'(lambda (x) (load-bmp-blob-into-texture (caddr x))) - image-list) - :images-.25x (mapcar - #'(lambda (x) (load-bmp-blob-into-texture (cadddr x))) - 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 diff --git a/draw.lisp b/draw.lisp index 5c4761d..a9988a6 100755 --- a/draw.lisp +++ b/draw.lisp @@ -28,9 +28,9 @@ (defmethod draw ((obj room)) (let ((*current-translation-x* - (* 2 (- 400 (x (graphic-centralizer obj))))) + (* (- +screen-width+ (x (graphic-centralizer obj))))) (*current-translation-y* - (* 2 (- 300 (y (graphic-centralizer obj)))))) + (* (- +screen-height+ (y (graphic-centralizer obj)))))) (draw-background *current-translation-x* *current-translation-y*) (gl:scale *zoomx* (- *zoomy*) 1) (gl:translate *current-translation-x* *current-translation-y* 0) diff --git a/files.lisp b/files.lisp index 07808be..0a880d1 100755 --- a/files.lisp +++ b/files.lisp @@ -18,24 +18,17 @@ (h (bmp-height img))) (uxul-world::resize-bmp-blob img (max 1 (floor (/ w a))) (max 1 (floor (/ h a)))))) -(defun all-sizes (img) - (list img - (ash-sized-image img 2) - (ash-sized-image img 4) - (ash-sized-image img 8))) - (defun init-bmp-file (file) "Load an image file into a Variable. Set |filename| (without .png and path) to a list with all sizes of that image." - (si (pathname-name file) - (all-sizes + (si (pathname-name file) (with-open-file (in file :element-type '(unsigned-byte 8)) (let* ((length (file-length in)) (content (make-array (list length) :element-type '(unsigned-byte 8) :adjustable nil))) (read-sequence content in) - content))))) + content)))) (defun bmp-p (file) "Is the file relevant for initialization? So far only .png-files are diff --git a/leveleditor.lisp b/leveleditor.lisp index c70c706..5700060 100755 --- a/leveleditor.lisp +++ b/leveleditor.lisp @@ -52,7 +52,7 @@ (defun stretched-image (imgs) "Resize that image to 32x32 and convert it into a ppm." (bmp-to-gif - (uxul-world::resize-bmp-blob (car imgs) 32 32))) + (uxul-world::resize-bmp-blob imgs 32 32))) (defun annotated-image (img ann) "Add a (lower-left) annotation." diff --git a/opengl.lisp b/opengl.lisp index 907aa6d..5337ae7 100644 --- a/opengl.lisp +++ b/opengl.lisp @@ -16,8 +16,8 @@ id)) (defun make-quad (id x y w h) - (setf x (- (+ x x) +screen-width+ )) - (setf y (- (+ y y) +screen-height+)) + (setf x (- x +screen-width+ )) + (setf y (- y +screen-height+)) (gl:bind-texture :texture-2d id) (gl:with-primitive :quads (gl:tex-coord 0 0) (gl:vertex x (+ y h)) -- 2.20.1