files.lisp

   1 ;;; Copyright 2009-2011 Christoph Senjak
   2
   3 ;; This file declares the constants for loading different files and
   4 ;; file-formats.
   5
   6 (in-package :uxul-world)
   7
   8 (defun si (var val)
   9   (setf (symbol-value (intern var)) val))
  10
  11 (defun stretch-image (x y img)
  12   "Resize that file to x times y."
  13   (uxul-world::resize-bmp-blob img x y))
  14
  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)
  23 ;;                                   :adjustable nil)))
  24 ;;         (read-sequence content in)
  25 ;;         content))))
  26
  27 (defun bmp-p (file)
  28   "Is the file relevant for initialization? So far only .png-files are
  29 relevant."
  30   (string= (pathname-type file) "bmp"))
  31
  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))
  36
  37 (defvar *spritesheet*)
  38 (defvar *spritesheet-id*)
  39 (defvar *buffer-id*)
  40
  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))
  48          (pixeldata (mapcar
  49                      (lambda (x)
  50                        (bmp-pixel-data x :destructive t))
  51                      imagedata))
  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
  59          ;; everything up)
  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)
  70                                      :adjustable nil
  71                                      :initial-element #x00))
  72          (cx 0) (cy 0)
  73          (cx* 0) (cy* 0))
  74     (mapcar
  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)
  79            `(,width ,height
  80                     ,@(mapcar #'(lambda (x) (/ x sidelength 1.0))
  81                               (list cx* cy* (+ cx* width) (+ cy* height)))
  82                     ,cx* ,cy*))
  83        (incf cx)
  84        (cond ((= cx optimal-x-num)
  85               (incf cy)
  86               (incf cy* max-height)
  87               (setf cx 0 cx* 0))
  88              (T (incf cx* max-width))))
  89      names pixeldata widths heights)
  90     (setf *spritesheet* (list new-image-data sidelength))
  91     ;; since the output of "setf" kills emacs, I return Nil here ...
  92     nil))
  93
  94
  95 (defun init-files ()
  96   "Load the relevant files into variables"
  97   (init-bmp-files))
  98
  99 (init-files)