-
-
Notifications
You must be signed in to change notification settings - Fork 32
/
camera.lisp
257 lines (232 loc) · 10.8 KB
/
camera.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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
(in-package #:org.shirakumo.fraf.kandria)
(defclass camera (trial:2d-camera unpausable)
((name :initform :camera)
(scale :initform 1.0 :accessor view-scale)
(intended-scale :initform 1.0 :accessor intended-view-scale)
(target-size :initarg :target-size :accessor target-size)
(target :initarg :target :initform NIL :accessor target)
(intended-location :initform (vec2 0 0) :accessor intended-location)
(zoom :initarg :zoom :initform 1.0 :accessor zoom)
(intended-zoom :initform 1.0 :accessor intended-zoom)
(chunk :initform NIL :accessor chunk)
(shake-timer :initform 0f0 :accessor shake-timer)
(shake-intensity :initform 3 :accessor shake-intensity)
(shake-unique :initform 0 :accessor shake-unique)
(rumble-intensity :initform 1.0 :accessor rumble-intensity)
(offset :initform (vec 0 0) :accessor offset)
(fix-offset :initform NIL :accessor fix-offset)
(in-view-tester :initform (vec 0 0 0 0) :accessor in-view-tester))
(:default-initargs
:location (vec 0 0)
:target-size (v* +tiles-in-view+ +tile-size+ .5)))
(defmethod (setf view-scale) (value (camera camera))
(setf (slot-value camera 'scale) (max 0.0001 value)))
(defmethod (setf zoom) (value (camera camera))
(setf (slot-value camera 'zoom) (max 0.0001 value)))
(defmethod reset ((camera camera))
(dolist (gamepad (gamepad:list-devices))
(gamepad:rumble gamepad 0.0))
(setf (target camera) NIL)
(setf (chunk camera) NIL)
(setf (location camera) (vec 0 0))
(setf (intended-location camera) (vec 0 0))
(setf (zoom camera) 1.0)
(setf (intended-zoom camera) 1.0)
(setf (shake-timer camera) 0.0)
(setf (offset camera) (vec 0 0)))
(defmethod (setf location) ((loc vec2) (camera camera))
(v<- (location camera) loc))
(defmethod map-visible (function (camera camera) (region region))
(dolist (entity (indefinite-extent-entities region))
(funcall function entity))
(do-fitting (entity (bvh region) (in-view-tester camera))
(funcall function entity)))
(defmethod layer-index ((counter fps-counter)) 100)
(defmethod map-visible (function (camera camera) (world world))
(let ((fps (node 'fps-counter world)))
(when fps (funcall function fps)))
(if (region world)
(map-visible function camera (region world))
(call-next-method)))
(defmethod enter :after ((camera camera) (scene scene))
(setf (target camera) (node 'player scene))
(when (target camera)
(setf (location camera) (vcopy (location (target camera))))))
(defun clamp-camera-target (camera target &optional (dir :both))
(let ((chunk (chunk camera))
(zoom (max (zoom camera) (intended-zoom camera))))
(when chunk
(let ((lx (vx2 (location chunk)))
(ly (vy2 (location chunk)))
(lw (vx2 (bsize chunk)))
(lh (vy2 (bsize chunk)))
(cw (/ (vx2 (target-size camera)) zoom))
(ch (/ (vy2 (target-size camera)) zoom)))
(when (or (eql dir :both) (eql dir :x))
(setf (vx target) (clamp (1+ (+ lx cw (- lw)))
(vx target)
(1- (+ lx (- cw) lw)))))
(when (or (eql dir :both) (eql dir :y))
(setf (vy target) (clamp (1+ (+ ly ch (- lh)))
(vy target)
(1- (+ ly (- ch) lh)))))))))
(defmethod handle :before ((ev tick) (camera camera))
(unless (find-panel 'editor)
(let ((loc (location camera))
(dt (dt ev)))
;; Camera movement
(let ((int (intended-location camera)))
(when (target camera)
(let ((tar (location (target camera))))
(vsetf int (round (vx tar)) (round (vy tar)))))
(clamp-camera-target camera int)
(let* ((dir (v- int loc))
(len (max 1 (vlength dir)))
(ease (clamp 0 (+ 0.2 (/ (expt len 1.4) 100)) 20)))
(nv* dir (/ ease len))
(nv+ loc dir)
;; View scale transitioning
(let* ((z (view-scale camera))
(int (intended-view-scale camera)))
(when (/= z int)
(let ((dir (/ (- (log int) (log (max z 0.0001))) 10)))
(if (< (abs dir) 0.001)
(setf (view-scale camera) int)
(incf (view-scale camera) dir)))
;; Clamp based on move direction only
(clamp-camera-target camera loc (cond ((< (abs (vx dir)) (abs (vy dir))) :x)
((= 0.0 (vy dir)) NIL)
(T :y)))))))
;; Camera zoom
(let* ((z (zoom camera))
(int (intended-zoom camera)))
(when (/= z int)
(let ((dir (/ (- (log int) (log z)) 10)))
(if (< (abs dir) 0.001)
(setf (zoom camera) int)
(incf (zoom camera) dir)))
(clamp-camera-target camera loc)))
;; Camera shake
(when (< 0 (shake-timer camera))
(decf (shake-timer camera) dt)
(when (typep +input-source+ 'gamepad:device)
(gamepad:rumble +input-source+ (if (< 0 (shake-timer camera))
(rumble-intensity camera)
0.0)))
;; Deterministic shake so that we can slow it down properly.
(when (< 0 (shake-intensity camera))
(let ((frame-id (sxhash (+ (shake-unique camera) (mod (floor (* (shake-timer camera) 100)) 100)))))
(nv+ loc (vcartesian (vec (* (logand #xFF (1+ frame-id))
(setting :gameplay :screen-shake) (shake-intensity camera)
0.001)
(* (* 2 PI) (/ (logand #xFF frame-id) #xFF))))))
(clamp-camera-target camera loc)))
(let ((off (offset camera)))
(when (v/= 0 off)
(vsetf loc
(+ (vx (intended-location camera)) (vx off))
(+ (vy (intended-location camera)) (vy off)))
(unless (fix-offset camera)
(nv* off 0.98))
(when (<= (abs (vx off)) 0.1) (setf (vx off) 0.0))
(when (<= (abs (vy off)) 0.1) (setf (vy off) 0.0))
(clamp-camera-target camera loc)))))
(update-in-view-tester camera))
(defun snap-to-target (camera &optional (target (target camera)))
(setf (target camera) target)
(v<- (location camera) (location target))
(v<- (intended-location camera) (location target))
(clamp-camera-target camera (location camera)))
(defmethod (setf target) :after ((target located-entity) (camera camera))
(when (region +world+)
(setf (chunk camera) (find-chunk target))))
(defmethod handle :before ((ev resize) (camera camera))
;; Adjust max width based on aspect ratio to ensure ultrawides still get to see something.
(let ((aspect (float (/ (width ev) (max 1 (height ev))))))
(setf (vx (target-size camera))
(cond ((<= aspect 2.1)
(* (vx +tiles-in-view+) +tile-size+ .5))
((<= aspect 2.6)
(* (vx +tiles-in-view+) +tile-size+ .75))
(T
(* (vx +tiles-in-view+) +tile-size+)))))
;; Ensure we scale to fit width as much as possible without showing space
;; outside the chunk.
(let* ((optimal-scale (float (/ (width ev) (* 2 (vx (target-size camera))))))
(max-fit-scale (if (chunk camera)
(max (/ (height ev) (* 2 (- (vy (bsize (chunk camera))) 8)))
(/ (width ev) (* 2 (- (vx (bsize (chunk camera))) 8))))
optimal-scale))
(scale (max 0.0001 optimal-scale max-fit-scale)))
(setf (intended-view-scale camera) scale)
(setf (vx (target-size camera)) (/ (width ev) scale 2))
(setf (vy (target-size camera)) (/ (height ev) scale 2))))
(defmethod (setf chunk) :after (chunk (camera camera))
;; Optimal bounds might have changed, update.
(handle (make-instance 'resize :width (width *context*) :height (height *context*)) camera))
(defmethod handle ((ev switch-chunk) (camera camera))
(setf (chunk camera) (chunk ev)))
(defmethod handle ((ev switch-region) (camera camera))
(setf (target camera) (node 'player T)))
(defmethod handle ((ev window-shown) (camera camera))
(if (target camera)
(snap-to-target camera (target camera))
(vsetf (location camera) 0 0)))
(defmethod project-view ((camera camera))
(let* ((z (max 0.0001 (* (view-scale camera) (zoom camera))))
(v (nv- (v/ (target-size camera) (zoom camera)) (location camera))))
(reset-matrix *view-matrix*)
(scale-by z z z *view-matrix*)
(translate-by (vx v) (vy v) 100 *view-matrix*)))
(defun shake-camera (&key (duration 0.2) (intensity 3) (rumble-intensity 1.0))
(let ((camera (camera +world+)))
(setf (shake-unique camera) (random 100))
(setf (shake-timer camera) duration)
(setf (shake-intensity camera) intensity)
(setf (rumble-intensity camera) (* (setting :gameplay :rumble) rumble-intensity))
(when (= 0 duration)
(gamepad:call-with-devices (lambda (d) (gamepad:rumble d 0.0))))))
(defun rumble (&key (duration 0.3) (intensity 1.0))
(let ((camera (camera +world+)))
(setf (shake-timer camera) duration)
(setf (rumble-intensity camera) (* (setting :gameplay :rumble) intensity))
(when (= 0 duration)
(gamepad:call-with-devices (lambda (d) (gamepad:rumble d 0.0))))))
(defun duck-camera (x y)
(let ((off (offset (camera +world+))))
(vsetf off
(+ (vx off) (* 0.1 (- x (vx off))))
(+ (vy off) (* 0.1 (- y (vy off)))))))
(defmethod bsize ((camera camera))
(let* ((context (context +main+))
(zoom (the single-float (zoom camera)))
(vscale (the single-float (view-scale camera))))
(tvec (/ (the (unsigned-byte 32) (width context)) (* zoom 2 vscale))
(/ (the (unsigned-byte 32) (height context)) (* zoom 2 vscale)))))
(defun in-view-p (loc bsize)
(declare (optimize speed))
(declare (type vec2 loc bsize))
(let* ((test (in-view-tester (camera +world+)))
(lx (vx2 loc))
(ly (vy2 loc))
(sx (vx2 bsize))
(sy (vy2 bsize)))
(declare (type vec4 test))
(and (< (vx4 test) (+ lx sx))
(< (vy4 test) (+ ly sy))
(< (- lx sx) (vz4 test))
(< (- ly sy) (vw4 test)))))
(defun update-in-view-tester (camera)
(declare (optimize speed))
(let* ((context (context +main+))
(zoom (the single-float (zoom camera)))
(vscale (the single-float (view-scale camera)))
(siz (the vec2 (target-size camera)))
(cloc (the vec2 (location camera)))
(xoff (/ (vx2 siz) zoom))
(yoff (/ (vy2 siz) zoom)))
(vsetf (in-view-tester camera)
(- (vx cloc) xoff)
(- (vy cloc) yoff)
(- (+ (/ (the (unsigned-byte 32) (width context)) (* zoom vscale)) (vx cloc)) xoff)
(- (+ (/ (the (unsigned-byte 32) (height context)) (* zoom vscale)) (vy cloc)) yoff))))