Factor out layered-container and fix some shit.

chunk.lisp

@@ -1,15 +1,14 @@
 (in-package #:org.shirakumo.fraf.leaf)
 
-(define-shader-entity chunk (container-unit sized-entity solid lighted-entity light-environment)
+(define-shader-entity chunk (layered-container sized-entity solid lighted-entity light-environment)
   ((vertex-array :initform (asset 'trial:trial 'trial::fullscreen-square) :accessor vertex-array)
    (texture :accessor texture)
    (layers :accessor layers)
    (tileset :initarg :tileset :initform (error "TILESET required.") :accessor tileset
             :type asset :documentation "The tileset texture for the chunk.")
    (size :initarg :size :initform +tiles-in-view+ :accessor size
          :type vec2 :documentation "The size of the chunk in tiles."))
-  (:inhibit-shaders (shader-entity :fragment-shader))
-  (:default-initargs :layers +layer-count+))
+  (:inhibit-shaders (shader-entity :fragment-shader)))
 
 (defmethod initargs append ((_ chunk))
   `(:size :tileset))
@@ -57,14 +56,14 @@
 
 (defmethod paint :around ((chunk chunk) target)
   (call-next-method)
-  (for:for ((entity flare-queue:in-queue (objects chunk)))
-    (when (= *current-layer (layer entity))
-      (paint entity target))))
+  (when (< *current-layer* (length (objects chunk)))
+    (loop for unit across (aref (objects chunk) *current-layer*)
+          do (paint unit target))))
 
 (defmethod paint ((chunk chunk) (pass shader-pass))
   (let ((program (shader-program-for-pass pass chunk))
         (vao (vertex-array chunk)))
-    (setf (uniform program "layer") (+ *current-layer* (floor +layer-count+ 2)))
+    (setf (uniform program "layer") *current-layer*)
     (setf (uniform program "tile_size") +tile-size+)
     (setf (uniform program "view_size") (vec2 (width *context*) (height *context*)))
     (setf (uniform program "map_size") (size chunk))
@@ -251,7 +250,7 @@ void main(){
   (let ((tile (tile target chunk)))
     (if (and tile (= 0 (vy tile)) (< 0 (vx tile)))
         (aref +surface-blocks+ (truncate (vx tile)))
-        (for:for ((entity flare-queue:in-queue (objects chunk)))
+        (do-layered-container (entity chunk)
           (when (and (typep entity 'solid)
                      (scan entity target))
             (return entity))))))
@@ -298,7 +297,7 @@ void main(){
                             (setf (hit-object hit) (aref +surface-blocks+ tile))
                             (setf result hit))))))
     ;; Scan through entities
-    (for:for ((entity flare-queue:in-queue (objects chunk)))
+    (do-layered-container (entity chunk)
       (when (and (not (eq entity target))
                  (typep entity 'solid))
         (let ((hit (scan entity target)))

editor.lisp

@@ -311,7 +311,7 @@ void main(){
     (setf (uniform program "tile") (tile-to-place editor))))
 
 (defmethod paint :around ((editor chunk-editor) (target shader-pass))
-  (let ((*current-layer* 3))
+  (let ((*current-layer* +layer-count+))
     (paint-with target (entity editor)))
   (with-pushed-matrix ()
     (call-next-method))

layered-container.lisp

@@ -0,0 +1,72 @@
+(in-package #:org.shirakumo.fraf.leaf)
+
+(defclass layered-container (container-unit)
+  ((objects :initform NIL))
+  (:default-initargs :layers +layer-count+))
+
+(defmethod initialize-instance :after ((container layered-container) &key layers)
+  (let ((objects (make-array layers)))
+    (dotimes (i layers)
+      (setf (aref objects i) (make-array 0 :adjustable T :fill-pointer T)))
+    (setf (objects container) objects)))
+
+(defgeneric layer-index (unit))
+
+(defmethod layer-index ((unit unit)) 0)
+
+(defmethod enter ((unit unit) (container layered-container))
+  (let ((layer (+ (layer-index unit)
+                  (floor (length (objects container)) 2))))
+    (vector-push-extend unit (aref (objects container) layer))))
+
+(defmethod leave ((unit unit) (container layered-container))
+  (let ((layer (+ (layer-index unit)
+                  (floor (length (objects container)) 2))))
+    (array-utils:vector-pop-position*
+     (aref (objects container) layer)
+     (position unit (aref (objects container) layer)))))
+
+(defmethod paint ((container layered-container) target)
+  (let ((layers (objects container)))
+    (dotimes (i (length layers))
+      (let ((*current-layer* i))
+        (loop for unit across (aref layers i)
+              do (paint unit target))))))
+
+(defmethod layer-count ((container layered-container))
+  (length (objects container)))
+
+(defmacro do-layered-container ((entity container &optional result) &body body)
+  (let ((layer (gensym "LAYER")))
+    `(loop for ,layer across (objects ,container)
+           do (loop for ,entity across ,layer
+                    do (progn ,@body))
+           finally (return ,result))))
+
+(defclass layered-container-iterator (for:iterator)
+  ((layer :initarg :layer :accessor layer)
+   (start :initform 0 :accessor start)))
+
+(defmethod for:has-more ((iterator layered-container-iterator))
+  (< (layer iterator) (length (for:object iterator))))
+
+(defmethod for:next ((iterator layered-container-iterator))
+  (let ((layer (aref (for:object iterator) (layer iterator))))
+    (prog1 (aref layer (start iterator))
+      (incf (start iterator))
+      (when (<= (length layer) (start iterator))
+        (setf (start iterator) 0)
+        (loop for i from (1+ (layer iterator)) below (length (for:object iterator))
+              while (= 0 (length (aref (for:object iterator) i)))
+              finally (setf (layer iterator) i))))))
+
+(defmethod (setf for:current) ((unit unit) (iterator layered-container-iterator))
+  (setf (aref (aref (for:object iterator) (layer iterator))
+              (start iterator))
+        unit))
+
+(defmethod for:make-iterator ((container layered-container) &key)
+  (make-instance 'layered-container-iterator
+                 :object (objects container)
+                 :layer (or (position 0 (objects container) :key #'length :test-not #'=)
+                            MOST-POSITIVE-FIXNUM)))

leaf.asd

@@ -1,6 +1,7 @@
 (asdf:defsystem leaf
   :components ((:file "package")
                (:file "helpers")
+               (:file "layered-container")
                (:file "packet")
                (:file "region")
                (:file "keys")

main.lisp

@@ -28,13 +28,8 @@
   (let ((region (make-instance 'region))
         (chunk (make-instance 'chunk :tileset (asset 'leaf 'ice))))
     (enter region level)
-    (enter (make-instance 'background :texture (asset 'leaf 'icey-mountains)) region)
     (enter chunk region)
-    (enter (make-instance 'falling-platform :texture (asset 'leaf 'ice)
-                                            :tile (vec 0 4)
-                                            :size (vec 48 48)
-                                            :bsize (vec 24 24))
-           chunk)
+    (enter (make-instance 'falling-platform :texture (asset 'leaf 'ice)) chunk)
     (enter (make-instance 'player :location (vec 64 64)) region)))
 
 (defclass main (trial:main)

moving-platform.lisp

@@ -1,7 +1,9 @@
 (in-package #:org.shirakumo.fraf.leaf)
 
 (define-shader-subject moving-platform (lighted-sprite-entity game-entity solid)
-  ())
+  ()
+  (:default-initargs
+   :bsize (vec2 32 32)))
 
 (defmethod collides-p ((platform moving-platform) thing hit) NIL)
 (defmethod collides-p ((platform moving-platform) (block block) hit) T)

player.lisp

@@ -263,13 +263,16 @@ void main(){
 
 (define-handler (player switch-level) (ev level)
   (let ((other (for:for ((entity over (unit 'region level)))
+                 (print (list entity (contained-p (location player) entity)))
                  (when (and (typep entity 'chunk)
                             (contained-p (location player) entity))
                    (return entity)))))
     (unless other
       (warn "Player is somehow outside all chunks, picking first chunk we can get.")
-      (setf other (for:for ((entity flare-queue:in-queue (objects level)))
-                    (when (typep entity 'chunk) (return entity)))))
+      (setf other (for:for ((entity over (unit 'region level)))
+                    (when (typep entity 'chunk) (return entity))))
+      (unless other
+        (error "What the fuck? Could not find any chunks.")))
     (issue level 'switch-chunk :chunk other)))
 
 (define-handler (player switch-chunk) (ev chunk)

region.lisp

@@ -2,78 +2,16 @@
 
 (defvar *current-layer*)
 
-(defclass region (container-unit entity)
-  ((objects :initform NIL)
-   (author :initform "Anonymous" :initarg :author :accessor author)
+(defclass region (layered-container entity)
+  ((author :initform "Anonymous" :initarg :author :accessor author)
    (version :initform "0.0.0" :initarg :version :accessor version)
    (description :initform "" :initarg :description :accessor description)
    (preview :initform NIL :initarg :preview :accessor preview))
   (:default-initargs :layers +layer-count+))
 
-(defmethod initialize-instance :after ((region region) &key layers)
-  (let ((objects (make-array layers)))
-    (dotimes (i layers)
-      (setf (aref objects i) (make-array 0 :adjustable T :fill-pointer T)))
-    (setf (objects region) objects)))
-
-(defgeneric layer-index (unit))
-
-(defmethod layer-index ((unit unit)) 0)
-
 (defmethod enter :after ((region region) (scene scene))
   (setf (gethash 'region (name-map scene)) region))
 
-(defmethod enter ((unit unit) (region region))
-  (let ((layer (+ (layer-index unit)
-                  (floor (length (objects region)) 2))))
-    (vector-push-extend unit (aref (objects region) layer))))
-
-(defmethod leave ((unit unit) (region region))
-  (let ((layer (+ (layer-index unit)
-                  (floor (length (objects region)) 2))))
-    (array-utils:vector-pop-position*
-     (aref (objects region) layer)
-     (position unit (aref (objects region) layer)))))
-
-(defmethod paint ((region region) target)
-  (let ((layers (objects region)))
-    (dotimes (i (length layers))
-      (let ((layer (aref layers i))
-            (*current-layer* (- i (floor (length layers) 2))))
-        (loop for unit across layer
-              do (paint unit target))))))
-
-(defmethod layer-count ((region region))
-  (length (objects region)))
-
-(defclass region-iterator (for:iterator)
-  ((layer :initarg :layer :accessor layer)
-   (start :initform 0 :accessor start)))
-
-(defmethod for:has-more ((iterator region-iterator))
-  (< (layer iterator) (length (for:object iterator))))
-
-(defmethod for:next ((iterator region-iterator))
-  (let ((layer (aref (for:object iterator) (layer iterator))))
-    (prog1 (aref layer (start iterator))
-      (incf (start iterator))
-      (when (<= (length layer) (start iterator))
-        (setf (start iterator) 0)
-        (loop for i from (1+ (layer iterator)) below (length (for:object iterator))
-              while (= 0 (length (aref (for:object iterator) i)))
-              finally (setf (layer iterator) i))))))
-
-(defmethod (setf for:current) ((unit unit) (iterator region-iterator))
-  (setf (aref (aref (for:object iterator) (layer iterator))
-              (start iterator))
-        unit))
-
-(defmethod for:make-iterator ((region region) &key)
-  (make-instance 'region-iterator
-                 :object (objects region)
-                 :layer (or (position 0 (objects region) :key #'length :test-not #'=)
-                            MOST-POSITIVE-FIXNUM)))
-
 (defclass version () ())
 
 (defun coerce-version (symbol)