Creating a spritesheet instead of many surfaces.

(A step towards VBOs)

diff --git a/animation.lisp b/animation.lisp
index f2825aa..fdec198 100755 (executable)
--- 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 (executable)
--- a/bmp.lisp
+++ b/bmp.lisp
@@ -115,6 +115,17 @@ all."
                    :displaced-index-offset o)\r
        (subseq sequence o (+ o l)))))\r
 \r
+(defun blit-image (x y src-width src-height src-blob\r
+                  dst-width dst-height dst-blob)\r
+  (declare (ignore dst-height))\r
+  (do ((cx 0 (1+ cx))) ((= cx src-width))\r
+    (do ((cy 0 (1+ cy))) ((= cy src-height))\r
+      (let ((src-pos (* 4 (+ cx (* cy src-width))))\r
+           (dst-pos (* 4 (+ (+ x cx) (* (+ y cy) dst-width)))))\r
+       (do ((i 0 (1+ i))) ((= i 4))\r
+         (setf (elt dst-blob (+ i dst-pos))\r
+               (elt src-blob (+ i src-pos))))))))\r
+\r
 (defun resize-pixeldata\r
     (argb-pixeldata old-width old-height new-width new-height\r
      &optional (new-pixeldata (make-array (list (* 4 new-width new-height))\r

diff --git a/files.lisp b/files.lisp
index 0a880d1..3d1a253 100755 (executable)
--- 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 (executable)
--- 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 (file)
--- a/opengl.lisp
+++ b/opengl.lisp
@@ -15,13 +15,26 @@
     (gl:flush)\r
     id))\r
 \r
-(defun make-quad (id x y w h)\r
-  (setf x (- x +screen-width+ ))\r
-  (setf y (- y +screen-height+))\r
-  (gl:bind-texture :texture-2d id)\r
-  (gl:with-primitive :quads\r
-    (gl:tex-coord 0 0) (gl:vertex x (+ y h))\r
-    (gl:tex-coord 1 0) (gl:vertex  (+ x w) (+ y h))\r
-    (gl:tex-coord 1 1) (gl:vertex (+ x w) y)\r
-    (gl:tex-coord 0 1) (gl:vertex x y)))\r
+(defun load-spritesheet ()\r
+  (let*\r
+      ((id (car (gl:gen-textures 1)))\r
+       (wh (cadr *spritesheet*))\r
+       (pix (car *spritesheet*)))\r
+    (gl:bind-texture :texture-2d id)\r
+    (gl:tex-image-2d :texture-2d 0 :rgba8 wh wh 0 :bgra :unsigned-byte pix)\r
+    (gl:tex-parameter :texture-2d :texture-min-filter :linear)\r
+    (gl:tex-parameter :texture-2d :texture-mag-filter :linear)\r
+    (gl:flush)\r
+    id))\r
+\r
+(defun make-quad (imgs x y w h)\r
+  (destructuring-bind (x1 y1 x2 y2) imgs\r
+    (setf x (- x +screen-width+))\r
+    (setf y (- y +screen-height+))\r
+    (gl:bind-texture :texture-2d *spritesheet-id*)\r
+    (gl:with-primitive :quads\r
+      (gl:tex-coord x1 y1) (gl:vertex x (+ y h))\r
+      (gl:tex-coord x2 y1) (gl:vertex  (+ x w) (+ y h))\r
+      (gl:tex-coord x2 y2) (gl:vertex (+ x w) y)\r
+      (gl:tex-coord x1 y2) (gl:vertex x y))))\r
 \r