Make EXIT-RENDER-LOOP quit the context automatically.

Shirakumo · Jun 13, 2020 · 82ca47e · 82ca47e
1 parent 9125407
commit 82ca47e
Showing 1 changed file with 31 additions and 28 deletions.
diff --git a/render-loop.lisp b/render-loop.lisp
@@ -32,31 +32,34 @@
   (declare (optimize speed))
   (let ((fc 0))
     (declare (type fixnum fc))
-    (with-simple-restart (exit-render-loop "Exit the render loop entirely.")
-      (unwind-protect
-           (with-retry-restart (reset-render-loop "Reset the render loop timing, not catching up with lost frames.")
-             (let ((tt 0.0d0)
-                   (dt (coerce (delta-time render-loop) 'double-float))
-                   (current-time (current-time))
-                   (accumulator 0.0d0)
-                   (new-time 0.0d0)
-                   (frame-time 0.0d0))
-               (declare (type double-float tt dt current-time
-                              accumulator new-time frame-time))
-               (with-error-logging (:trial.render-loop "Error in render thread")
-                 (loop while (thread render-loop)
-                       do (setf new-time (current-time))
-                          (setf frame-time (- new-time current-time))
-                          (setf current-time new-time)
-                          (incf accumulator frame-time)
-                          (loop while (<= dt accumulator)
-                                do (update render-loop tt dt fc)
-                                   (decf accumulator dt)
-                                   (incf tt dt))
-                          ;; FIXME: interpolate state
-                          ;;        See http://gafferongames.com/game-physics/fix-your-timestep/
-                          (setf (frame-time render-loop) frame-time)
-                          (with-simple-restart (abort "Abort the update and retry.")
-                            (render render-loop render-loop)
-                            (incf fc))))))
-        (v:info :trial.render-loop "Exiting render-loop for ~a." render-loop)))))
+    (restart-case
+        (unwind-protect
+             (with-retry-restart (reset-render-loop "Reset the render loop timing, not catching up with lost frames.")
+               (let ((tt 0.0d0)
+                     (dt (coerce (delta-time render-loop) 'double-float))
+                     (current-time (current-time))
+                     (accumulator 0.0d0)
+                     (new-time 0.0d0)
+                     (frame-time 0.0d0))
+                 (declare (type double-float tt dt current-time
+                                accumulator new-time frame-time))
+                 (with-error-logging (:trial.render-loop "Error in render thread")
+                   (loop while (thread render-loop)
+                         do (setf new-time (current-time))
+                            (setf frame-time (- new-time current-time))
+                            (setf current-time new-time)
+                            (incf accumulator frame-time)
+                            (loop while (<= dt accumulator)
+                                  do (update render-loop tt dt fc)
+                                     (decf accumulator dt)
+                                     (incf tt dt))
+                            ;; FIXME: interpolate state
+                            ;;        See http://gafferongames.com/game-physics/fix-your-timestep/
+                            (setf (frame-time render-loop) frame-time)
+                            (with-simple-restart (abort "Abort the update and retry.")
+                              (render render-loop render-loop)
+                              (incf fc))))))
+          (v:info :trial.render-loop "Exiting render-loop for ~a." render-loop))
+      (exit-render-loop ()
+        :report "Exit the render loop entirely."
+        (quit *context*)))))