summaryrefslogtreecommitdiff
path: root/catbird/camera.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2022-10-03 19:22:23 -0400
committerDavid Thompson <dthompson2@worcester.edu>2022-10-22 11:48:39 -0400
commit14464dee966fe415d4c8e1fb8b5205653b22003f (patch)
tree986a7b03a089a4545465901cadce4d671f3032c1 /catbird/camera.scm
parentdcf869ccd7ec9d33c937507fe96e9e09f517bded (diff)
Add prototype catbird modules.
Diffstat (limited to 'catbird/camera.scm')
-rw-r--r--catbird/camera.scm113
1 files changed, 113 insertions, 0 deletions
diff --git a/catbird/camera.scm b/catbird/camera.scm
new file mode 100644
index 0000000..ad7425c
--- /dev/null
+++ b/catbird/camera.scm
@@ -0,0 +1,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))