3 files changed, 52 insertions(+), 1 deletions(-)

M fairy.asd
M fairy.lisp
A tiled.lisp

@@ 6,3 6,12 @@
     :serial t
     :depends-on (trivial-gamekit)
     :components ((:file "fairy")))
+
+(asdf:defsystem fairy/tiled
+    :description "Extension to fairy.lisp to handle tiled tilesets and maps"
+    :author "lthms"
+    :license "GPLv3"
+    :version "0.0.1"
+    :serial t
+    :depends-on (fairy cl-tiled alexandria)
+    :components ((:file "tiled")))

@@ 1,6 1,7 @@
 (defpackage :fairy
   (:use :cl)
   (:export draw
+           defdraw
            element
            origin
            scale


@@ 15,10 16,11 @@
            delete-child
            delete-child-with-key))
 
+(cl:in-package :fairy)
+
 (defgeneric draw (element)
   (:documentation "Draw the element on the screen"))
 
-(cl:in-package :fairy)
 
 (defclass element ()
   ((origin :initarg :origin

@@ 0,0 1,40 @@
+(defpackage :fairy/tiled
+  (:use :cl)
+  (:export tile))
+
+(cl:in-package :fairy/tiled)
+
+(defclass tile (fairy:element)
+  ((tileset :initarg :path
+            :initform (error "You should provide a path for the tileset")
+            :reader tileset
+            :writer (setf change-tileset))
+   (current :initarg :current
+            :initform 0
+            :accessor :current)
+   (get-resource :initarg :get-resource
+                 :initform 'alexandria:make-keyword
+                 :reader :get-resource)))
+
+(defmethod initialize-instance :after ((el tile) &key)
+  (let ((tileset (cl-tiled:load-tileset (tileset el))))
+    (setf (change-tileset el) tileset)))
+
+(fairy:defdraw (el tile)
+    (with-slots (tileset current get-resource) el
+      (let* ((image (cl-tiled:tileset-image (tileset el)))
+             (width (cl-tiled:image-width image))
+             (height (cl-tiled:image-height image))
+             (path (cl-tiled:image-source image))
+             (res-key (funcall get-resource path))
+             (tile-width (cl-tiled:tileset-tile-width tileset))
+             (tile-height (cl-tiled:tileset-tile-height tileset))
+             (nb-col (truncate width tile-width))
+             (nb-line (truncate height tile-height))
+             (line (- nb-line 1 (truncate current nb-col)))
+             (col (mod current nb-col)))
+        (gamekit:draw-image (gamekit:vec2 0 0) res-key
+                            :origin (gamekit:vec2 (* col tile-width)
+                                                  (* line tile-height))
+                            :width tile-width
+                            :height tile-height))))