Implement single-threaded game support

Shirakumo · Aug 31, 2024 · 9918a42 · 9918a42
1 parent aff812d
commit 9918a42
Show file tree

Hide file tree

Showing 5 changed files with 54 additions and 23 deletions.
diff --git a/backends/glfw/context.lisp b/backends/glfw/context.lisp
@@ -244,7 +244,9 @@
   pos)
 
 (defmethod poll-input ((context context))
-  (glfw:poll-events :timeout NIL))
+  (glfw:poll-events :timeout NIL)
+  (when (glfw:should-close-p context)
+    (exit-render-loop)))
 
 (defun make-context (&optional handler &rest initargs)
   (handler-case (glfw:init)
@@ -258,25 +260,26 @@
                #+trial-release (error () (error 'trial:context-creation-error :message "Failed to initialize GLFW.")))
              (let ((main (apply #'make-instance main initargs)))
                (start main)
-               (trial:rename-thread "input-loop")
-               (v:debug :trial.backend.glfw "Entering input loop")
                (unwind-protect
-                    (let ((context (trial:context main)))
-                      (flet ((handler (request arg)
-                               (handler-case
-                                   (ecase request
-                                     (:get-clipboard (glfw:clipboard-string context))
-                                     (:set-clipboard (setf (glfw:clipboard-string context) arg)))
-                                 #+trial-release
-                                 (error (e)
-                                   (v:debug :trial.backend.glfw e)
-                                   (v:error :trial.backend.glfw "Failed to execute ~a: ~a" request e)
-                                   ""))))
-                        (declare (dynamic-extent #'handler))
-                        (loop until (glfw:should-close-p context)
-                              do (glfw:poll-events :timeout 0.005d0)
-                                 (poll-input main)
-                                 (handle-event-queue (event-queue context) #'handler))))
+                    (unless (typep main 'trial::single-threaded-display)
+                      (let ((context (trial:context main)))
+                        (trial:rename-thread "input-loop")
+                        (v:debug :trial.backend.glfw "Entering input loop")
+                        (flet ((handler (request arg)
+                                 (handler-case
+                                     (ecase request
+                                       (:get-clipboard (glfw:clipboard-string context))
+                                       (:set-clipboard (setf (glfw:clipboard-string context) arg)))
+                                   #+trial-release
+                                   (error (e)
+                                     (v:debug :trial.backend.glfw e)
+                                     (v:error :trial.backend.glfw "Failed to execute ~a: ~a" request e)
+                                     ""))))
+                          (declare (dynamic-extent #'handler))
+                          (loop until (glfw:should-close-p context)
+                                do (glfw:poll-events :timeout 0.005d0)
+                                   (poll-input main)
+                                   (handle-event-queue (event-queue context) #'handler)))))
                  (v:debug :trial.backend.glfw "Cleaning up")
                  (unwind-protect (finalize main)
                    (glfw:shutdown)))))

diff --git a/backends/nxgl/context.lisp b/backends/nxgl/context.lisp
@@ -170,7 +170,9 @@
     (nxgl:poll (pointer context) count events)
     (loop for i from 0 below (cffi:mem-ref count :size)
           for event = (cffi:mem-aptr events '(:struct nxgl:event) i)
-          do (process-event context event))))
+          do (process-event context event)))
+  (when (close-pending-p context)
+    (exit-render-loop)))
 
 (cffi:define-foreign-library %gl::opengl
   (t "opengl.nso"))

diff --git a/display.lisp b/display.lisp
@@ -83,3 +83,9 @@
 
 (defmethod height ((display display))
   (height (context display)))
+
+(defclass single-threaded-display (single-threaded-render-loop display)
+  ())
+
+(defmethod poll-input :after ((display single-threaded-display))
+  (poll-input (context display)))
diff --git a/package.lisp b/package.lisp
@@ -1547,11 +1547,11 @@
    #:frame-time
    #:target-frame-time
    #:reset-render-loop
+   #:exit-render-loop
    #:start
    #:stop
    #:render
-   #:update
-   #:reset-render-loop)
+   #:update)
   ;; resource.lisp
   (:export
    #:resource

diff --git a/render-loop.lisp b/render-loop.lisp
@@ -77,4 +77,24 @@
                          (render render-loop render-loop))))))))))
 
 (defun reset-render-loop ()
-  (invoke-restart 'reset-render-loop))
+  (when (find-restart 'reset-render-loop)
+    (invoke-restart 'reset-render-loop)))
+
+(defun exit-render-loop ()
+  (when (find-restart 'exit-render-loop)
+    (invoke-restart 'exit-render-loop)))
+
+(defclass single-threaded-render-loop (render-loop)
+  ())
+
+(defmethod start ((render-loop single-threaded-render-loop))
+  (setf (thread render-loop) (bt:current-thread))
+  (render-loop render-loop))
+
+(defmethod stop ((render-loop single-threaded-render-loop))
+  (setf (thread render-loop) NIL)
+  (when (find-restart 'exit-render-loop)
+    (invoke-restart 'exit-render-loop)))
+
+(defmethod update :after ((render-loop single-threaded-render-loop) tt dt fc)
+  (poll-input render-loop))