Migrate systems to init/discard flows where appropriate

borodust · Oct 3, 2018 · 1f07e50 · 1f07e50
1 parent 33de4ee
commit 1f07e50
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 22 deletions.
diff --git a/graphics/system.lisp b/graphics/system.lisp
@@ -15,9 +15,22 @@
   (:default-initargs :depends-on '(host-system)))
 
 
-(defmethod initialize-system :after ((this graphics-system))
+(defmethod enabling-flow list ((this graphics-system))
   (with-slots (resource-executor) this
-    (setf resource-executor (acquire-executor :single-threaded-p t :exclusive-p t))))
+    (>> (%> ()
+          (setf resource-executor (acquire-executor :single-threaded-p t :exclusive-p t))
+          (execute resource-executor
+                   (lambda ()
+                     (bind-rendering-context :main nil)
+                     (log:debug "Shared context bound")
+                     (run (concurrently () (continue-flow))))
+                   :priority :highest :important-p t))
+        (for-host ()
+          (framebuffer-size))
+        (-> this (viewport)
+          (declare (type vec2 viewport))
+          (update-context-framebuffer-size (floor (x viewport))
+                                           (floor (y viewport)))))))
 
 
 (defmethod disabling-flow list ((this graphics-system))
@@ -31,9 +44,9 @@
                            (progn
                              (release-rendering-context)
                              (log:debug "Shared context released"))
-                        (continue-flow)))
+                        (run (concurrently () (continue-flow)))))
                     :priority :highest :important-p t)
-           (continue-flow)))
+           (run (concurrently () (continue-flow)))))
      (instantly ()
        (release-executor resource-executor)))))
 
@@ -48,23 +61,6 @@
      ,@body))
 
 
-(defmethod enabling-flow list ((this graphics-system))
-  (with-slots (resource-executor) this
-    (>> (%> ()
-          (execute resource-executor
-                   (lambda ()
-                     (bind-rendering-context :main nil)
-                     (log:debug "Shared context bound")
-                     (continue-flow))
-                   :priority :highest :important-p t))
-        (for-host ()
-          (framebuffer-size))
-        (-> this (viewport)
-          (declare (type vec2 viewport))
-          (update-context-framebuffer-size (floor (x viewport))
-                                           (floor (y viewport)))))))
-
-
 (defmethod dispatch ((this graphics-system) (task function) invariant &rest args
                      &key (main-p t) disposing)
   (with-slots (resource-executor) this

diff --git a/host/system.lisp b/host/system.lisp
@@ -107,7 +107,7 @@
 
 
 (defmethod disabling-flow list ((this host-system))
-  (ge.ng:>>
+  (>>
    (%> ()
      (bodge-host:destroy-shared-rendering-context (shared-application this))
      (set-destroy-continuation (host-application this) #'continue-flow)