diff options
author | David Thompson <dthompson2@worcester.edu> | 2022-10-03 19:22:23 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2022-10-22 11:48:39 -0400 |
commit | 14464dee966fe415d4c8e1fb8b5205653b22003f (patch) | |
tree | 986a7b03a089a4545465901cadce4d671f3032c1 /catbird/camera.scm | |
parent | dcf869ccd7ec9d33c937507fe96e9e09f517bded (diff) |
Add prototype catbird modules.
Diffstat (limited to 'catbird/camera.scm')
-rw-r--r-- | catbird/camera.scm | 113 |
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)) |