Ad-hoc notification method for engine -> system communication

borodust · Jan 5, 2017 · 4c5f98f · 4c5f98f
1 parent b5288c7
commit 4c5f98f
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 9 deletions.
diff --git a/engine/engine.lisp b/engine/engine.lisp
@@ -43,6 +43,9 @@
 (defgeneric enable (system)
   (:method (system) nil))
 
+(defgeneric notify-system (system notification &key &allow-other-keys)
+  (:method (system notification &key)))
+
 (defgeneric disable (system)
   (:method (system) nil))
 
@@ -132,7 +135,9 @@
              (property :systems (lambda ()
                                   (error ":systems property should be defined")))))
         (setf systems (alist-hash-table (instantiate-systems system-class-names))
-              disabling-order (enable-requested-systems systems))))))
+              disabling-order (enable-requested-systems systems)))
+      (loop for system being the hash-value of systems
+         do (notify-system system :engine-started)))))
 
 
 (defun shutdown ()
@@ -192,6 +197,11 @@
      ,@body))
 
 
+(defmacro concurrently ((&rest lambda-list) &body body)
+  `(-> (nil :concurrently-p t) ,lambda-list
+     ,@body))
+
+
 (defun value-flow (value)
   (instantly () value))
 

diff --git a/engine/packages.lisp b/engine/packages.lisp
@@ -113,6 +113,7 @@
            enable
            disable
            enabledp
+           notify-system
            acquire-executor
            release-executor
            working-directory
@@ -121,6 +122,7 @@
            dispatcher
            run
            instantly
+           concurrently
            value-flow
            null-flow
 

diff --git a/events/system.lisp b/events/system.lisp
@@ -12,12 +12,15 @@
 
 (defmethod initialize-system :after ((this event-system))
   (with-slots (executor) this
-    (setf executor (acquire-executor))
-    (flet ((register-handler (event-class-name handler)
-             (subscribe-to event-class-name handler this)))
-      (loop for (event-class-name . handler-name) in *predefined-event-callbacks*
-           do (register-handler event-class-name handler-name))
-      (setf *registration-callback* #'register-handler))))
+    (setf executor (acquire-executor))))
+
+
+(defmethod notify-system ((this event-system) (notification (eql :engine-started)) &key)
+  (flet ((register-handler (event-class-name handler)
+           (subscribe-to event-class-name handler this)))
+    (loop for (event-class-name . handler-name) in *predefined-event-callbacks*
+       do (register-handler event-class-name handler-name))
+    (setf *registration-callback* #'register-handler)))
 
 
 (definline events ()
@@ -33,9 +36,11 @@
 
 (defmacro %with-accessor-bindings ((accessor-bindings event-var) &body body)
   (let ((bindings (loop for binding in accessor-bindings
-                     for (name accessor) = (if (listp binding)
+                     for (name accessor) = (if (and (listp binding) (second binding))
                                                binding
-                                               (list binding binding))
+                                               (list binding (format-symbol
+                                                              (symbol-package binding)
+                                                              "~A~A" binding '-from)))
                      collect `(,name (,accessor ,event-var)))))
     `(symbol-macrolet ,bindings
        ,@body)))