forked from Shirakumo/trial
-
Notifications
You must be signed in to change notification settings - Fork 0
/
layered-container.lisp
72 lines (60 loc) · 2.72 KB
/
layered-container.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#|
This file is a part of trial
(c) 2016 Shirakumo http://tymoon.eu ([email protected])
Author: Nicolas Hafner <[email protected]>
|#
(in-package #:org.shirakumo.fraf.trial)
(defclass layered-container (container)
((objects :initform NIL))
(:default-initargs :layer-count (error "LAYER-COUNT required.")))
(defmethod initialize-instance :after ((container layered-container) &key layer-count)
(let ((objects (make-array layer-count)))
(dotimes (i (length objects))
(setf (aref objects i) (flare-indexed-set:make-indexed-set)))
(setf (objects container) objects)))
(defgeneric layer-index (unit))
(defmethod layer-index ((_ unit)) 0)
(defmethod layer-count ((container layered-container))
(length (objects container)))
(defmethod enter (thing (container layered-container))
(flare-indexed-set:set-add thing (aref (objects container) (layer-index thing))))
(defmethod leave (thing (container layered-container))
(flare-indexed-set:set-remove thing (aref (objects container) (layer-index thing))))
(defmethod preceding-entity ((thing entity) (container layered-container))
(let ((objects (objects container))
(preceding NIL))
(loop for index downfrom (layer-index thing)
for set = (aref objects index)
for head = (flare-queue::head set)
for last = (flare-queue::left (flare-queue::tail set))
do (loop until (or (eq last head)
(and (typep (flare-queue:value last) 'renderable)
(not (eq (flare-queue:value last) thing))))
do (setf last (flare-queue::left last)))
(unless (eq last head)
(return (setf preceding (flare-queue:value last)))))
preceding))
(defmethod for:step-functions ((iterator layered-container))
(let* ((layers (objects iterator))
(idx 0) layer cell tail)
(flet ((update ()
(setf layer (aref layers idx))
(setf cell (flare-queue:right (flare-queue::head layer)))
(setf tail (flare-queue::tail layer))))
(update)
(values (lambda ()
(prog1 (flare-queue:value cell)
(setf cell (flare-queue:right cell))))
(lambda ()
(loop while (eql cell tail)
do (incf idx)
(if (< idx (length layers))
(update)
(return NIL))
finally (return T)))
(lambda (value)
(declare (ignore value))
(error "Not supported"))
(lambda ())))))
(defmethod for:object ((container layered-container)) container)
(defmethod for:make-iterator ((container layered-container) &key) container)