Permalink
Browse files

Add banned-slots method to easily remove slots from loader considerat…

…ions.

Perform other minor loader related improvements
  • Loading branch information...
Shinmera committed Oct 21, 2018
1 parent ab78568 commit eabfc31eff8229f9a2e7ac911d41868e8c934da9
Showing with 32 additions and 10 deletions.
  1. +2 −2 controller.lisp
  2. +14 −8 loader.lisp
  3. +1 −0 package.lisp
  4. +4 −0 pipeline.lisp
  5. +5 −0 pipelined-scene.lisp
  6. +3 −0 scene.lisp
  7. +3 −0 subject.lisp
View
@@ -37,8 +37,8 @@
(:default-initargs
:name :controller))
(defmethod compute-resources ((controller controller) resources readying cache)
(compute-resources (text controller) resources readying cache))
(defmethod banned-slots append ((object entity))
'(display fps-buffer))
(defmethod register-object-for-pass :after (pass (controller controller))
(register-object-for-pass pass (text controller)))
View
@@ -6,6 +6,8 @@
(in-package #:org.shirakumo.fraf.trial)
(defgeneric banned-slots (object)
(:method-combination append))
(defgeneric compute-resources (object resource-vector readying-vector traversal-cache))
(defgeneric bake (bakable))
(defgeneric baked-p (bakable))
@@ -34,18 +36,22 @@
(compute-resources (cdr cons) resources readying cache))
(defmethod compute-resources ((vector vector) resources readying cache)
(unless (typep vector 'string)
(when (eql T (array-element-type vector))
(loop for object across vector
do (compute-resources object resources readying cache))))
(defmethod compute-resources ((table hash-table) resources readying cache)
(loop for value being the hash-values of table
do (compute-resources value resources readying cache)))
(defmethod banned-slots append ((object entity))
())
(defmethod compute-resources ((object entity) resources readying cache)
(loop for slot in (c2mop:class-slots (class-of object))
(loop with banned = (banned-slots object)
for slot in (c2mop:class-slots (class-of object))
for name = (c2mop:slot-definition-name slot)
when (slot-boundp object name)
when (and (not (find name banned :test 'eq)) (slot-boundp object name))
do (compute-resources (slot-value object name) resources readying cache)))
(defmethod compute-resources ((queue flare-queue:queue) resources readying cache)
@@ -75,11 +81,6 @@
(defmethod compute-resources :before ((readied readied) resources readying cache)
(vector-push-extend readied readying))
(defun stable-set-difference-eq (a b)
(let ((table (make-hash-table :test 'eq :size (length b))))
(loop for item across b do (setf (gethash item table) T))
(remove-if (lambda (item) (gethash item table)) a)))
(defun topological-sort-by-dependencies (resources)
(let ((status (make-hash-table :test 'eq))
(sorted (make-array (length resources) :fill-pointer 0)))
@@ -131,6 +132,11 @@
(%transition NIL to-deallocate NIL)
to))
(defun stable-set-difference-eq (a b)
(let ((table (make-hash-table :test 'eq :size (length b))))
(loop for item across b do (setf (gethash item table) T))
(remove-if (lambda (item) (gethash item table)) a)))
(defmethod transition ((from scene) (to scene))
(v:info :trial.loader "Transitioning from ~a to ~a" from to)
(multiple-value-bind (to to-ready) (compute-resources-for to)
View
@@ -392,6 +392,7 @@
#:layer)
;; loader.lisp
(:export
#:banned-slots
#:compute-resources
#:resources-ready
#:bake
View
@@ -165,3 +165,7 @@
(defmethod register-object-for-pass ((pipeline pipeline) object)
(loop for pass across (passes pipeline)
do (register-object-for-pass pass object)))
(defmethod compute-resources ((pipeline pipeline) resources readying cache)
(compute-resources (passes pipeline) resources readying cache)
(compute-resources (textures pipeline) resources readying cache))
View
@@ -29,5 +29,10 @@
(for:for ((element over scene))
(register-object-for-pass scene element)))
(defmethod compute-resources ((scene pipelined-scene) resources readying cache)
(compute-resources (objects scene) resources readying cache)
(compute-resources (textures scene) resources readying cache)
(compute-resources (passes scene) resources readying cache))
(defmethod handle :after ((event resize) (scene pipelined-scene))
(resize scene (width event) (height event)))
View
@@ -48,6 +48,9 @@
(let ((*scene* scene))
(call-next-method)))
(defmethod banned-slots append ((object scene))
'(queue handlers))
;; Since we have a tick event, we don't want to dupe that here.
;; animations and clock update are already handled by the method
;; combination, but defining a noop primary method prevents update
View
@@ -60,6 +60,9 @@
((event-loops :initarg :event-loops :initform NIL :accessor event-loops))
(:metaclass subject-class))
(defmethod banned-slots append ((object subject))
'(event-loops))
(defmethod initialize-instance :after ((subject subject) &key)
(regenerate-handlers subject))

0 comments on commit eabfc31

Please sign in to comment.