From 921c5a127c76c30c63451e55cbd5b0c59476a5ed Mon Sep 17 00:00:00 2001 From: Boutade Date: Mon, 15 Apr 2019 13:31:21 -0500 Subject: Added CLI --- imbricate.ros | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index 5828da1..fbdf700 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -1,12 +1,12 @@ -;; #!/bin/sh -;; #|-*- mode:lisp -*-|# -;; #| -;; exec ros -Q -- $0 "$@" -;; |# -;; (progn ;;init forms -;; (ros:ensure-asdf) -;; #+quicklisp(ql:quickload '(imago cl-fad) :silent t) -;; ) +#!/bin/sh +#|-*- mode:lisp -*-|# +#| +exec ros -Q -- $0 "$@" +|# +(progn ;;init forms + (ros:ensure-asdf) + #+quicklisp(ql:quickload '(imago cl-fad) :silent t) + ) (defpackage :ros.script.imbricate.3764151058 (:use :cl)) @@ -136,5 +136,13 @@ (defun main (&rest argv) - (declare (ignorable argv))) + (declare (ignorable argv)) + (destructuring-bind (path target) argv + (let* ((tile-stats (images-under-dir path)) + (packlist (build-packlist tile-stats)) + (tilesheet (pack-images packlist)) + (tile-index (packlist->tile-index packlist))) + (imago:write-png tilesheet (format nil "~a.png" target)) + (write-tile-index tile-index (format nil "~a-index.lisp" target)))) + (format t "ALL DONE~%")) ;;; vim: set ft=lisp lisp: -- cgit v1.2.3 From ed091397779cce2e6c8792825978be26878b7e50 Mon Sep 17 00:00:00 2001 From: Boutade Date: Mon, 15 Apr 2019 13:53:43 -0500 Subject: convert non-rgb images to rgb for copying to tilesheet --- imbricate.ros | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index fbdf700..b25d9d1 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -58,15 +58,20 @@ exec ros -Q -- $0 "$@" "fills grid with T for rectangle x y w h" (do-over-rect x y w h #'(lambda (xi yi) (setf (aref grid xi yi) t)))) +(defun rgb-imagep (img) + (eq (find-class 'imago:rgb-image) + (class-of img))) + (defun pack-images (packlist) "Creates an image and copies the contents of the packlist to that image" (destructuring-bind (cw ch) (packlist-dimensions packlist) (let ((tilesheet (make-instance 'imago:rgb-image :width cw :height ch))) (dolist (spec packlist) (let-when (img (safe-open-image (getf spec :path))) - (imago:copy tilesheet img + (let ((img (if (not (rgb-imagep img)) (imago:convert-to-rgb img) img))) + (imago:copy tilesheet img :dest-x (getf spec :x) - :dest-y (getf spec :y)))) + :dest-y (getf spec :y))))) tilesheet))) (defun packlist->tile-index (packlist) @@ -134,7 +139,6 @@ exec ros -Q -- $0 "$@" (search-loop))) - (defun main (&rest argv) (declare (ignorable argv)) (destructuring-bind (path target) argv -- cgit v1.2.3 From 38fa069479128d49760d01bd1f434f4e880a5564 Mon Sep 17 00:00:00 2001 From: Boutade Date: Mon, 15 Apr 2019 14:59:18 -0500 Subject: changed speed at which grid search increases size --- imbricate.ros | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index b25d9d1..7d419ca 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -134,7 +134,7 @@ exec ros -Q -- $0 "$@" (when (unfilled-over-rect grid x y width height) (return-from search-loop (list x y))))) (progn - (adjust-array grid (list (* 2 gw) (* 2 gh)) :initial-element nil) + (adjust-array grid (list (+ width gw) (+ height gh)) :initial-element nil) (search-loop))))) (search-loop))) @@ -147,6 +147,7 @@ exec ros -Q -- $0 "$@" (tilesheet (pack-images packlist)) (tile-index (packlist->tile-index packlist))) (imago:write-png tilesheet (format nil "~a.png" target)) - (write-tile-index tile-index (format nil "~a-index.lisp" target)))) + (write-tile-index tile-index (format nil "~a-index.lisp" target)) + (write-tile-index *bad-images* (format nil "~a.bad.txt" target)))) (format t "ALL DONE~%")) ;;; vim: set ft=lisp lisp: -- cgit v1.2.3 From 6f912e7d29b37a70decf3270e2581bbc79c15e90 Mon Sep 17 00:00:00 2001 From: Boutade Date: Mon, 15 Apr 2019 15:49:50 -0500 Subject: keep path name in index file --- imbricate.ros | 1 - 1 file changed, 1 deletion(-) diff --git a/imbricate.ros b/imbricate.ros index 7d419ca..bb9d97e 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -78,7 +78,6 @@ exec ros -Q -- $0 "$@" "renames the path1 in the packlist to a nicer name for referring toa tile location" (mapcar #'(lambda (pl) (let ((name (pathname-name (getf pl :path)))) - (remf pl :path) (setf (getf pl :name) name) pl)) packlist)) -- cgit v1.2.3 From 3eee95e0db528a91a8c3f94d726731e2328d07e3 Mon Sep 17 00:00:00 2001 From: Boutade Date: Mon, 15 Apr 2019 16:03:40 -0500 Subject: added readme --- README.org | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 README.org diff --git a/README.org b/README.org new file mode 100644 index 0000000..dfe925c --- /dev/null +++ b/README.org @@ -0,0 +1,61 @@ + +* =imbricate= makes tilesheets for (Lisp) games + + The =imbricate= turns a directory, with possible nexted directories, + containing images of varying sizes into a single tile sheet. The tool also + produces file containing a list of property lists that includes a location and + a name for each image within the sheet. + +** Example + + +: $ ls eg/ +: AcidArrow.png AcidPellet.png Acorn.png Amber.png AncientSpear.png Arrow.png +: AcidBolt.png AcidSac.png AdamantBone.png Amythyst.png Apple.png AstralCloak.png +: +: $ imbricate eg/ example-graphics +: ALL DONE! +: +: $ ls example-graphics* +: example-graphics.bad.txt example-graphics-index.lisp example-graphics.png +: +: $ cat example-graphics-index.lisp +: +: ((:NAME "AstralCloak" :X 0 :Y 0 :PATH +: #P"/tmp/eg/AstralCloak.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "Arrow" :X 0 :Y 30 :PATH +: #P"/tmp/eg/Arrow.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "Apple" :X 0 :Y 60 :PATH +: #P"/tmp/eg/Apple.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "AncientSpear" :X 30 :Y 0 :PATH +: #P"/tmp/eg/AncientSpear.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "Amythyst" :X 30 :Y 30 :PATH +: #P"/tmp/eg/Amythyst.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "Amber" :X 30 :Y 60 :PATH +: #P"/tmp/eg/Amber.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "AdamantBone" :X 60 :Y 0 :PATH +: #P"/tmp/eg/AdamantBone.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "Acorn" :X 60 :Y 30 :PATH +: #P"/tmp/eg/Acorn.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "AcidSac" :X 60 :Y 60 :PATH +: #P"/tmp/eg/AcidSac.png" :WIDTH 30 :HEIGHT 30) +: (:NAME "AcidArrow" :X 0 :Y 90 :PATH +: #P"/tmp/eg/AcidArrow.png" :WIDTH 30 :HEIGHT 30)) + +The =example-graphics.bat.txt= is a file that lists the any images that the +script could not decode as =png= files. Any such files are skipped. + +** Building + +Assuming that you have [[https://github.com/roswell/roswell][roswell]] installed: + +: $ ros use sbcl +: $ git clone https://github.com/thegoofist/imbricate.git +: $ cd imbricate.git +: $ ros build imbricate.git + + + + + + -- cgit v1.2.3 From 3815301f04c5d616c9a1d8f6a42fa8954be1677b Mon Sep 17 00:00:00 2001 From: Boutade Date: Mon, 15 Apr 2019 16:08:45 -0500 Subject: typos --- README.org | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.org b/README.org index dfe925c..4dc3e88 100644 --- a/README.org +++ b/README.org @@ -42,7 +42,7 @@ : (:NAME "AcidArrow" :X 0 :Y 90 :PATH : #P"/tmp/eg/AcidArrow.png" :WIDTH 30 :HEIGHT 30)) -The =example-graphics.bat.txt= is a file that lists the any images that the +The =example-graphics.bad.txt= is a file that lists the any images that the script could not decode as =png= files. Any such files are skipped. ** Building @@ -52,7 +52,7 @@ Assuming that you have [[https://github.com/roswell/roswell][roswell]] installed : $ ros use sbcl : $ git clone https://github.com/thegoofist/imbricate.git : $ cd imbricate.git -: $ ros build imbricate.git +: $ ros build imbricate.ros -- cgit v1.2.3 From 99bbeeb4f1ce181f8b04ed93785b746f2c058332 Mon Sep 17 00:00:00 2001 From: Boutade Date: Tue, 16 Apr 2019 12:03:39 -0500 Subject: refactored for speed, did away with array searching approach --- imbricate.ros | 183 +++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 125 insertions(+), 58 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index bb9d97e..7d4e2d9 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -16,6 +16,10 @@ exec ros -Q -- $0 "$@" `(let ((,var ,test)) (when ,var ,@body))) +(defmacro let-if ((var test) then else) + `(let ((,var ,test)) + (if ,var ,then ,else))) + (defun images-under-dir (dir &key (type "png")) (let ((images '())) (cl-fad:walk-directory @@ -28,7 +32,6 @@ exec ros -Q -- $0 "$@" (defvar *bad-images* '()) - (defun safe-open-image (path) (handler-case (imago:read-image (format nil "~a" path)) (error (c) @@ -37,7 +40,8 @@ exec ros -Q -- $0 "$@" (defun image-stats (img) (list :width (imago:image-width img) - :height (imago:image-height img))) + :height (imago:image-height img) + :img img)) (defun image-area (stat) (* (getf stat :width) @@ -54,30 +58,31 @@ exec ros -Q -- $0 "$@" (setf h (max h (+ (getf img :height) (getf img :y))))) (list w h))) -(defun fill-grid (grid x y w h) - "fills grid with T for rectangle x y w h" - (do-over-rect x y w h #'(lambda (xi yi) (setf (aref grid xi yi) t)))) - (defun rgb-imagep (img) (eq (find-class 'imago:rgb-image) (class-of img))) +(defun to-rgb (img) + (if (not (rgb-imagep img)) + (imago:convert-to-rgb img) + img)) + (defun pack-images (packlist) "Creates an image and copies the contents of the packlist to that image" (destructuring-bind (cw ch) (packlist-dimensions packlist) (let ((tilesheet (make-instance 'imago:rgb-image :width cw :height ch))) (dolist (spec packlist) - (let-when (img (safe-open-image (getf spec :path))) - (let ((img (if (not (rgb-imagep img)) (imago:convert-to-rgb img) img))) - (imago:copy tilesheet img - :dest-x (getf spec :x) - :dest-y (getf spec :y))))) + (let* ((img (to-rgb (getf spec :img)))) + (imago:copy tilesheet img + :dest-x (getf spec :x) + :dest-y (getf spec :y)))) tilesheet))) (defun packlist->tile-index (packlist) "renames the path1 in the packlist to a nicer name for referring toa tile location" (mapcar #'(lambda (pl) (let ((name (pathname-name (getf pl :path)))) + (remf pl :img) (setf (getf pl :name) name) pl)) packlist)) @@ -89,53 +94,115 @@ exec ros -Q -- $0 "$@" (print tile-index out))) -(defun build-packlist (image-list) - (let* ((image-list (sort image-list #'> :key #'image-area)) - (side-dim (ceiling (sqrt (minimum-required-area image-list)))) - (pack-mask (make-array (list side-dim side-dim) :initial-element nil :adjustable t)) - (pack-list '())) - (dolist (image image-list) - (let ((width (getf image :width)) - (height (getf image :height))) - (destructuring-bind (x y) (find-place-for pack-mask width height) - (fill-grid pack-mask x y width height) - (push (nconc (list :x x :y y) image) pack-list)))) - (reverse pack-list))) ;; biggest image first - - -(defun do-over-rect (x y w h fn) - (loop for xi from x to (+ x w -1) do - (loop for yi from y to (+ y h -1) do - (funcall fn xi yi)))) - - -(defun filled-at (grid x y) - "returns two values. The the second is nil if x y is out of range" - (destructuring-bind (gw gh) (array-dimensions grid) - (if (and (< x gw) (< y gh)) - (values (aref grid x y) t) - (values nil nil)))) - -(defun unfilled-over-rect (grid x y w h) - (do-over-rect x y w h - #'(lambda (xi yi) - (multiple-value-bind (filled in-bounds) (filled-at grid xi yi) - (when (or filled (not in-bounds)) - (return-from unfilled-over-rect nil))))) - t) - -(defun find-place-for (grid width height) - "returns (x y) where a (width X height) sized rectangle will fit into grid" - (labels ((search-loop () - (destructuring-bind (gw gh) (array-dimensions grid) - (do-over-rect 0 0 gw gh - #'(lambda (x y) - (when (unfilled-over-rect grid x y width height) - (return-from search-loop (list x y))))) - (progn - (adjust-array grid (list (+ width gw) (+ height gh)) :initial-element nil) - (search-loop))))) - (search-loop))) +(defun rect (x y w h) (list x y w h)) +(defun rx (r) (first r)) +(defun ry (r) (second r)) +(defun rw (r) (third r)) +(defun rh (r) (fourth r)) +(defun tl (r) (list (rx r) (ry r))) +(defun tr (r) (list (+ (rx r) (rw r)) (ry r))) +(defun br (r) (list (+ (rx r) (rw r)) (+ (ry r) (rh r)))) +(defun bl (r) (list (rx r) (+ (ry r) (rh r)))) +(defun xy-bounds (r) + "returns (left right top bottom)" + (list (rx r) (+ (rx r) (rw r)) + (ry r) (+ (ry r) (rh r)))) + + +(defun inside-rect (r x y) + (destructuring-bind (l r tp b) (xy-bounds r) + (and (<= l x) (< x r) + (<= tp y) (< y b)))) + + +(defun make-corner-keeper () (list 0 0 '() (make-hash-table :test 'equal))) +(defun keeper-w (k) (first k)) +(defun keeper-h (k) (second k)) +(defun (setf keeper-w) (v k) + (setf (first k) v)) +(defun (setf keeper-h) (v k) + (setf (second k) v)) + +(defun keeper-corners (k) (third k)) +(defun (setf keeper-corners) (val k) + (setf (third k) val)) + +(defun visited-corners (k) (fourth k)) + +(defun was-visited (k p) + (gethash p (visited-corners k))) + +(defun visit (k p) + (setf (gethash p (visited-corners k)) t)) + +(defun remove-corner (k c) + (setf (keeper-corners k) + (remove c (keeper-corners k) :test #'equal))) + +(defun prune-corners-behind (k r) + (setf (keeper-corners k) + (remove-if + #'(lambda (xy) + (destructuring-bind (x y) xy + (or + (inside-rect r x y) + (inside-rect r (+ x (rw r) -1) (+ y (rh r) -1)) + (inside-rect r (+ x (rw r) -1) y) + (inside-rect r x (+ y (rh r) -1))))) + + (keeper-corners k)))) + +(defun add-corner (k c) + (unless (was-visited k c) + (visit k c) + (push c (keeper-corners k)))) + +(defun adjust-width (k) + (let ((mx 0) + (my 0)) + (dolist (xy (keeper-corners k)) + (setf mx (max mx (first xy))) + (setf my (max my (second xy)))) + (setf (keeper-w k) mx) + (setf (keeper-h k) my))) + +(defun add-rect (k r) + (remove-corner k (tl r)) + (prune-corners-behind k r) + (add-corner k (tr r)) + (add-corner k (bl r)) + (add-corner k (br r)) + (adjust-width k)) + + +(defun bounds-preserving-corners (k w h) + (let ((kw (keeper-w k)) + (kh (keeper-h k))) + (remove-if + #'(lambda (xy) + (destructuring-bind (x y) xy + (or (< kw (+ x w)) + (< kh (+ y h))))) + (keeper-corners k)))) + +(defun find-space-for (k w h) + (let-if (candidates (bounds-preserving-corners k w h)) + (first candidates) + (if (< (keeper-w k) (keeper-h k)) + (list (keeper-w k) 0) + (list 0 (keeper-h k))))) + +(defun build-packlist (tile-stats) + (let ((tile-stats (sort tile-stats #'> :key #'image-area)) + (ck (make-corner-keeper)) + (packlist '())) + (dolist (stats tile-stats) + (let ((tw (getf stats :width)) + (th (getf stats :height))) + (destructuring-bind (x y) (find-space-for ck tw th) + (add-rect ck (rect x y tw th)) + (push (nconc (list :x x :y y) stats) packlist)))) + packlist)) (defun main (&rest argv) -- cgit v1.2.3 From 40e111c81fc7e0ae2a94f5a3f25bae55787ef95f Mon Sep 17 00:00:00 2001 From: Boutade Date: Tue, 16 Apr 2019 18:18:13 -0500 Subject: concept is speedy enough - some debugging to do specifically, need to complete the intersection check function --- imbricate.ros | 97 +++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 55 insertions(+), 42 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index 7d4e2d9..ab32984 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -20,6 +20,14 @@ exec ros -Q -- $0 "$@" `(let ((,var ,test)) (if ,var ,then ,else))) + +(defmacro match-dolist ((matchform form) &rest body) + (if (listp matchform) + (let ((tmpvar (gensym))) + `(dolist (,tmpvar ,form) + (destructuring-bind ,matchform ,tmpvar ,@body))) + `(dolist (,matchform ,form) ,@body))) + (defun images-under-dir (dir &key (type "png")) (let ((images '())) (cl-fad:walk-directory @@ -109,13 +117,29 @@ exec ros -Q -- $0 "$@" (ry r) (+ (ry r) (rh r)))) -(defun inside-rect (r x y) +(defun inside-rect (r xy) (destructuring-bind (l r tp b) (xy-bounds r) - (and (<= l x) (< x r) - (<= tp y) (< y b)))) + (destructuring-bind (x y) xy + (and (< l x) (< x r) + (< tp y) (< y b))))) + +(defun intersect-p (r1 r2) + (or + (equalp r1 r2) + (inside-rect r1 (tl r2)) + (inside-rect r1 (tr r2)) + (inside-rect r1 (br r2)) + (inside-rect r1 (bl r2)) + (inside-rect r2 (tl r1)) + (inside-rect r2 (tr r1)) + (inside-rect r2 (br r1)) + (inside-rect r2 (bl r1)) + )) ;; TODO add the case checks for edge intersections -(defun make-corner-keeper () (list 0 0 '() (make-hash-table :test 'equal))) + + +(defun make-corner-keeper () (list 0 0 '() (make-hash-table :test 'equal) '())) (defun keeper-w (k) (first k)) (defun keeper-h (k) (second k)) (defun (setf keeper-w) (v k) @@ -135,62 +159,50 @@ exec ros -Q -- $0 "$@" (defun visit (k p) (setf (gethash p (visited-corners k)) t)) +(defun keeper-rects (k) (fifth k)) +(defun (setf keeper-rects) (val k) + (setf (fifth k) val)) + (defun remove-corner (k c) (setf (keeper-corners k) (remove c (keeper-corners k) :test #'equal))) -(defun prune-corners-behind (k r) - (setf (keeper-corners k) - (remove-if - #'(lambda (xy) - (destructuring-bind (x y) xy - (or - (inside-rect r x y) - (inside-rect r (+ x (rw r) -1) (+ y (rh r) -1)) - (inside-rect r (+ x (rw r) -1) y) - (inside-rect r x (+ y (rh r) -1))))) - - (keeper-corners k)))) (defun add-corner (k c) (unless (was-visited k c) (visit k c) (push c (keeper-corners k)))) -(defun adjust-width (k) - (let ((mx 0) - (my 0)) - (dolist (xy (keeper-corners k)) - (setf mx (max mx (first xy))) - (setf my (max my (second xy)))) - (setf (keeper-w k) mx) - (setf (keeper-h k) my))) - (defun add-rect (k r) (remove-corner k (tl r)) - (prune-corners-behind k r) + (push r (keeper-rects k)) (add-corner k (tr r)) (add-corner k (bl r)) - (add-corner k (br r)) - (adjust-width k)) +;; (add-corner k (br r)) + (setf (keeper-w k) (max (first (br r)) + (keeper-w k))) + (setf (keeper-h k) (max (second (br r)) + (keeper-h k)))) -(defun bounds-preserving-corners (k w h) - (let ((kw (keeper-w k)) - (kh (keeper-h k))) - (remove-if - #'(lambda (xy) - (destructuring-bind (x y) xy - (or (< kw (+ x w)) - (< kh (+ y h))))) - (keeper-corners k)))) +(defun intersects-any-tile-p (k r) + (dolist (r2 (keeper-rects k)) + (when (intersect-p r r2) + (return-from intersects-any-tile-p t)))) + +(defun valid-rect (k r) + (and (inside-rect (rect 0 0 (keeper-w k) (keeper-h k)) (br r)) + (not (intersects-any-tile-p k r)))) (defun find-space-for (k w h) - (let-if (candidates (bounds-preserving-corners k w h)) - (first candidates) - (if (< (keeper-w k) (keeper-h k)) - (list (keeper-w k) 0) - (list 0 (keeper-h k))))) + (dolist (xy (keeper-corners k)) + (when (valid-rect k (rect (first xy) (second xy) w h)) + (return-from find-space-for xy))) + ;; if not already-returned, then do: + (if (< (keeper-w k) (keeper-h k)) + (list (keeper-w k) 0) + (list 0 (keeper-h k)))) + (defun build-packlist (tile-stats) (let ((tile-stats (sort tile-stats #'> :key #'image-area)) @@ -200,6 +212,7 @@ exec ros -Q -- $0 "$@" (let ((tw (getf stats :width)) (th (getf stats :height))) (destructuring-bind (x y) (find-space-for ck tw th) + (format t "found space: ~a,~a~%" x y) (add-rect ck (rect x y tw th)) (push (nconc (list :x x :y y) stats) packlist)))) packlist)) -- cgit v1.2.3 From 9e132df8926eb75bb2388f6e6664db2fdcdbccb6 Mon Sep 17 00:00:00 2001 From: Boutade Date: Tue, 16 Apr 2019 18:40:01 -0500 Subject: improved intersection check --- imbricate.ros | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index ab32984..c5eba0c 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -134,9 +134,15 @@ exec ros -Q -- $0 "$@" (inside-rect r2 (tr r1)) (inside-rect r2 (br r1)) (inside-rect r2 (bl r1)) - )) ;; TODO add the case checks for edge intersections - - + ;; if no corner of one is inside the other, then + ;; any edge of one intersects at least one edge of the other + ;; so we check one arbitrarily + (destructuring-bind (left1 right1 top1 bottom1) (xy-bounds r1) + (destructuring-bind (left2 right2 top2 bottom2) (xy-bounds r2) + (and (<= left1 left2) + (< left2 right1) + (<= top2 top1) + (< top1 bottom2)))))) (defun make-corner-keeper () (list 0 0 '() (make-hash-table :test 'equal) '())) @@ -212,7 +218,6 @@ exec ros -Q -- $0 "$@" (let ((tw (getf stats :width)) (th (getf stats :height))) (destructuring-bind (x y) (find-space-for ck tw th) - (format t "found space: ~a,~a~%" x y) (add-rect ck (rect x y tw th)) (push (nconc (list :x x :y y) stats) packlist)))) packlist)) -- cgit v1.2.3 From 8b1053ce16533987f8830298d2d58631a34578ca Mon Sep 17 00:00:00 2001 From: Boutade Date: Tue, 16 Apr 2019 18:51:00 -0500 Subject: added some progress reporting --- imbricate.ros | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/imbricate.ros b/imbricate.ros index c5eba0c..7ae5498 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -29,10 +29,13 @@ exec ros -Q -- $0 "$@" `(dolist (,matchform ,form) ,@body))) (defun images-under-dir (dir &key (type "png")) + (format t "~%Reading images from disk") (let ((images '())) (cl-fad:walk-directory dir (lambda (path) + (format t ".") + (force-output) (let-when (img (and (string= type (pathname-type path)) (safe-open-image path))) (push (nconc (list :path path) (image-stats img)) images)))) @@ -77,9 +80,12 @@ exec ros -Q -- $0 "$@" (defun pack-images (packlist) "Creates an image and copies the contents of the packlist to that image" + (format t "~%Constructing tilesheet") (destructuring-bind (cw ch) (packlist-dimensions packlist) (let ((tilesheet (make-instance 'imago:rgb-image :width cw :height ch))) (dolist (spec packlist) + (format t ".") + (force-output) (let* ((img (to-rgb (getf spec :img)))) (imago:copy tilesheet img :dest-x (getf spec :x) @@ -211,6 +217,7 @@ exec ros -Q -- $0 "$@" (defun build-packlist (tile-stats) + (format t "~%Creating Layout") (let ((tile-stats (sort tile-stats #'> :key #'image-area)) (ck (make-corner-keeper)) (packlist '())) @@ -218,6 +225,8 @@ exec ros -Q -- $0 "$@" (let ((tw (getf stats :width)) (th (getf stats :height))) (destructuring-bind (x y) (find-space-for ck tw th) + (format t ".") + (force-output) (add-rect ck (rect x y tw th)) (push (nconc (list :x x :y y) stats) packlist)))) packlist)) @@ -230,8 +239,10 @@ exec ros -Q -- $0 "$@" (packlist (build-packlist tile-stats)) (tilesheet (pack-images packlist)) (tile-index (packlist->tile-index packlist))) + (format t "~%Writing to disk...") + (force-output) (imago:write-png tilesheet (format nil "~a.png" target)) (write-tile-index tile-index (format nil "~a-index.lisp" target)) (write-tile-index *bad-images* (format nil "~a.bad.txt" target)))) - (format t "ALL DONE~%")) + (format t "~%ALL DONE~%")) ;;; vim: set ft=lisp lisp: -- cgit v1.2.3 From ccccfd0dba5482fed3025ef1e74fa3d324b721c6 Mon Sep 17 00:00:00 2001 From: Boutade Date: Tue, 16 Apr 2019 20:24:43 -0500 Subject: cleaned up code --- imbricate.ros | 22 +--------------------- 1 file changed, 1 insertion(+), 21 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index 7ae5498..2693a3b 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -16,18 +16,6 @@ exec ros -Q -- $0 "$@" `(let ((,var ,test)) (when ,var ,@body))) -(defmacro let-if ((var test) then else) - `(let ((,var ,test)) - (if ,var ,then ,else))) - - -(defmacro match-dolist ((matchform form) &rest body) - (if (listp matchform) - (let ((tmpvar (gensym))) - `(dolist (,tmpvar ,form) - (destructuring-bind ,matchform ,tmpvar ,@body))) - `(dolist (,matchform ,form) ,@body))) - (defun images-under-dir (dir &key (type "png")) (format t "~%Reading images from disk") (let ((images '())) @@ -101,13 +89,11 @@ exec ros -Q -- $0 "$@" pl)) packlist)) - (defun write-tile-index (tile-index file-path) "saves tile-index to file-path as a standard lisp object" (with-open-file (out file-path :direction :output) (print tile-index out))) - (defun rect (x y w h) (list x y w h)) (defun rx (r) (first r)) (defun ry (r) (second r)) @@ -117,12 +103,12 @@ exec ros -Q -- $0 "$@" (defun tr (r) (list (+ (rx r) (rw r)) (ry r))) (defun br (r) (list (+ (rx r) (rw r)) (+ (ry r) (rh r)))) (defun bl (r) (list (rx r) (+ (ry r) (rh r)))) + (defun xy-bounds (r) "returns (left right top bottom)" (list (rx r) (+ (rx r) (rw r)) (ry r) (+ (ry r) (rh r)))) - (defun inside-rect (r xy) (destructuring-bind (l r tp b) (xy-bounds r) (destructuring-bind (x y) xy @@ -150,7 +136,6 @@ exec ros -Q -- $0 "$@" (<= top2 top1) (< top1 bottom2)))))) - (defun make-corner-keeper () (list 0 0 '() (make-hash-table :test 'equal) '())) (defun keeper-w (k) (first k)) (defun keeper-h (k) (second k)) @@ -179,7 +164,6 @@ exec ros -Q -- $0 "$@" (setf (keeper-corners k) (remove c (keeper-corners k) :test #'equal))) - (defun add-corner (k c) (unless (was-visited k c) (visit k c) @@ -190,13 +174,11 @@ exec ros -Q -- $0 "$@" (push r (keeper-rects k)) (add-corner k (tr r)) (add-corner k (bl r)) -;; (add-corner k (br r)) (setf (keeper-w k) (max (first (br r)) (keeper-w k))) (setf (keeper-h k) (max (second (br r)) (keeper-h k)))) - (defun intersects-any-tile-p (k r) (dolist (r2 (keeper-rects k)) (when (intersect-p r r2) @@ -215,7 +197,6 @@ exec ros -Q -- $0 "$@" (list (keeper-w k) 0) (list 0 (keeper-h k)))) - (defun build-packlist (tile-stats) (format t "~%Creating Layout") (let ((tile-stats (sort tile-stats #'> :key #'image-area)) @@ -231,7 +212,6 @@ exec ros -Q -- $0 "$@" (push (nconc (list :x x :y y) stats) packlist)))) packlist)) - (defun main (&rest argv) (declare (ignorable argv)) (destructuring-bind (path target) argv -- cgit v1.2.3 From 4596aa975136d502c6e72a889e2adbf2e9a2172c Mon Sep 17 00:00:00 2001 From: Boutade Date: Sat, 20 Apr 2019 08:48:39 -0500 Subject: added license --- LICENSE | 675 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 675 insertions(+) create mode 100644 LICENSE diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..53d1f3d --- /dev/null +++ b/LICENSE @@ -0,0 +1,675 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. + -- cgit v1.2.3 From c893d53eced92dc620f64b7fe9c264fea6f07f14 Mon Sep 17 00:00:00 2001 From: Boutade Date: Tue, 17 Mar 2020 08:18:19 -0500 Subject: read-image to read-png --- imbricate.ros | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/imbricate.ros b/imbricate.ros index 2693a3b..4683fe2 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -32,7 +32,7 @@ exec ros -Q -- $0 "$@" (defvar *bad-images* '()) (defun safe-open-image (path) - (handler-case (imago:read-image (format nil "~a" path)) + (handler-case (imago:read-png (format nil "~a" path)) (error (c) (push path *bad-images*) nil))) -- cgit v1.2.3 From a8d2adf50c2b1c28c4bcf4564c49327b57cfed5b Mon Sep 17 00:00:00 2001 From: Boutade Date: Thu, 2 Apr 2020 09:13:37 -0500 Subject: swapped out imago for opticl --- imbricate.ros | 52 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 21 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index 4683fe2..961f958 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -5,7 +5,7 @@ exec ros -Q -- $0 "$@" |# (progn ;;init forms (ros:ensure-asdf) - #+quicklisp(ql:quickload '(imago cl-fad) :silent t) + #+quicklisp(ql:quickload '(cl-fad opticl) :silent t) ) (defpackage :ros.script.imbricate.3764151058 @@ -32,14 +32,14 @@ exec ros -Q -- $0 "$@" (defvar *bad-images* '()) (defun safe-open-image (path) - (handler-case (imago:read-png (format nil "~a" path)) + (handler-case (opticl:read-png-file (format nil "~a" path)) (error (c) (push path *bad-images*) nil))) (defun image-stats (img) - (list :width (imago:image-width img) - :height (imago:image-height img) + (list :width (array-dimension img 0) + :height (array-dimension img 1) :img img)) (defun image-area (stat) @@ -57,36 +57,46 @@ exec ros -Q -- $0 "$@" (setf h (max h (+ (getf img :height) (getf img :y))))) (list w h))) -(defun rgb-imagep (img) - (eq (find-class 'imago:rgb-image) - (class-of img))) - (defun to-rgb (img) - (if (not (rgb-imagep img)) - (imago:convert-to-rgb img) - img)) + img) (defun pack-images (packlist) "Creates an image and copies the contents of the packlist to that image" (format t "~%Constructing tilesheet") (destructuring-bind (cw ch) (packlist-dimensions packlist) - (let ((tilesheet (make-instance 'imago:rgb-image :width cw :height ch))) + (let ((tilesheet (make-array (list cw ch 4) :element-type '(unsigned-byte 8)))) (dolist (spec packlist) (format t ".") (force-output) - (let* ((img (to-rgb (getf spec :img)))) - (imago:copy tilesheet img - :dest-x (getf spec :x) - :dest-y (getf spec :y)))) + (let* ((img (getf spec :img))) + (handler-case + (copy-into-img tilesheet img + (getf spec :x) + (getf spec :y)) + (error (e) (push (cons :bad-image-format (getf spec :path)) + *bad-images*))))) tilesheet))) +(defun img-width (img) (array-dimension img 0)) +(defun img-height (img) (array-dimension img 1)) + +(defun copy-into-img (target source dest-x dest-y) + (dotimes (x (img-width source)) + (dotimes (y (img-height source)) + (dotimes (v 4) + (setf (aref target (+ x dest-x) (+ y dest-y) v) + (aref source x y v)))))) + + + (defun packlist->tile-index (packlist) "renames the path1 in the packlist to a nicer name for referring toa tile location" (mapcar #'(lambda (pl) - (let ((name (pathname-name (getf pl :path)))) - (remf pl :img) - (setf (getf pl :name) name) - pl)) + (remf pl :img) + (setf (getf pl :name) + (substitute #\. #\/ (namestring (getf pl :path)))) + (remf pl :path) + pl) packlist)) (defun write-tile-index (tile-index file-path) @@ -221,7 +231,7 @@ exec ros -Q -- $0 "$@" (tile-index (packlist->tile-index packlist))) (format t "~%Writing to disk...") (force-output) - (imago:write-png tilesheet (format nil "~a.png" target)) + (opticl:write-png-file (format nil "~a.png" target) tilesheet) (write-tile-index tile-index (format nil "~a-index.lisp" target)) (write-tile-index *bad-images* (format nil "~a.bad.txt" target)))) (format t "~%ALL DONE~%")) -- cgit v1.2.3 From c133e679f06c1151c466e5660fc82c4f56df7241 Mon Sep 17 00:00:00 2001 From: Boutade Date: Thu, 2 Apr 2020 09:50:13 -0500 Subject: adjustment to how names are formatted --- imbricate.ros | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index 961f958..3e014f9 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -73,7 +73,9 @@ exec ros -Q -- $0 "$@" (copy-into-img tilesheet img (getf spec :x) (getf spec :y)) - (error (e) (push (cons :bad-image-format (getf spec :path)) + (error (e) (push (list :bad-image-format + (array-dimensions img) + (getf spec :path)) *bad-images*))))) tilesheet))) @@ -90,14 +92,20 @@ exec ros -Q -- $0 "$@" (defun packlist->tile-index (packlist) - "renames the path1 in the packlist to a nicer name for referring toa tile location" - (mapcar #'(lambda (pl) - (remf pl :img) - (setf (getf pl :name) - (substitute #\. #\/ (namestring (getf pl :path)))) - (remf pl :path) - pl) - packlist)) + "renames the path in the packlist to a nicer name for referring toa tile location" + (let ((strip-index (1+ (length (sb-posix:getcwd))))) + (mapcar #'(lambda (pl) + (remf pl :img) + (setf (getf pl :name) + (substitute #\. #\/ (subseq (namestring (getf pl :path)) + strip-index))) + (setf (getf pl :name) + (subseq (getf pl :name) + 0 + (search "." (getf pl :name) :from-end t))) + (remf pl :path) + pl) + packlist))) (defun write-tile-index (tile-index file-path) "saves tile-index to file-path as a standard lisp object" -- cgit v1.2.3 From 9f242c0ccf871e65cd50c8af43acf0163190efcd Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 2 Apr 2020 09:57:49 -0500 Subject: added a todo --- imbricate.ros | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/imbricate.ros b/imbricate.ros index 3e014f9..b81cde8 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -99,7 +99,7 @@ exec ros -Q -- $0 "$@" (setf (getf pl :name) (substitute #\. #\/ (subseq (namestring (getf pl :path)) strip-index))) - (setf (getf pl :name) + (setf (getf pl :name) ; ← This is stupid hah ↓ (subseq (getf pl :name) 0 (search "." (getf pl :name) :from-end t))) -- cgit v1.2.3 From 4aa76811a643c1d768fec7689e66661707d5dab9 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 2 Apr 2020 10:21:02 -0500 Subject: optional json output. cleanup tile naming code --- imbricate.ros | 48 ++++++++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 22 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index b81cde8..8189a55 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -5,7 +5,7 @@ exec ros -Q -- $0 "$@" |# (progn ;;init forms (ros:ensure-asdf) - #+quicklisp(ql:quickload '(cl-fad opticl) :silent t) + #+quicklisp(ql:quickload '(cl-fad opticl jonathan) :silent t) ) (defpackage :ros.script.imbricate.3764151058 @@ -38,13 +38,13 @@ exec ros -Q -- $0 "$@" nil))) (defun image-stats (img) - (list :width (array-dimension img 0) - :height (array-dimension img 1) + (list :|width| (array-dimension img 0) + :|height| (array-dimension img 1) :img img)) (defun image-area (stat) - (* (getf stat :width) - (getf stat :height))) + (* (getf stat :|width|) + (getf stat :|height|))) (defun minimum-required-area (image-list) (loop for stats in image-list @@ -53,8 +53,8 @@ exec ros -Q -- $0 "$@" (defun packlist-dimensions (packlist) (let ((w 0) (h 0)) (dolist (img packlist) - (setf w (max w (+ (getf img :width) (getf img :x)))) - (setf h (max h (+ (getf img :height) (getf img :y))))) + (setf w (max w (+ (getf img :|width|) (getf img :|x|)))) + (setf h (max h (+ (getf img :|height|) (getf img :|y|))))) (list w h))) (defun to-rgb (img) @@ -71,8 +71,8 @@ exec ros -Q -- $0 "$@" (let* ((img (getf spec :img))) (handler-case (copy-into-img tilesheet img - (getf spec :x) - (getf spec :y)) + (getf spec :|x|) + (getf spec :|y|)) (error (e) (push (list :bad-image-format (array-dimensions img) (getf spec :path)) @@ -96,22 +96,24 @@ exec ros -Q -- $0 "$@" (let ((strip-index (1+ (length (sb-posix:getcwd))))) (mapcar #'(lambda (pl) (remf pl :img) - (setf (getf pl :name) - (substitute #\. #\/ (subseq (namestring (getf pl :path)) - strip-index))) - (setf (getf pl :name) ; ← This is stupid hah ↓ - (subseq (getf pl :name) - 0 - (search "." (getf pl :name) :from-end t))) + (let ((name (substitute #\. #\/ (subseq (namestring (getf pl :path)) + strip-index)))) + (setf name (subseq name 0 (search "." name :from-end t))) + (setf (getf pl :|name|) name)) (remf pl :path) pl) packlist))) (defun write-tile-index (tile-index file-path) "saves tile-index to file-path as a standard lisp object" - (with-open-file (out file-path :direction :output) + (with-open-file (out file-path :direction :output :if-exists :supersede) (print tile-index out))) +(defun write-json-index (tile-index file-path) + (with-open-file (out file-path :direction :output :if-exists :supersede) + (format out "~a" + (jonathan:to-json tile-index)))) + (defun rect (x y w h) (list x y w h)) (defun rx (r) (first r)) (defun ry (r) (second r)) @@ -221,18 +223,18 @@ exec ros -Q -- $0 "$@" (ck (make-corner-keeper)) (packlist '())) (dolist (stats tile-stats) - (let ((tw (getf stats :width)) - (th (getf stats :height))) + (let ((tw (getf stats :|width|)) + (th (getf stats :|height|))) (destructuring-bind (x y) (find-space-for ck tw th) (format t ".") (force-output) (add-rect ck (rect x y tw th)) - (push (nconc (list :x x :y y) stats) packlist)))) + (push (nconc (list :|x| x :|y| y) stats) packlist)))) packlist)) (defun main (&rest argv) (declare (ignorable argv)) - (destructuring-bind (path target) argv + (destructuring-bind (path target . options) argv (let* ((tile-stats (images-under-dir path)) (packlist (build-packlist tile-stats)) (tilesheet (pack-images packlist)) @@ -240,7 +242,9 @@ exec ros -Q -- $0 "$@" (format t "~%Writing to disk...") (force-output) (opticl:write-png-file (format nil "~a.png" target) tilesheet) - (write-tile-index tile-index (format nil "~a-index.lisp" target)) + (if (member "-json" options :test #'equal) + (write-json-index tile-index (format nil "~a-index.json" target)) + (write-tile-index tile-index (format nil "~a-index.lisp" target))) (write-tile-index *bad-images* (format nil "~a.bad.txt" target)))) (format t "~%ALL DONE~%")) ;;; vim: set ft=lisp lisp: -- cgit v1.2.3 From 5586c1315a98d3fd5f62d2b805dd158fbf89ed2b Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 2 Apr 2020 10:53:32 -0500 Subject: update README --- README.org | 206 ++++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 171 insertions(+), 35 deletions(-) diff --git a/README.org b/README.org index 4dc3e88..728d7df 100644 --- a/README.org +++ b/README.org @@ -6,44 +6,169 @@ produces file containing a list of property lists that includes a location and a name for each image within the sheet. + The property list outputs either a list of plists, or a json file. + ** Example +*** Running =imbricate= + + Suppose you have a bunch of separate directional pad (DPad) buttons: + + #+BEGIN_EXAMPLE + + $ tree + . + └── Dpad + ├── DownLeft.png + ├── Down.png + ├── DownRight.png + ├── Left.png + ├── Right.png + ├── UpLeft.png + ├── UP.png + └── UpRight.png + + + #+END_EXAMPLE + + To create a single image that contains all of them, just do: + + #+BEGIN_EXAMPLE + + $ imbricate Dpad/ dpad + + Reading images from disk........ + Creating Layout........ + Constructing tilesheet........ + Writing to disk... + ALL DONE + + #+END_EXAMPLE + + Now your working directory shoul look like: + + #+BEGIN_EXAMPLE + + $ tree + . + ├── Dpad + │   ├── DownLeft.png + │   ├── Down.png + │   ├── DownRight.png + │   ├── Left.png + │   ├── Right.png + │   ├── UpLeft.png + │   ├── UP.png + │   └── UpRight.png + ├── dpad.bad.txt + ├── dpad-index.lisp + └── dpad.png + + + #+END_EXAMPLE + +*** The Output + + The file =dpad.bad.txt= is hopefully empty. It contains information + about processing errors that =imbricate= may have encountered. + + The file =dpad.png= is the resulting image - it should contain + everything from the target directory. + + The file =dpad-index.lisp= is a list of plists. For the above + example, it looks like this: + +#+BEGIN_EXAMPLE + +$ cat dpad-index.lisp + +((:|name| "Dpad.Down" :|x| 54 :|y| 108 :|width| 54 :|height| 54) + (:|name| "Dpad.DownLeft" :|x| 0 :|y| 162 :|width| 54 :|height| 54) + (:|name| "Dpad.DownRight" :|x| 54 :|y| 54 :|width| 54 :|height| 54) + (:|name| "Dpad.Left" :|x| 108 :|y| 0 :|width| 54 :|height| 54) + (:|name| "Dpad.Right" :|x| 0 :|y| 108 :|width| 54 :|height| 54) + (:|name| "Dpad.UP" :|x| 54 :|y| 0 :|width| 54 :|height| 54) + (:|name| "Dpad.UpLeft" :|x| 0 :|y| 54 :|width| 54 :|height| 54) + (:|name| "Dpad.UpRight" :|x| 0 :|y| 0 :|width| 54 :|height| 54)) + +#+END_EXAMPLE + +*** JSON Output + +You can opt for JSON output instead of Lisp by passing the =-json= +option to =imbricate= after all the other arguments: + +#+BEGIN_EXAMPLE + +$ imbricate Dpad dpad -json + +$ cat dpad-index.json + + +$ cat dpad-index.json # this is after M-x json-pretty-print-buffer in emacs + +[ + { + "name": "Dpad.Down", + "x": 54, + "y": 108, + "width": 54, + "height": 54 + }, + { + "name": "Dpad.DownLeft", + "x": 0, + "y": 162, + "width": 54, + "height": 54 + }, + { + "name": "Dpad.DownRight", + "x": 54, + "y": 54, + "width": 54, + "height": 54 + }, + { + "name": "Dpad.Left", + "x": 108, + "y": 0, + "width": 54, + "height": 54 + }, + { + "name": "Dpad.Right", + "x": 0, + "y": 108, + "width": 54, + "height": 54 + }, + { + "name": "Dpad.UP", + "x": 54, + "y": 0, + "width": 54, + "height": 54 + }, + { + "name": "Dpad.UpLeft", + "x": 0, + "y": 54, + "width": 54, + "height": 54 + }, + { + "name": "Dpad.UpRight", + "x": 0, + "y": 0, + "width": 54, + "height": 54 + } +] + + +#+END_EXAMPLE -: $ ls eg/ -: AcidArrow.png AcidPellet.png Acorn.png Amber.png AncientSpear.png Arrow.png -: AcidBolt.png AcidSac.png AdamantBone.png Amythyst.png Apple.png AstralCloak.png -: -: $ imbricate eg/ example-graphics -: ALL DONE! -: -: $ ls example-graphics* -: example-graphics.bad.txt example-graphics-index.lisp example-graphics.png -: -: $ cat example-graphics-index.lisp -: -: ((:NAME "AstralCloak" :X 0 :Y 0 :PATH -: #P"/tmp/eg/AstralCloak.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "Arrow" :X 0 :Y 30 :PATH -: #P"/tmp/eg/Arrow.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "Apple" :X 0 :Y 60 :PATH -: #P"/tmp/eg/Apple.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "AncientSpear" :X 30 :Y 0 :PATH -: #P"/tmp/eg/AncientSpear.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "Amythyst" :X 30 :Y 30 :PATH -: #P"/tmp/eg/Amythyst.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "Amber" :X 30 :Y 60 :PATH -: #P"/tmp/eg/Amber.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "AdamantBone" :X 60 :Y 0 :PATH -: #P"/tmp/eg/AdamantBone.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "Acorn" :X 60 :Y 30 :PATH -: #P"/tmp/eg/Acorn.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "AcidSac" :X 60 :Y 60 :PATH -: #P"/tmp/eg/AcidSac.png" :WIDTH 30 :HEIGHT 30) -: (:NAME "AcidArrow" :X 0 :Y 90 :PATH -: #P"/tmp/eg/AcidArrow.png" :WIDTH 30 :HEIGHT 30)) - -The =example-graphics.bad.txt= is a file that lists the any images that the -script could not decode as =png= files. Any such files are skipped. ** Building @@ -54,6 +179,17 @@ Assuming that you have [[https://github.com/roswell/roswell][roswell]] installed : $ cd imbricate.git : $ ros build imbricate.ros +I copy the resulting executable to =~/.local/bin=, which is in my =PATH=. + +: $ cp imbricate ~/.local/bin + + +** Caveats + +I made this for my own use, but relased it thinking it might be useful for others. + +Presently, the tool only works with PNG files that have RGBA +format. (i.e each pixel takes up 4 bytes). -- cgit v1.2.3 From 2cf731bdbfc63195e4075f4b7a4f4bd8f2c4ad1f Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 2 Apr 2020 10:58:33 -0500 Subject: readme --- README.org | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/README.org b/README.org index 728d7df..41e2eb1 100644 --- a/README.org +++ b/README.org @@ -1,12 +1,15 @@ -* =imbricate= makes tilesheets for (Lisp) games +* =imbricate= Makes Tilesheets For Games - The =imbricate= turns a directory, with possible nexted directories, - containing images of varying sizes into a single tile sheet. The tool also - produces file containing a list of property lists that includes a location and - a name for each image within the sheet. + The =imbricate= produces tile sheets from a directory tree the + leaves of which are PNG image files. - The property list outputs either a list of plists, or a json file. + The PNG files can be of any size. The =imbricate= tool will attempt + to pack the tiles into a square tile sheet. + + Imbricate also produces an "index file" for the tilesheet, providing + a name and a location of each individual image. The index can be in + Lisp or JSON formats. ** Example -- cgit v1.2.3 From ef46c9a6408bda2bc987536c6d2bba378d0d02ee Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 2 Apr 2020 11:01:18 -0500 Subject: typo --- README.org | 3 --- 1 file changed, 3 deletions(-) diff --git a/README.org b/README.org index 41e2eb1..cbbff7f 100644 --- a/README.org +++ b/README.org @@ -105,9 +105,6 @@ option to =imbricate= after all the other arguments: $ imbricate Dpad dpad -json -$ cat dpad-index.json - - $ cat dpad-index.json # this is after M-x json-pretty-print-buffer in emacs [ -- cgit v1.2.3 From e5e35d2c19e2a1df9e4740d2244a9cc94300d7c5 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 6 Apr 2020 14:59:43 -0500 Subject: curious --- imbricate.ros | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/imbricate.ros b/imbricate.ros index 8189a55..40cb9bf 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -71,8 +71,8 @@ exec ros -Q -- $0 "$@" (let* ((img (getf spec :img))) (handler-case (copy-into-img tilesheet img - (getf spec :|x|) - (getf spec :|y|)) + (getf spec :|y|) + (getf spec :|x|)) (error (e) (push (list :bad-image-format (array-dimensions img) (getf spec :path)) -- cgit v1.2.3 From 3a6c976cd72da5fd20f0a612171e3610812a8d8a Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 16 Apr 2020 20:49:14 -0500 Subject: readme, uiop --- README.org | 2 +- imbricate.ros | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/README.org b/README.org index cbbff7f..6440499 100644 --- a/README.org +++ b/README.org @@ -175,7 +175,7 @@ $ cat dpad-index.json # this is after M-x json-pretty-print-buffer in emacs Assuming that you have [[https://github.com/roswell/roswell][roswell]] installed: : $ ros use sbcl -: $ git clone https://github.com/thegoofist/imbricate.git +: $ git clone https://github.com/cbeo/imbricate.git : $ cd imbricate.git : $ ros build imbricate.ros diff --git a/imbricate.ros b/imbricate.ros index 40cb9bf..694d2dd 100755 --- a/imbricate.ros +++ b/imbricate.ros @@ -5,7 +5,7 @@ exec ros -Q -- $0 "$@" |# (progn ;;init forms (ros:ensure-asdf) - #+quicklisp(ql:quickload '(cl-fad opticl jonathan) :silent t) + #+quicklisp(ql:quickload '(cl-fad opticl jonathan uiop) :silent t) ) (defpackage :ros.script.imbricate.3764151058 @@ -93,7 +93,7 @@ exec ros -Q -- $0 "$@" (defun packlist->tile-index (packlist) "renames the path in the packlist to a nicer name for referring toa tile location" - (let ((strip-index (1+ (length (sb-posix:getcwd))))) + (let ((strip-index (length (princ-to-string (uiop:getcwd))))) (mapcar #'(lambda (pl) (remf pl :img) (let ((name (substitute #\. #\/ (subseq (namestring (getf pl :path)) -- cgit v1.2.3 From 380751c79f562105ac7bd908d819cd4c09f2948c Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 16 Apr 2020 20:50:15 -0500 Subject: typo --- README.org | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.org b/README.org index 6440499..b47e3a3 100644 --- a/README.org +++ b/README.org @@ -186,7 +186,8 @@ I copy the resulting executable to =~/.local/bin=, which is in my =PATH=. ** Caveats -I made this for my own use, but relased it thinking it might be useful for others. +I made this for my own use but released it thinking it might be useful +for others. Presently, the tool only works with PNG files that have RGBA format. (i.e each pixel takes up 4 bytes). -- cgit v1.2.3 From 04a690eb200883a16b1ac54676fe32c9399ad34a Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 7 Sep 2020 16:14:04 -0500 Subject: added imbricate as a library --- imbricate.asd | 10 +++ imbricate.lisp | 196 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 206 insertions(+) create mode 100644 imbricate.asd create mode 100644 imbricate.lisp diff --git a/imbricate.asd b/imbricate.asd new file mode 100644 index 0000000..acdd2ec --- /dev/null +++ b/imbricate.asd @@ -0,0 +1,10 @@ +;;;; imbricate.asd + +(asdf:defsystem #:imbricate + :description "Describe imbricate here" + :author "Your Name " + :license "Specify license here" + :version "0.0.1" + :serial t + :depends-on (#:jonathan #:opticl #:uiop #:defclass-std #:lambda-tools) + :components ((:file "imbricate"))) diff --git a/imbricate.lisp b/imbricate.lisp new file mode 100644 index 0000000..5eeae6d --- /dev/null +++ b/imbricate.lisp @@ -0,0 +1,196 @@ +;;;; imbricate.lisp + +(defpackage #:imbricate + (:use #:cl) + (:import-from #:opticl + #:convert-image-to-rgba + #:read-png-file + #:with-image-bounds) + (:import-from #:alexandria #:when-let #:if-let) + (:import-from #:defclass-std #:defclass/std)) + +(in-package #:imbricate) + +(defclass rect () + ((x :accessor rect-x + :initarg :x + :initform 0 + :type fixnum) + (y :accessor rect-y + :initarg :y + :initform 0 + :type fixnum) + (width :accessor rect-width + :initarg :width + :initform 0 + :type fixnum) + (height :accessor rect-height + :initarg :height + :initform 0 + :type fixnum))) + + +(defun rect-area (r) + (* (rect-width r) (rect-height r))) + +(defun contains-point-p (r px py) + (with-slots (x y width height) r + (and (<= x px (1- (+ x width))) + (<= y py (1- (+ y height)))))) + + +(defun top-left (rect) + (with-slots (x y) rect + (cons x y))) + +(defun top-right (rect) + (with-slots (x y width) rect + (cons (1- (+ x width)) + y))) + +(defun bottom-left (rect) + (with-slots (x y width height) rect + (cons (1- (+ x width)) + (1- (+ y height))))) + +(defun bottom-right (rect) + (with-slots (x y height) rect + (cons x + (1- (+ y height))))) + +(defun translate-pt (pt dx dy) + (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) + (top-right rect) + (bottom-right rect) + (bottom-left rect))) + +(defun intersects-p (r1 r2) + (loop :for (x . y) :in (corners r2) + :when (contains-point-p r1 x y) + :do (return-from intersects-p t))) + +(defclass tile (rect) + ((path :accessor tile-path + :initarg :path + :initform (error "must supply path")) + (data :accessor tile-data + :initarg :data + :initform (error "Must supply data")))) + +(defmethod print-object ((ob tile) stream) + (with-slots (x y width height path) ob + (format stream "#" + path width height x y))) + +(defclass sheet-plan (rect) + ((candidates :accessor candidates + :initform nil) + (positioned :accessor positioned + :initform nil))) + + +(defun validly-positioned-p (plan tile) + (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. " + (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 + (unless (validly-positioned-p plan tile) + (with-slots (width height) plan + (if (< width height) + (setf (rect-x tile) width + (rect-y tile) 0) + (setf (rect-x tile) 0 + (rect-y tile) height)))) + + ;; update width and height of the sheet + (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 + (push tile (positioned plan)) + (setf (candidates plan) + (delete (top-left tile) + (candidates plan) + :test #'equal)) + (pushnew (translate-pt (top-right tile) 1 0) (candidates plan) + :test #'equal) + (pushnew (translate-pt (bottom-left tile) 0 1) (candidates plan) + :test #'equal)) + + + +(defun position-tiles (tiles) + (let ((plan (make-instance 'sheet-plan)) + (tiles (sort tiles #'> :key #'rect-area))) + (dolist (tile tiles plan) + (position-tile plan tile)))) + + + +(defun render-sheet (plan) + (let ((sheet (opticl:make-8-bit-rgba-image (rect-width plan) (rect-height plan)))) + (dolist (tile (positioned plan)) + (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)) + + + +(defun load-tile (path) + (let ((data + (convert-image-to-rgba + (read-png-file path)))) + + (with-image-bounds (w h) data + (make-instance 'tile + :path path + :data data + :width w + :height h)))) + +(defun png-file-p (path) + (declare (type pathname path)) + (string-equal "png" (pathname-type path))) + +(defvar *bad-images* nil) + +(defun images-under-dir (dir) + (let ((images '()) + (*bad-images* nil)) + (uiop:collect-sub*directories + dir + (constantly t) + (constantly t) + (lambda (subdir) + (dolist (file (uiop:directory-files subdir)) + (when (png-file-p file) + (handler-case + (push (load-tile file) images) + (error (e) + (declare (ignore e)) + (push file *bad-images*))))))) + images)) + -- cgit v1.2.3 From e49c96b0c3ad920864b4c2e1ec025affb4c7c25f Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 7 Sep 2020 16:37:27 -0500 Subject: exports --- imbricate.lisp | 37 +++++++++++++++++++++++++++++++++---- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/imbricate.lisp b/imbricate.lisp index 5eeae6d..0667c74 100644 --- a/imbricate.lisp +++ b/imbricate.lisp @@ -6,8 +6,8 @@ #:convert-image-to-rgba #:read-png-file #:with-image-bounds) - (:import-from #:alexandria #:when-let #:if-let) - (:import-from #:defclass-std #:defclass/std)) + (:export #:imbricate + #:imbricate-and-save)) (in-package #:imbricate) @@ -91,6 +91,10 @@ (format stream "#" path width height x y))) +(defun tile-meta-info (tile) + (with-slots (x y width height path) tile + (list :path path :x x :y y :width width :height height))) + (defclass sheet-plan (rect) ((candidates :accessor candidates :initform nil) @@ -158,6 +162,8 @@ instance. " sheet)) +(defun make-sheet-info (plan) + (mapcar #'tile-meta-info (positioned plan))) (defun load-tile (path) (let ((data @@ -178,8 +184,7 @@ instance. " (defvar *bad-images* nil) (defun images-under-dir (dir) - (let ((images '()) - (*bad-images* nil)) + (let ((images '())) (uiop:collect-sub*directories dir (constantly t) @@ -194,3 +199,27 @@ instance. " (push file *bad-images*))))))) images)) + +(defun imbricate (dir) + (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) + (multiple-value-bind (sheet info bad) (imbricate dir) + (let ((png-path (merge-pathnames (format nil "~a.png" title) save-to)) + (info-path (merge-pathnames (format nil "~a.sexp" title) save-to)) + (bad-path (merge-pathnames (format nil "~a.errors.txt" title) save-to))) + (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)) + (opticl:write-png-file png-path sheet)))) -- cgit v1.2.3 From f09c489f299fefce62d6b46703744a4336b484b2 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 7 Sep 2020 16:39:49 -0500 Subject: removed roswell script --- imbricate.ros | 250 ---------------------------------------------------------- 1 file changed, 250 deletions(-) delete mode 100755 imbricate.ros diff --git a/imbricate.ros b/imbricate.ros deleted file mode 100755 index 694d2dd..0000000 --- a/imbricate.ros +++ /dev/null @@ -1,250 +0,0 @@ -#!/bin/sh -#|-*- mode:lisp -*-|# -#| -exec ros -Q -- $0 "$@" -|# -(progn ;;init forms - (ros:ensure-asdf) - #+quicklisp(ql:quickload '(cl-fad opticl jonathan uiop) :silent t) - ) - -(defpackage :ros.script.imbricate.3764151058 - (:use :cl)) -(in-package :ros.script.imbricate.3764151058) - -(defmacro let-when ((var test) &rest body) - `(let ((,var ,test)) - (when ,var ,@body))) - -(defun images-under-dir (dir &key (type "png")) - (format t "~%Reading images from disk") - (let ((images '())) - (cl-fad:walk-directory - dir - (lambda (path) - (format t ".") - (force-output) - (let-when (img (and (string= type (pathname-type path)) - (safe-open-image path))) - (push (nconc (list :path path) (image-stats img)) images)))) - images)) - -(defvar *bad-images* '()) - -(defun safe-open-image (path) - (handler-case (opticl:read-png-file (format nil "~a" path)) - (error (c) - (push path *bad-images*) - nil))) - -(defun image-stats (img) - (list :|width| (array-dimension img 0) - :|height| (array-dimension img 1) - :img img)) - -(defun image-area (stat) - (* (getf stat :|width|) - (getf stat :|height|))) - -(defun minimum-required-area (image-list) - (loop for stats in image-list - summing (image-area stats))) - -(defun packlist-dimensions (packlist) - (let ((w 0) (h 0)) - (dolist (img packlist) - (setf w (max w (+ (getf img :|width|) (getf img :|x|)))) - (setf h (max h (+ (getf img :|height|) (getf img :|y|))))) - (list w h))) - -(defun to-rgb (img) - img) - -(defun pack-images (packlist) - "Creates an image and copies the contents of the packlist to that image" - (format t "~%Constructing tilesheet") - (destructuring-bind (cw ch) (packlist-dimensions packlist) - (let ((tilesheet (make-array (list cw ch 4) :element-type '(unsigned-byte 8)))) - (dolist (spec packlist) - (format t ".") - (force-output) - (let* ((img (getf spec :img))) - (handler-case - (copy-into-img tilesheet img - (getf spec :|y|) - (getf spec :|x|)) - (error (e) (push (list :bad-image-format - (array-dimensions img) - (getf spec :path)) - *bad-images*))))) - tilesheet))) - -(defun img-width (img) (array-dimension img 0)) -(defun img-height (img) (array-dimension img 1)) - -(defun copy-into-img (target source dest-x dest-y) - (dotimes (x (img-width source)) - (dotimes (y (img-height source)) - (dotimes (v 4) - (setf (aref target (+ x dest-x) (+ y dest-y) v) - (aref source x y v)))))) - - - -(defun packlist->tile-index (packlist) - "renames the path in the packlist to a nicer name for referring toa tile location" - (let ((strip-index (length (princ-to-string (uiop:getcwd))))) - (mapcar #'(lambda (pl) - (remf pl :img) - (let ((name (substitute #\. #\/ (subseq (namestring (getf pl :path)) - strip-index)))) - (setf name (subseq name 0 (search "." name :from-end t))) - (setf (getf pl :|name|) name)) - (remf pl :path) - pl) - packlist))) - -(defun write-tile-index (tile-index file-path) - "saves tile-index to file-path as a standard lisp object" - (with-open-file (out file-path :direction :output :if-exists :supersede) - (print tile-index out))) - -(defun write-json-index (tile-index file-path) - (with-open-file (out file-path :direction :output :if-exists :supersede) - (format out "~a" - (jonathan:to-json tile-index)))) - -(defun rect (x y w h) (list x y w h)) -(defun rx (r) (first r)) -(defun ry (r) (second r)) -(defun rw (r) (third r)) -(defun rh (r) (fourth r)) -(defun tl (r) (list (rx r) (ry r))) -(defun tr (r) (list (+ (rx r) (rw r)) (ry r))) -(defun br (r) (list (+ (rx r) (rw r)) (+ (ry r) (rh r)))) -(defun bl (r) (list (rx r) (+ (ry r) (rh r)))) - -(defun xy-bounds (r) - "returns (left right top bottom)" - (list (rx r) (+ (rx r) (rw r)) - (ry r) (+ (ry r) (rh r)))) - -(defun inside-rect (r xy) - (destructuring-bind (l r tp b) (xy-bounds r) - (destructuring-bind (x y) xy - (and (< l x) (< x r) - (< tp y) (< y b))))) - -(defun intersect-p (r1 r2) - (or - (equalp r1 r2) - (inside-rect r1 (tl r2)) - (inside-rect r1 (tr r2)) - (inside-rect r1 (br r2)) - (inside-rect r1 (bl r2)) - (inside-rect r2 (tl r1)) - (inside-rect r2 (tr r1)) - (inside-rect r2 (br r1)) - (inside-rect r2 (bl r1)) - ;; if no corner of one is inside the other, then - ;; any edge of one intersects at least one edge of the other - ;; so we check one arbitrarily - (destructuring-bind (left1 right1 top1 bottom1) (xy-bounds r1) - (destructuring-bind (left2 right2 top2 bottom2) (xy-bounds r2) - (and (<= left1 left2) - (< left2 right1) - (<= top2 top1) - (< top1 bottom2)))))) - -(defun make-corner-keeper () (list 0 0 '() (make-hash-table :test 'equal) '())) -(defun keeper-w (k) (first k)) -(defun keeper-h (k) (second k)) -(defun (setf keeper-w) (v k) - (setf (first k) v)) -(defun (setf keeper-h) (v k) - (setf (second k) v)) - -(defun keeper-corners (k) (third k)) -(defun (setf keeper-corners) (val k) - (setf (third k) val)) - -(defun visited-corners (k) (fourth k)) - -(defun was-visited (k p) - (gethash p (visited-corners k))) - -(defun visit (k p) - (setf (gethash p (visited-corners k)) t)) - -(defun keeper-rects (k) (fifth k)) -(defun (setf keeper-rects) (val k) - (setf (fifth k) val)) - -(defun remove-corner (k c) - (setf (keeper-corners k) - (remove c (keeper-corners k) :test #'equal))) - -(defun add-corner (k c) - (unless (was-visited k c) - (visit k c) - (push c (keeper-corners k)))) - -(defun add-rect (k r) - (remove-corner k (tl r)) - (push r (keeper-rects k)) - (add-corner k (tr r)) - (add-corner k (bl r)) - (setf (keeper-w k) (max (first (br r)) - (keeper-w k))) - (setf (keeper-h k) (max (second (br r)) - (keeper-h k)))) - -(defun intersects-any-tile-p (k r) - (dolist (r2 (keeper-rects k)) - (when (intersect-p r r2) - (return-from intersects-any-tile-p t)))) - -(defun valid-rect (k r) - (and (inside-rect (rect 0 0 (keeper-w k) (keeper-h k)) (br r)) - (not (intersects-any-tile-p k r)))) - -(defun find-space-for (k w h) - (dolist (xy (keeper-corners k)) - (when (valid-rect k (rect (first xy) (second xy) w h)) - (return-from find-space-for xy))) - ;; if not already-returned, then do: - (if (< (keeper-w k) (keeper-h k)) - (list (keeper-w k) 0) - (list 0 (keeper-h k)))) - -(defun build-packlist (tile-stats) - (format t "~%Creating Layout") - (let ((tile-stats (sort tile-stats #'> :key #'image-area)) - (ck (make-corner-keeper)) - (packlist '())) - (dolist (stats tile-stats) - (let ((tw (getf stats :|width|)) - (th (getf stats :|height|))) - (destructuring-bind (x y) (find-space-for ck tw th) - (format t ".") - (force-output) - (add-rect ck (rect x y tw th)) - (push (nconc (list :|x| x :|y| y) stats) packlist)))) - packlist)) - -(defun main (&rest argv) - (declare (ignorable argv)) - (destructuring-bind (path target . options) argv - (let* ((tile-stats (images-under-dir path)) - (packlist (build-packlist tile-stats)) - (tilesheet (pack-images packlist)) - (tile-index (packlist->tile-index packlist))) - (format t "~%Writing to disk...") - (force-output) - (opticl:write-png-file (format nil "~a.png" target) tilesheet) - (if (member "-json" options :test #'equal) - (write-json-index tile-index (format nil "~a-index.json" target)) - (write-tile-index tile-index (format nil "~a-index.lisp" target))) - (write-tile-index *bad-images* (format nil "~a.bad.txt" target)))) - (format t "~%ALL DONE~%")) -;;; vim: set ft=lisp lisp: -- cgit v1.2.3 From e43518427375ef19203dbd027b0d8a1a2f986932 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 7 Sep 2020 17:00:53 -0500 Subject: added build script --- build.lisp | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 build.lisp diff --git a/build.lisp b/build.lisp new file mode 100644 index 0000000..60a9b6a --- /dev/null +++ b/build.lisp @@ -0,0 +1,27 @@ + +(ql:quickload :imbricate) + +(defpackage #:imbricate.run + (:use #:cl)) + +(in-package :imbricate.run) + +(defun print-help () + (format t "USAGE: imbricate SOURCE-DIR TARGET-DIR SHEET-TITLE~%~%") + (format t " SOURCE-DIR a directory containing png files. Non png files are skipped~%") + (format t " TARGET-DIR a directory where the tilesheet is to be built.~%") + (format t " SHEET-TITLE a name used for this sheet and its meta info~%~%")) + + +#+sbcl +(progn + (defun main () + (unless (= 4 (length sb-ext:*posix-argv*)) + (print-help) + (uiop:quit)) + (destructuring-bind (src target title) (cdr sb-ext:*posix-argv*) + (imbricate:imbricate-and-save src target title) + (uiop:quit))) + + (sb-ext:save-lisp-and-die #p"imbricate" :toplevel #'main :executable t)) + -- cgit v1.2.3 From 6a8f66fb4543d07e15eaf879ee7ace90598b6f5b Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 7 Sep 2020 17:05:35 -0500 Subject: asd update --- imbricate.asd | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/imbricate.asd b/imbricate.asd index acdd2ec..a98ab0b 100644 --- a/imbricate.asd +++ b/imbricate.asd @@ -1,10 +1,10 @@ ;;;; imbricate.asd (asdf:defsystem #:imbricate - :description "Describe imbricate here" - :author "Your Name " - :license "Specify license here" - :version "0.0.1" + :description "Makes tilesheets" + :author "colin okay " + :license "AGPL-3.0" + :version "0.1.0" :serial t - :depends-on (#:jonathan #:opticl #:uiop #:defclass-std #:lambda-tools) + :depends-on ( #:opticl #:uiop ) :components ((:file "imbricate"))) -- cgit v1.2.3 From b43e843f52b4f44b3ebd32a329b0eca9a19c4879 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 8 Sep 2020 19:28:06 -0500 Subject: addec compression to save-lisp-and-die --- build.lisp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/build.lisp b/build.lisp index 60a9b6a..9e98804 100644 --- a/build.lisp +++ b/build.lisp @@ -13,6 +13,8 @@ (format t " SHEET-TITLE a name used for this sheet and its meta info~%~%")) + + #+sbcl (progn (defun main () @@ -23,5 +25,5 @@ (imbricate:imbricate-and-save src target title) (uiop:quit))) - (sb-ext:save-lisp-and-die #p"imbricate" :toplevel #'main :executable t)) + (sb-ext:save-lisp-and-die #p"imbricate" :toplevel #'main :executable t :compression t)) -- cgit v1.2.3 From 0536a9878d0e07a7be1f4317f04e1b1550671970 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 8 Sep 2020 19:28:21 -0500 Subject: removed imported opticl symbols --- imbricate.lisp | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/imbricate.lisp b/imbricate.lisp index 0667c74..14f15e9 100644 --- a/imbricate.lisp +++ b/imbricate.lisp @@ -2,10 +2,6 @@ (defpackage #:imbricate (:use #:cl) - (:import-from #:opticl - #:convert-image-to-rgba - #:read-png-file - #:with-image-bounds) (:export #:imbricate #:imbricate-and-save)) @@ -167,10 +163,10 @@ instance. " (defun load-tile (path) (let ((data - (convert-image-to-rgba - (read-png-file path)))) + (opticl:convert-image-to-rgba + (opticl:read-png-file path)))) - (with-image-bounds (w h) data + (opticl:with-image-bounds (w h) data (make-instance 'tile :path path :data data -- cgit v1.2.3 From eea615f1d8b4a07cfd51d406102bffa9a29e7e48 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 8 Sep 2020 19:43:04 -0500 Subject: cleaned up code --- imbricate.lisp | 52 +++++++++++++++++++++++++++++++--------------------- 1 file 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)))) -- cgit v1.2.3 From 0ff4d0bd20575214080952b675400c1026891e2d Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 8 Sep 2020 19:59:43 -0500 Subject: readme.md --- README.md | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 README.md diff --git a/README.md b/README.md new file mode 100644 index 0000000..f173772 --- /dev/null +++ b/README.md @@ -0,0 +1,54 @@ +# imbricate + +Make tilesheets from directories of png files. + +## Use as a library + + ;; clone the repo into ~/quicklisp/local-projects + (ql:quickload :imbricate) + + (multiple-value-bind (sheet meta bad-paths) (imbricate:imbricate #P"/path/to/images/") + ;; save the sheet image to disk as a png file + (opticl:write-png-file "tilesheet.png" sheet) + + ;; print the first tile metainfo + (print (car meta)) (terpri)) + + ; prints, e.g. (:PATH "/path/to/images/an-image.png :X 0 :Y 0 :WIDTH 200 :HEIGHT 100) + ; or whatever your actual images are like. + + +The function `imbricate` will recurse down through a directory +collecting PNG files as it goes. It will arrange those the images +contained in those PNG files into a single large sheet that contains +all of them, and return that as its first return value. The files do +not need to be the same size. + +The second return value of `imbricate` is a list of PLISTs that look like: + + + (:PATH "/path/to/images/an-image.png :X 0 :Y 0 :WIDTH 200 :HEIGHT 100) + +This way you can use the `:PATH` value to pick out a desired image +from within a tilesheet, using the coordinates and dimensions to +isolate that image's data within the sheet's texture. + +## Build as a command line tool + +The repo contains a `build.lisp` script that will build an executable +SBCL Lisp image. + + sbcl --load build.lisp + +From there you can use the imbricate command like so + + # SOURCE TARGET TITLE + ./imbricate /path/to/images/ /target/directory/ mysheet + +Which will put two files into `/target/directory/`, one pngfile +containing the tilesheet, and another file containg the s-expressions +represneting the tilesheet's meta data. + +If any of the PNG files in the source directory could not be loaded, +then a third file `mysheet.errors.txt` will appear containing the +paths of the offending files. -- cgit v1.2.3 From c46e46fc739c84f08d2d0af581a54a4518ec04fb Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 8 Sep 2020 19:59:58 -0500 Subject: removed readme.org --- README.org | 198 ------------------------------------------------------------- 1 file changed, 198 deletions(-) delete mode 100644 README.org diff --git a/README.org b/README.org deleted file mode 100644 index b47e3a3..0000000 --- a/README.org +++ /dev/null @@ -1,198 +0,0 @@ - -* =imbricate= Makes Tilesheets For Games - - The =imbricate= produces tile sheets from a directory tree the - leaves of which are PNG image files. - - The PNG files can be of any size. The =imbricate= tool will attempt - to pack the tiles into a square tile sheet. - - Imbricate also produces an "index file" for the tilesheet, providing - a name and a location of each individual image. The index can be in - Lisp or JSON formats. - -** Example - -*** Running =imbricate= - - Suppose you have a bunch of separate directional pad (DPad) buttons: - - #+BEGIN_EXAMPLE - - $ tree - . - └── Dpad - ├── DownLeft.png - ├── Down.png - ├── DownRight.png - ├── Left.png - ├── Right.png - ├── UpLeft.png - ├── UP.png - └── UpRight.png - - - #+END_EXAMPLE - - To create a single image that contains all of them, just do: - - #+BEGIN_EXAMPLE - - $ imbricate Dpad/ dpad - - Reading images from disk........ - Creating Layout........ - Constructing tilesheet........ - Writing to disk... - ALL DONE - - #+END_EXAMPLE - - Now your working directory shoul look like: - - #+BEGIN_EXAMPLE - - $ tree - . - ├── Dpad - │   ├── DownLeft.png - │   ├── Down.png - │   ├── DownRight.png - │   ├── Left.png - │   ├── Right.png - │   ├── UpLeft.png - │   ├── UP.png - │   └── UpRight.png - ├── dpad.bad.txt - ├── dpad-index.lisp - └── dpad.png - - - #+END_EXAMPLE - -*** The Output - - The file =dpad.bad.txt= is hopefully empty. It contains information - about processing errors that =imbricate= may have encountered. - - The file =dpad.png= is the resulting image - it should contain - everything from the target directory. - - The file =dpad-index.lisp= is a list of plists. For the above - example, it looks like this: - -#+BEGIN_EXAMPLE - -$ cat dpad-index.lisp - -((:|name| "Dpad.Down" :|x| 54 :|y| 108 :|width| 54 :|height| 54) - (:|name| "Dpad.DownLeft" :|x| 0 :|y| 162 :|width| 54 :|height| 54) - (:|name| "Dpad.DownRight" :|x| 54 :|y| 54 :|width| 54 :|height| 54) - (:|name| "Dpad.Left" :|x| 108 :|y| 0 :|width| 54 :|height| 54) - (:|name| "Dpad.Right" :|x| 0 :|y| 108 :|width| 54 :|height| 54) - (:|name| "Dpad.UP" :|x| 54 :|y| 0 :|width| 54 :|height| 54) - (:|name| "Dpad.UpLeft" :|x| 0 :|y| 54 :|width| 54 :|height| 54) - (:|name| "Dpad.UpRight" :|x| 0 :|y| 0 :|width| 54 :|height| 54)) - -#+END_EXAMPLE - -*** JSON Output - -You can opt for JSON output instead of Lisp by passing the =-json= -option to =imbricate= after all the other arguments: - -#+BEGIN_EXAMPLE - -$ imbricate Dpad dpad -json - -$ cat dpad-index.json # this is after M-x json-pretty-print-buffer in emacs - -[ - { - "name": "Dpad.Down", - "x": 54, - "y": 108, - "width": 54, - "height": 54 - }, - { - "name": "Dpad.DownLeft", - "x": 0, - "y": 162, - "width": 54, - "height": 54 - }, - { - "name": "Dpad.DownRight", - "x": 54, - "y": 54, - "width": 54, - "height": 54 - }, - { - "name": "Dpad.Left", - "x": 108, - "y": 0, - "width": 54, - "height": 54 - }, - { - "name": "Dpad.Right", - "x": 0, - "y": 108, - "width": 54, - "height": 54 - }, - { - "name": "Dpad.UP", - "x": 54, - "y": 0, - "width": 54, - "height": 54 - }, - { - "name": "Dpad.UpLeft", - "x": 0, - "y": 54, - "width": 54, - "height": 54 - }, - { - "name": "Dpad.UpRight", - "x": 0, - "y": 0, - "width": 54, - "height": 54 - } -] - - -#+END_EXAMPLE - - -** Building - -Assuming that you have [[https://github.com/roswell/roswell][roswell]] installed: - -: $ ros use sbcl -: $ git clone https://github.com/cbeo/imbricate.git -: $ cd imbricate.git -: $ ros build imbricate.ros - -I copy the resulting executable to =~/.local/bin=, which is in my =PATH=. - -: $ cp imbricate ~/.local/bin - - -** Caveats - -I made this for my own use but released it thinking it might be useful -for others. - -Presently, the tool only works with PNG files that have RGBA -format. (i.e each pixel takes up 4 bytes). - - - - - -- cgit v1.2.3 From 9ed8ffd48c35872531b881f2ccf10c056dbdc680 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Wed, 9 Sep 2020 10:49:11 -0500 Subject: added system for cli tool But the ecl build doesn't work... --- build.lisp | 34 +++++++++++++--------------------- imbricate-run.asd | 9 +++++++++ imbricate.asd | 2 +- run.lisp | 33 +++++++++++++++++++++++++++++++++ 4 files changed, 56 insertions(+), 22 deletions(-) create mode 100644 imbricate-run.asd create mode 100644 run.lisp diff --git a/build.lisp b/build.lisp index 9e98804..4552239 100644 --- a/build.lisp +++ b/build.lisp @@ -1,29 +1,21 @@ -(ql:quickload :imbricate) - -(defpackage #:imbricate.run - (:use #:cl)) - -(in-package :imbricate.run) - -(defun print-help () - (format t "USAGE: imbricate SOURCE-DIR TARGET-DIR SHEET-TITLE~%~%") - (format t " SOURCE-DIR a directory containing png files. Non png files are skipped~%") - (format t " TARGET-DIR a directory where the tilesheet is to be built.~%") - (format t " SHEET-TITLE a name used for this sheet and its meta info~%~%")) +(ql:register-local-projects) +(dolist (dir ql:*local-project-directories*) + (push dir asdf:*central-registry*)) +(ql:quickload :imbricate-run) #+sbcl -(progn - (defun main () - (unless (= 4 (length sb-ext:*posix-argv*)) - (print-help) - (uiop:quit)) - (destructuring-bind (src target title) (cdr sb-ext:*posix-argv*) - (imbricate:imbricate-and-save src target title) - (uiop:quit))) +(progn + (sb-ext:save-lisp-and-die #p"imbricate" :toplevel #'imbricate.run:main :executable t :compression t)) - (sb-ext:save-lisp-and-die #p"imbricate" :toplevel #'main :executable t :compression t)) +#+ecl +(progn + (asdf:make-build :imbricate-run + :type :program + :move-here #P"./" + :epilogue-code '(imbricate.run:main)) + (ext:exit)) diff --git a/imbricate-run.asd b/imbricate-run.asd new file mode 100644 index 0000000..c017655 --- /dev/null +++ b/imbricate-run.asd @@ -0,0 +1,9 @@ + +(asdf:defsystem #:imbricate-run + :description "cli tool for imbricate" + :author "colin okay " + :license "AGPL-3.0" + :version "0.1.0" + :serial t + :depends-on ( #:asdf #:imbricate ) + :components ((:file "run"))) diff --git a/imbricate.asd b/imbricate.asd index a98ab0b..472579f 100644 --- a/imbricate.asd +++ b/imbricate.asd @@ -6,5 +6,5 @@ :license "AGPL-3.0" :version "0.1.0" :serial t - :depends-on ( #:opticl #:uiop ) + :depends-on (#:asdf #:uiop #:opticl) :components ((:file "imbricate"))) diff --git a/run.lisp b/run.lisp new file mode 100644 index 0000000..8eeb603 --- /dev/null +++ b/run.lisp @@ -0,0 +1,33 @@ + +(defpackage #:imbricate.run + (:use #:cl) + (:export #:main)) + +(in-package :imbricate.run) + +(defun print-help () + (format t "USAGE: imbricate SOURCE-DIR TARGET-DIR SHEET-TITLE~%~%") + (format t " SOURCE-DIR a directory containing png files. Non png files are skipped~%") + (format t " TARGET-DIR a directory where the tilesheet is to be built.~%") + (format t " SHEET-TITLE a name used for this sheet and its meta info~%~%")) + +#+ecl +(defun main () + (print (ext:command-args))) + ;; (unless (= 4 (length (ext:command-args))) + ;; (print-help) + ;; (ext:quit)) + ;; (destructuring-bind (src target title) (cdr (ext:command-args)) + ;; (imbricate:imbricate-and-save src target title) + ;; (ext:quit))) + +#+sbcl +(defun main () + (unless (= 4 (length sb-ext:*posix-argv*)) + (print-help) + (uiop:quit)) + (destructuring-bind (src target title) (cdr sb-ext:*posix-argv*) + (imbricate:imbricate-and-save src target title) + (uiop:quit))) + + -- cgit v1.2.3