X-Git-Url: http://uxul.de/gitweb/?p=uxul-world.git;a=blobdiff_plain;f=files.lisp;fp=files.lisp;h=3d1a253d63a7d547d98c0f7336193f05a7fe3242;hp=0a880d1e24b0639e9d57cd6f3ab12bbfcbe76507;hb=fe47814b2cd1ec57db67e494ff48faae46ffe21c;hpb=470725f4a2f682d02fb15183cc596c7fa5c7b761

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"