blob: ad7425c5525590d26df6c72b6d55f0d60d0c330a (
plain)
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
|
(define-module (catbird camera)
#:use-module (catbird config)
#:use-module (catbird mixins)
#:use-module (chickadee math)
#:use-module (chickadee math matrix)
#:use-module (chickadee math rect)
#:use-module (chickadee math vector)
#:use-module (oop goops)
#:export (<camera>
projection-matrix
view-matrix
width
height
current-camera
<camera-2d>
view-bounding-box
move-to
move-by
<camera-3d>
field-of-vision
near-clip
far-clip
direction
up))
(define-root-class <camera> ()
(width #:accessor width #:init-keyword #:width)
(height #:accessor height #:init-keyword #:height)
(projection-matrix #:getter projection-matrix #:init-thunk make-identity-matrix4)
(view-matrix #:getter view-matrix #:init-thunk make-identity-matrix4))
(define-generic refresh-projection)
(define-generic refresh-view)
(define-method (initialize (camera <camera>) args)
(next-method)
(refresh-projection camera)
(refresh-view camera))
(define current-camera (make-parameter #f))
;;;
;;; 2D Camera
;;;
(define-class <camera-2d> (<camera> <movable-2d>)
(view-bounding-box #:accessor view-bounding-box #:init-thunk make-null-rect))
(define-method (initialize (camera <camera-2d>) initargs)
(next-method)
(let ((bb (view-bounding-box camera)))
(set-rect-width! bb (width camera))
(set-rect-height! bb (height camera))))
(define-method (refresh-projection (camera <camera-2d>))
(orthographic-projection! (projection-matrix camera)
0.0 (width camera)
(height camera) 0.0
0.0 1.0))
(define-method (refresh-view (camera <camera-2d>))
(let ((p (position camera))
(bb (view-bounding-box camera)))
(matrix4-translate! (view-matrix camera) p)
(set-rect-x! bb (vec2-x p))
(set-rect-y! bb (vec2-y p))))
(define-method (move-to (camera <camera-2d>) p)
(vec2-copy! p (position camera))
(refresh-view camera))
(define-method (move-by (camera <camera-2d>) d)
(vec2-add! (position camera) d)
(refresh-view camera))
;;;
;;; 3D Camera
;;;
(define-class <camera-3d> (<camera> <movable-3d>)
(field-of-vision #:getter field-of-vision #:init-keyword #:field-of-vision
#:init-value (degrees->radians 60))
(near-clip #:getter near-clip #:init-keyword #:near-clip #:init-value 0.1)
(far-clip #:getter far-clip #:init-keyword #:far-clip #:init-value 5.0)
(direction #:getter direction #:init-keyword #:direction
#:init-form (vec3 0.0 0.0 -1.0))
(up #:getter up #:init-keyword #:up
#:init-form (vec3 0.0 1.0 0.0)))
(define-method (refresh-projection (camera <camera-3d>))
(perspective-projection! (projection-matrix camera)
(field-of-vision camera)
(/ (width camera) (height camera))
(near-clip camera)
(far-clip camera)))
(define-method (refresh-view (camera <camera-3d>))
(look-at! (view-matrix camera)
(position camera)
(direction camera)
(up camera)))
(define-method (move-to (camera <camera-3d>) p)
(vec3-copy! p (position camera))
(refresh-view camera))
(define-method (move-by (camera <camera-3d>) d)
(vec3-add! (position camera) d)
(refresh-view camera))
|
