From: christoph Date: Sun, 2 Jan 2011 22:18:08 +0000 (+0100) Subject: Creating a spritesheet instead of many surfaces. X-Git-Url: http://uxul.de/gitweb/?a=commitdiff_plain;h=fe47814b2cd1ec57db67e494ff48faae46ffe21c;p=uxul-world.git Creating a spritesheet instead of many surfaces. (A step towards VBOs) --- diff --git a/animation.lisp b/animation.lisp index f2825aa..fdec198 100755 --- a/animation.lisp +++ b/animation.lisp @@ -114,8 +114,7 @@ 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 #'bmp-width image-list) - :full-heights (mapcar #'bmp-height image-list) - :images (mapcar #'load-bmp-blob-into-texture - 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 diff --git a/bmp.lisp b/bmp.lisp index 24ba92e..3597045 100755 --- a/bmp.lisp +++ b/bmp.lisp @@ -115,6 +115,17 @@ all." :displaced-index-offset o) (subseq sequence o (+ o l))))) +(defun blit-image (x y src-width src-height src-blob + dst-width dst-height dst-blob) + (declare (ignore dst-height)) + (do ((cx 0 (1+ cx))) ((= cx src-width)) + (do ((cy 0 (1+ cy))) ((= cy src-height)) + (let ((src-pos (* 4 (+ cx (* cy src-width)))) + (dst-pos (* 4 (+ (+ x cx) (* (+ y cy) dst-width))))) + (do ((i 0 (1+ i))) ((= i 4)) + (setf (elt dst-blob (+ i dst-pos)) + (elt src-blob (+ i src-pos)))))))) + (defun resize-pixeldata (argb-pixeldata old-width old-height new-width new-height &optional (new-pixeldata (make-array (list (* 4 new-width new-height)) diff --git a/files.lisp b/files.lisp index 0a880d1..3d1a253 100755 --- a/files.lisp +++ b/files.lisp @@ -12,33 +12,81 @@ "Resize that file to x times y." (uxul-world::resize-bmp-blob img x y)) -(defun ash-sized-image (img a) - "Calculate an image of half/eighth/quarter of the size." - (let ((w (bmp-width img)) - (h (bmp-height img))) - (uxul-world::resize-bmp-blob img (max 1 (floor (/ w a))) (max 1 (floor (/ h a)))))) - -(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) - (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)))) +;; (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) +;; (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)))) (defun bmp-p (file) "Is the file relevant for initialization? So far only .png-files are relevant." (string= (pathname-type file) "bmp")) +;; (defun init-bmp-files () +;; (cl-fad:walk-directory +;; (asdf:component-pathname (asdf:find-system :uxul-world)) +;; #'init-bmp-file :test #'bmp-p)) + +(defvar *spritesheet*) +(defvar *spritesheet-id*) + (defun init-bmp-files () - (cl-fad:walk-directory - (asdf:component-pathname (asdf:find-system :uxul-world)) - #'init-bmp-file :test #'bmp-p)) + (let* ((names (remove-if-not #'bmp-p + (cl-fad:list-directory + (asdf:component-pathname + (asdf:find-system :uxul-world))))) + (number (length names)) + (imagedata (mapcar #'load-file-to-sequence names)) + (pixeldata (mapcar + (lambda (x) + (bmp-pixel-data x :destructive t)) + imagedata)) + (widths (mapcar #'bmp-width imagedata)) + (heights (mapcar #'bmp-height imagedata)) + (max-width (apply #'max widths)) + (max-height (apply #'max heights)) + ;; minimize max-height * optimal-x-num + max-width * + ;; optimal-y-num, keeping optimal-x-num * optimal-y-num + ;; constant at the number of files (of course, round + ;; everything up) + (optimal-x-num (ceiling + (sqrt (/ (* max-height number) max-width)))) + (optimal-y-num (ceiling + (sqrt (/ (* max-width number) max-height)))) + ;; find the smallest powers of two such that both fit in it + (sidelength (expt 2 (max + (ceiling (log (* max-width optimal-x-num) 2)) + (ceiling (log (* max-height optimal-y-num) 2))))) + (new-image-data (make-array (list (* 4 sidelength sidelength)) + :element-type '(unsigned-byte 8) + :adjustable nil + :initial-element #x00)) + (cx 0) (cy 0) + (cx* 0) (cy* 0)) + (mapcar + (lambda (name pixels width height) + (blit-image cx* cy* width height pixels + sidelength sidelength new-image-data) + (si (pathname-name name) + `(,width ,height + ,@(mapcar #'(lambda (x) (/ x sidelength 1.0)) + (list cx* cy* (+ cx* width) (+ cy* height))))) + (incf cx) + (cond ((= cx optimal-x-num) + (incf cy) + (incf cy* max-height) + (setf cx 0 cx* 0)) + (T (incf cx* max-width)))) + names pixeldata widths heights) + (setf *spritesheet* (list new-image-data sidelength)))) + (defun init-files () "Load the relevant files into variables" diff --git a/game.lisp b/game.lisp index 25ac600..1c02cc0 100755 --- a/game.lisp +++ b/game.lisp @@ -35,8 +35,8 @@ drawn (for very slow computers)" (gl:hint :perspective-correction-hint :nicest) - (let ((*graphics-table* (make-hash-table :test #'equal)) + (*spritesheet-id* (load-spritesheet)) (*zoomx* (/ 1.0 +screen-width+)) (*zoomxi* (/ .01 +screen-width+)) (*zoomy* (/ 1.0 +screen-height+)) diff --git a/opengl.lisp b/opengl.lisp index 5337ae7..61c8e90 100644 --- a/opengl.lisp +++ b/opengl.lisp @@ -15,13 +15,26 @@ (gl:flush) id)) -(defun make-quad (id x y w h) - (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)) - (gl:tex-coord 1 0) (gl:vertex (+ x w) (+ y h)) - (gl:tex-coord 1 1) (gl:vertex (+ x w) y) - (gl:tex-coord 0 1) (gl:vertex x y))) +(defun load-spritesheet () + (let* + ((id (car (gl:gen-textures 1))) + (wh (cadr *spritesheet*)) + (pix (car *spritesheet*))) + (gl:bind-texture :texture-2d id) + (gl:tex-image-2d :texture-2d 0 :rgba8 wh wh 0 :bgra :unsigned-byte pix) + (gl:tex-parameter :texture-2d :texture-min-filter :linear) + (gl:tex-parameter :texture-2d :texture-mag-filter :linear) + (gl:flush) + id)) + +(defun make-quad (imgs x y w h) + (destructuring-bind (x1 y1 x2 y2) imgs + (setf x (- x +screen-width+)) + (setf y (- y +screen-height+)) + (gl:bind-texture :texture-2d *spritesheet-id*) + (gl:with-primitive :quads + (gl:tex-coord x1 y1) (gl:vertex x (+ y h)) + (gl:tex-coord x2 y1) (gl:vertex (+ x w) (+ y h)) + (gl:tex-coord x2 y2) (gl:vertex (+ x w) y) + (gl:tex-coord x1 y2) (gl:vertex x y))))