1 ;;; Copyright 2009-2011 Christoph Senjak
3 ;; This file declares the constants for loading different files and
6 (in-package :uxul-world)
9 (setf (symbol-value (intern var)) val))
11 (defun stretch-image (x y img)
12 "Resize that file to x times y."
13 (uxul-world::resize-bmp-blob img x y))
15 ;; (defun init-bmp-file (file)
16 ;; "Load an image file into a Variable. Set |filename| (without .png
17 ;; and path) to a list with all sizes of that image."
18 ;; (si (pathname-name file)
19 ;; (with-open-file (in file :element-type '(unsigned-byte 8))
20 ;; (let* ((length (file-length in))
21 ;; (content (make-array (list length)
22 ;; :element-type '(unsigned-byte 8)
24 ;; (read-sequence content in)
28 "Is the file relevant for initialization? So far only .png-files are
30 (string= (pathname-type file) "bmp"))
32 ;; (defun init-bmp-files ()
33 ;; (cl-fad:walk-directory
34 ;; (asdf:component-pathname (asdf:find-system :uxul-world))
35 ;; #'init-bmp-file :test #'bmp-p))
37 (defvar *spritesheet*)
38 (defvar *spritesheet-id*)
41 (defun init-bmp-files ()
42 (let* ((names (remove-if-not #'bmp-p
43 (cl-fad:list-directory
44 (asdf:component-pathname
45 (asdf:find-system :uxul-world)))))
46 (number (length names))
47 (imagedata (mapcar #'load-file-to-sequence names))
50 (bmp-pixel-data x :destructive t))
52 (widths (mapcar #'bmp-width imagedata))
53 (heights (mapcar #'bmp-height imagedata))
54 (max-width (apply #'max widths))
55 (max-height (apply #'max heights))
56 ;; minimize max-height * optimal-x-num + max-width *
57 ;; optimal-y-num, keeping optimal-x-num * optimal-y-num
58 ;; constant at the number of files (of course, round
60 (optimal-x-num (ceiling
61 (sqrt (/ (* max-height number) max-width))))
62 (optimal-y-num (ceiling
63 (sqrt (/ (* max-width number) max-height))))
64 ;; find the smallest powers of two such that both fit in it
65 (sidelength (expt 2 (max
66 (ceiling (log (* max-width optimal-x-num) 2))
67 (ceiling (log (* max-height optimal-y-num) 2)))))
68 (new-image-data (make-array (list (* 4 sidelength sidelength))
69 :element-type '(unsigned-byte 8)
71 :initial-element #x00))
75 (lambda (name pixels width height)
76 (blit-image cx* cy* width height pixels
77 sidelength sidelength new-image-data)
78 (si (pathname-name name)
80 ,@(mapcar #'(lambda (x) (/ x sidelength 1.0))
81 (list cx* cy* (+ cx* width) (+ cy* height)))))
83 (cond ((= cx optimal-x-num)
87 (T (incf cx* max-width))))
88 names pixeldata widths heights)
89 (setf *spritesheet* (list new-image-data sidelength))))
93 "Load the relevant files into variables"