summaryrefslogtreecommitdiff
path: root/imbricate.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'imbricate.lisp')
-rw-r--r--imbricate.lisp52
1 files changed, 31 insertions, 21 deletions
diff --git a/imbricate.lisp b/imbricate.lisp
index 14f15e9..7fe10a7 100644
--- a/imbricate.lisp
+++ b/imbricate.lisp
@@ -26,7 +26,7 @@
:type fixnum)))
-(defun rect-area (r)
+(defun area (r)
(* (rect-width r) (rect-height r)))
(defun contains-point-p (r px py)
@@ -58,10 +58,9 @@
(cons (+ dx (car pt))
(+ dy (cdr pt))))
-(defun left-most (rect) (rect-x rect))
+
(defun right-most (rect) (1- (+ (rect-x rect) (rect-width rect))))
(defun bottom-most (rect) (1- (+ (rect-y rect) (rect-height rect))))
-(defun top-most (rect ) (rect-y rect))
(defun corners (rect)
(list (top-left rect)
@@ -99,19 +98,25 @@
(defun validly-positioned-p (plan tile)
+ "A tile has a valid position if the plan rectangle contains the tile
+rectangle, and if the tile does not intersect any other tile already
+positioned."
(and (contains-point-p plan (right-most tile) (bottom-most tile))
(not (some (lambda (other) (intersects-p tile other)) (positioned plan)))))
(defun position-tile (plan tile)
- "finds a place for the tile in the tilesheet under construction and
-places the tile into the 'positioned' list of the corner plan
-instance. "
+ "Places the tile into the plan, increasing the dimensions of the
+plan when necessary, and updates the plan's internal state to account
+for the new tile.
+
+Modifies both the tile and the plan."
+ ;; 1. search for a condidate position
(loop :for (x . y) :in (candidates plan)
:do (setf (rect-x tile) x
(rect-y tile) y)
:until (validly-positioned-p plan tile))
- ;; if no position was found, set a position based
- ;; on the current size of the tilesheet
+ ;; 2. If no position was found, set a position based
+ ;; on the current size of the plan rectangle
(unless (validly-positioned-p plan tile)
(with-slots (width height) plan
(if (< width height)
@@ -119,14 +124,12 @@ instance. "
(rect-y tile) 0)
(setf (rect-x tile) 0
(rect-y tile) height))))
-
- ;; update width and height of the sheet
+ ;; 3. update width and height of the plan
(setf (rect-width plan) (max (rect-width plan)
(1+ (right-most tile)))
(rect-height plan) (max (rect-height plan)
(1+ (bottom-most tile))))
-
- ;; update the corner plan
+ ;; 4. update candidate corners
(push tile (positioned plan))
(setf (candidates plan)
(delete (top-left tile)
@@ -140,25 +143,28 @@ instance. "
(defun position-tiles (tiles)
+ "Accepts a list of tiles and returns a plan that arranges them in to
+a compact logical 2d plane"
(let ((plan (make-instance 'sheet-plan))
- (tiles (sort tiles #'> :key #'rect-area)))
+ (tiles (sort tiles #'> :key #'area)))
(dolist (tile tiles plan)
(position-tile plan tile))))
(defun render-sheet (plan)
+ "Generates and returns a single image from a plan."
(let ((sheet (opticl:make-8-bit-rgba-image (rect-width plan) (rect-height plan))))
- (dolist (tile (positioned plan))
+ (dolist (tile (positioned plan) sheet)
(with-slots (x y width height data) tile
(dotimes (px width)
(dotimes (py height)
(setf (opticl:pixel sheet (+ x px) (+ y py) )
- (opticl:pixel data px py ))))))
- sheet))
+ (opticl:pixel data px py ))))))))
(defun make-sheet-info (plan)
+ "Return a list of plists, each describing metadata for one tile."
(mapcar #'tile-meta-info (positioned plan)))
(defun load-tile (path)
@@ -180,6 +186,7 @@ instance. "
(defvar *bad-images* nil)
(defun images-under-dir (dir)
+ "Returns a list of TILE instances for images in the directory tree rooted at DIR."
(let ((images '()))
(uiop:collect-sub*directories
dir
@@ -197,15 +204,17 @@ instance. "
(defun imbricate (dir)
+ "Given a directory, returns three values:
+
+1. An array representing representing a tilesheet for the images under DIR.
+2. A list of plists containing metainformation for the tiles in the tile sheet
+3. A list of paths of those images that could not be succesfully loaded."
(let ((*bad-images* nil)
(plan (position-tiles
(images-under-dir dir))))
(values
-
(render-sheet plan)
-
(make-sheet-info plan)
-
*bad-images*)))
(defun imbricate-and-save (dir save-to title)
@@ -216,6 +225,7 @@ instance. "
(ensure-directories-exist png-path)
(with-open-file (out info-path :direction :output :if-exists :supersede)
(print info out))
- (with-open-file (out bad-path :direction :output :if-exists :supersede)
- (print bad out))
+ (when bad
+ (with-open-file (out bad-path :direction :output :if-exists :supersede)
+ (print bad out)))
(opticl:write-png-file png-path sheet))))