-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
layered-container.lisp
58 lines (47 loc) · 2.11 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
(in-package #:org.shirakumo.fraf.trial)
(defclass layered-container (container)
((%objects :initform NIL :accessor %objects))
(: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) (make-instance 'bag :container container)))
(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))
(enter thing (aref (%objects container) (clamp 0 (round (layer-index thing)) (1- (length (%objects container)))))))
(defmethod leave (thing (container layered-container))
(leave thing (aref (%objects container) (clamp 0 (round (layer-index thing)) (1- (length (%objects container)))))))
(defmethod clear ((container layered-container))
(loop for layer across (%objects container)
do (clear layer))
container)
(defmethod for:step-functions ((iterator layered-container))
(let* ((layers (%objects iterator))
(layer-idx 0) (idx 0) layer size)
(flet ((update ()
(let ((bag (aref layers layer-idx)))
(setf layer (%objects bag))
(setf idx 0)
(setf size (size bag)))))
(update)
(values (lambda ()
(prog1 (aref layer idx)
(incf idx)
(decf size)))
(lambda ()
(loop while (= 0 size)
do (incf layer-idx)
(if (< layer-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)