Permalink
Browse files

Rework class redefinition system (untested)

  • Loading branch information...
Shinmera committed Jan 31, 2018
1 parent df83eb1 commit 39f1cd0173b61fc3cf9dd8cf888dc0bf39162e31
Showing with 101 additions and 38 deletions.
  1. +60 −0 redefinition-notifying-class.lisp
  2. +19 −7 shader-entity.lisp
  3. +18 −12 shader-pass.lisp
  4. +0 −5 shader-subject.lisp
  5. +2 −13 subject.lisp
  6. +2 −1 trial.asd
@@ -0,0 +1,60 @@
#|
This file is a part of trial
(c) 2018 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#
(in-package #:org.shirakumo.fraf.trial)
(defclass redefinition-notifying-class (standard-class)
((listeners :initform () :accessor %class-redefinition-listeners)))
(defmethod c2mop:validate-superclass ((class redefinition-notifying-class) (superclass t))
NIL)
(defmethod c2mop:validate-superclass ((class standard-class) (superclass redefinition-notifying-class))
T)
(defmethod c2mop:validate-superclass ((class redefinition-notifying-class) (superclass standard-class))
T)
(defmethod c2mop:validate-superclass ((class redefinition-notifying-class) (superclass redefinition-notifying-class))
T)
(defmethod c2mop:finalize-inheritance :after ((class redefinition-notifying-class))
(dolist (super (c2mop:class-direct-superclasses class))
(unless (c2mop:class-finalized-p super)
(c2mop:finalize-inheritance super)))
(notify-class-redefinition class class))
(defmethod notify-class-redefinition ((class redefinition-notifying-class) redef)
(loop for pointer in (%class-redefinition-listeners class)
for listener = (tg:weak-pointer-value pointer)
when listener do (notify-class-redefinition listener redef)))
(defmethod class-redefinition-listeners ((class symbol))
(class-redefinition-listeners (find-class class)))
(defmethod (setf class-redefinition-listeners) (value (class symbol))
(setf (class-redefinition-listeners (find-class class)) value))
(defmethod class-redefinition-listeners ((class redefinition-notifying-class))
(loop for pointer in (%class-redefinition-listeners class)
for listener = (tg:weak-pointer-value pointer)
when listener collect listener))
(defmethod (setf class-redefinition-listeners) (listeners (class redefinition-notifying-class))
(setf (%class-redefinition-listeners class)
(loop for listener in listeners
for pointer = (tg:make-weak-pointer listener)
collect listener)))
(defmethod add-class-redefinition-listener (listener (class redefinition-notifying-class))
(unless (find listener (%class-redefinition-listeners class) :key tg:weak-pointer-value)
(push (tg:make-weak-pointer listener) (%class-redefinition-listeners class)))
listener)
(defmethod remove-class-redefinition-listener (listener (class redefinition-notifying-class))
(setf (%class-redefinition-listeners class)
(delete listener (%class-redefinition-listeners class) :key #'tg:weak-pointer-value))
listener)
View
@@ -6,7 +6,7 @@
(in-package #:org.shirakumo.fraf.trial)
(defclass shader-entity-class (standard-class)
(defclass shader-entity-class (redefinition-notifying-class)
((effective-shaders :initform () :accessor effective-shaders)
(direct-shaders :initform () :initarg :shaders :accessor direct-shaders)
(inhibit-shaders :initform () :initarg :inhibit-shaders :accessor inhibit-shaders)))
@@ -74,12 +74,24 @@
(c2mop:finalize-inheritance super)))
(compute-effective-shaders class))
(defmethod (setf effective-shaders) :after (value (class shader-entity-class))
(notify-class-redefinition class class))
(defmethod (setf direct-shaders) :after (value (class shader-entity-class))
(compute-effective-shaders class))
(defmethod effective-shaders ((class symbol))
(effective-shaders (find-class class)))
(defmethod (setf effective-shaders) (value (class symbol))
(setf (effective-shaders (find-class class)) value))
(defmethod direct-shaders ((class symbol))
(direct-shaders (find-class class)))
(defmethod (setf direct-shaders) (value (class symbol))
(setf (direct-shaders (find-class class)) value))
(defmethod class-shader (type (class shader-entity-class))
(getf (direct-shaders class) type))
@@ -92,18 +104,12 @@
(defmethod (setf class-shader) (shader type (class symbol))
(setf (class-shader type (find-class class)) shader))
(defmethod (setf class-shader) :after (shader type (class shader-entity-class))
(compute-effective-shaders class))
(defmethod remove-class-shader (type (class shader-entity-class))
(remf (direct-shaders class) type))
(defmethod remove-class-shader (type (class symbol))
(remove-class-shader type (find-class class)))
(defmethod remove-class-shader :after (type (class shader-entity-class))
(compute-effective-shaders class))
(defmethod make-class-shader-program ((class shader-entity-class))
(make-asset 'shader-program
(loop for (type source) on (effective-shaders class) by #'cddr
@@ -120,9 +126,15 @@
(defmethod effective-shaders ((subject shader-entity))
(effective-shaders (class-of subject)))
(defmethod (setf effective-shaders) (value (subject shader-entity))
(setf (effective-shaders (class-of subject)) value))
(defmethod direct-shaders ((subject shader-entity))
(direct-shaders (class-of subject)))
(defmethod (setf direct-shaders) (value (subject shader-entity))
(setf (direct-shaders (class-of subject)) value))
(defmethod class-shader (type (subject shader-entity))
(class-shader type (class-of subject)))
View
@@ -56,6 +56,9 @@
(:metaclass shader-pass-class)
(:inhibit-shaders (shader-entity :fragment-shader)))
(defmethod initialize-instance :after ((pass shader-pass) &key)
(add-class-redefinition-listener pass (class-of pass)))
(define-class-shader (shader-pass :fragment-shader)
"#version 330 core")
@@ -66,6 +69,9 @@
(defgeneric coerce-pass-shader (pass class type spec))
(defgeneric determine-effective-shader-class (class))
(defmethod register-object-for-pass :after ((pass shader-pass) (object shader-entity))
(add-class-redefinition-listener pass (class-of object)))
(defmethod finalize :after ((pass shader-pass))
(when (framebuffer pass)
(finalize (framebuffer pass))))
@@ -106,12 +112,12 @@
(define-shader-pass per-object-pass ()
((assets :initform (make-hash-table :test 'eql) :accessor assets)))
(define-handler (per-object-pass update-shader-for-redefined-subject subject-class-redefined) (ev subject-class)
(let ((assets (assets per-object-pass)))
(defmethod notify-class-redefinition ((pass per-object-pass) (class shader-entity-class))
(let ((assets (assets pass)))
(flet ((refresh (class)
(let ((previous (gethash class assets)))
(remhash class assets)
(register-object-for-pass per-object-pass class)
(register-object-for-pass pass class)
(let ((new (gethash class assets)))
(when (and previous (resource previous)
(not (eql previous new)))
@@ -122,14 +128,14 @@
(continue ()
:report "Ignore the change and continue with the hold shader."
(setf (gethash class assets) previous))))))))
(cond ((eql subject-class (class-of per-object-pass))
(cond ((eql class (class-of pass))
;; Pass changed, recompile everything
(loop for class being the hash-keys of assets
do (refresh class)))
((and (typep subject-class 'shader-entity-class)
(not (typep subject-class 'shader-pass-class)))
((and (typep class 'shader-entity-class)
(not (typep class 'shader-pass-class)))
;; Object changed, recompile it
(refresh subject-class))))))
(refresh class))))))
(defmethod shader-program-for-pass ((pass per-object-pass) (subject shader-entity))
(gethash (class-of subject) (assets pass)))
@@ -231,13 +237,13 @@
(define-shader-pass single-shader-pass ()
((shader-program :initform (make-instance 'shader-program) :accessor shader-program)))
(define-handler (single-shader-pass update-shader-for-redefined-subject subject-class-redefined) (ev subject-class)
(when (eql subject-class (class-of single-shader-pass))
(let* ((program (shader-program single-shader-pass))
(defmethod notify-class-redefinition ((pass single-shader-pass) class)
(when (eql class (class-of pass))
(let* ((program (shader-program pass))
(loaded (and program (resource program))))
(when loaded (offload program))
(setf (shader-program single-shader-pass) (make-class-shader-program single-shader-pass))
(when loaded (load (shader-program single-shader-pass))))))
(setf (shader-program pass) (make-class-shader-program pass))
(when loaded (load (shader-program pass))))))
(defmethod load progn ((pass single-shader-pass))
(setf (shader-program pass) (make-class-shader-program pass)))
View
@@ -9,11 +9,6 @@
(defclass shader-subject-class (subject-class shader-entity-class)
())
(defmethod (setf effective-shaders) :after (shaders (class shader-subject-class))
;; Mark as obsolete
(setf (class-redefinition-event-sent class) NIL)
(make-instances-obsolete class))
(defclass shader-subject (subject shader-entity)
()
(:metaclass shader-subject-class))
View
@@ -6,12 +6,8 @@
(in-package #:org.shirakumo.fraf.trial)
(defclass subject-class-redefined (event)
((subject-class :initarg :subject-class :reader subject-class)))
(defclass subject-class (standard-class handler-container)
((effective-handlers :initform NIL :accessor effective-handlers)
(class-redefinition-event-sent :initform T :accessor class-redefinition-event-sent)))
((effective-handlers :initform NIL :accessor effective-handlers)))
(defmethod c2mop:validate-superclass ((class subject-class) (superclass t))
NIL)
@@ -33,8 +29,6 @@
(dolist (handler (effective-handlers super))
(pushnew handler effective-handlers :key #'name)))
finally (setf (effective-handlers class) effective-handlers))
;; Mark as obsolete
(setf (class-redefinition-event-sent class) NIL)
(make-instances-obsolete class))
(defmethod compute-effective-handlers :after ((class subject-class))
@@ -73,12 +67,7 @@
(regenerate-handlers subject))
(defmethod update-instance-for-redefined-class ((subject subject) aslots dslots plist &key args)
(let ((class (class-of subject)))
(regenerate-handlers subject)
(when (not (class-redefinition-event-sent class))
(dolist (event-loop (event-loops subject))
(issue event-loop 'subject-class-redefined :subject-class class))
(setf (class-redefinition-event-sent class) T))))
(regenerate-handlers subject))
(defmethod regenerate-handlers ((subject subject))
(setf (handlers subject)
View
@@ -51,13 +51,14 @@
(:file "pipeline" :depends-on ("package" "event-loop" "toolkit"))
(:file "pipelined-scene" :depends-on ("package" "pipeline" "scene" "loader"))
(:file "rails" :depends-on ("package" "subject" "helpers"))
(:file "redefinition-notifying-class" :depends-on ("package"))
(:file "render-texture" :depends-on ("package" "pipeline" "entity"))
(:file "renderable" :depends-on ("package" "toolkit"))
(:file "retention" :depends-on ("package" "event-loop"))
(:file "scene-buffer" :depends-on ("package" "scene" "render-texture"))
(:file "scene" :depends-on ("package" "event-loop" "entity"))
(:file "selection-buffer" :depends-on ("package" "render-texture" "scene" "effects" "loader"))
(:file "shader-entity" :depends-on ("package" "entity"))
(:file "shader-entity" :depends-on ("package" "entity" "redefinition-notifying-class"))
(:file "shader-pass" :depends-on ("package" "shader-subject" "asset" "scene" "loader"))
(:file "shader-subject" :depends-on ("package" "shader-entity" "subject"))
(:file "skybox" :depends-on ("package" "shader-subject" "transforms"))

0 comments on commit 39f1cd0

Please sign in to comment.