-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
render-loop.lisp
100 lines (87 loc) · 4.53 KB
/
render-loop.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
(in-package #:org.shirakumo.fraf.trial)
(defclass render-loop ()
((thread :initform NIL :accessor thread)
(delta-time :initarg :delta-time :initform 0.01f0 :accessor delta-time)
(frame-time :initform 0.0d0 :accessor frame-time)
(target-frame-time :initarg :target-frame-time :initform 0.0d0 :accessor target-frame-time)))
(defmethod initialize-instance :after ((loop render-loop) &key (target-framerate (setting :display :target-framerate)))
(setf (target-frame-time loop) (float (typecase target-framerate
(real (/ target-framerate))
(T 0.0))
0d0)))
(defmethod start ((render-loop render-loop))
#+nx (setf (org.shirakumo.machine-state:thread-core-mask T) #b0001)
(setf (thread render-loop) T)
(setf (thread render-loop)
(with-thread ("render-loop")
#+nx (setf (org.shirakumo.machine-state:thread-core-mask T) #b0010)
(render-loop render-loop))))
(defmethod stop ((render-loop render-loop))
(let ((thread (thread render-loop)))
(with-thread-exit (thread)
(setf (thread render-loop) NIL))))
(defmethod finalize :before ((render-loop render-loop))
(stop render-loop))
(defmethod render (thing (render-loop render-loop)))
(defmethod update ((render-loop render-loop) tt dt fc))
(defmethod render-loop ((render-loop render-loop))
(declare (optimize speed))
(let ((fc 0))
(declare (type fixnum fc))
(with-simple-restart (exit-render-loop "Exit the render loop entirely.")
(with-unwind-protection (v:info :trial.render-loop "Exiting render-loop for ~a." render-loop)
(v:debug :trial.render-loop "Entering render-loop")
(with-retry-restart (reset-render-loop "Reset the render loop timing, not catching up with lost frames.")
(let ((tt 0.0d0)
(fdt (coerce (delta-time render-loop) 'single-float))
(dt (coerce (delta-time render-loop) 'double-float))
(target-frame-time (coerce (target-frame-time render-loop) 'double-float))
(current-time (current-time))
;; Accumulator starts big such that we ensure an UPDATE happens
;; before the first RENDER can happen. Otherwise we get an ugly
;; first frame display.
(accumulator 1000.0d0)
(new-time 0.0d0)
(frame-time 0.0d0)
(extra-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 (loop (setf new-time (current-time))
(setf frame-time (- new-time current-time))
(setf extra-time (- target-frame-time frame-time))
(when (<= extra-time 0.0)
(return))
(sleep extra-time))
(setf current-time new-time)
(incf accumulator frame-time)
(loop while (<= dt accumulator)
do (when (<= 10d0 accumulator)
(setf accumulator dt))
(update render-loop tt fdt fc)
(decf accumulator dt)
(incf tt dt)
(incf fc))
;; 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))))))))))
(defun 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))