diff options
Diffstat (limited to 'catbird/region.scm')
-rw-r--r-- | catbird/region.scm | 102 |
1 files changed, 102 insertions, 0 deletions
diff --git a/catbird/region.scm b/catbird/region.scm new file mode 100644 index 0000000..4ae4bc9 --- /dev/null +++ b/catbird/region.scm @@ -0,0 +1,102 @@ +(define-module (catbird region) + #:use-module (catbird camera) + #:use-module (catbird config) + #:use-module (catbird mixins) + #:use-module (catbird node) + #:use-module (catbird scene) + #:use-module (chickadee) + #:use-module (chickadee data array-list) + #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics viewport) + #:use-module (chickadee math rect) + #:use-module (ice-9 exceptions) + #:use-module (oop goops) + #:export (<region> + make-region + area + area-x + area-y + area-width + area-height + camera + scene + replace-scene + push-scene + pop-scene) + #:re-export (name + rank + render + update)) + +(define-root-class <region> (<renderable> <updatable> <nameable> <rankable>) + (area #:accessor area #:init-keyword #:area) + (camera #:accessor camera #:init-keyword #:camera #:init-value #f) + (scene #:accessor scene #:init-keyword #:scene #:init-value #f) + (scene-stack #:getter scene-stack #:init-thunk make-array-list) + (viewport #:accessor viewport)) + +(define-method (area-x (region <region>)) + (rect-x (area region))) + +(define-method (area-y (region <region>)) + (rect-y (area region))) + +(define-method (area-width (region <region>)) + (rect-width (area region))) + +(define-method (area-height (region <region>)) + (rect-height (area region))) + +(define (float->int x) + (inexact->exact (round x))) + +(define-method (initialize (region <region>) args) + (next-method) + (let ((r (area region))) + (set! (viewport region) + (make-viewport (float->int (rect-x r)) + (float->int (rect-y r)) + (float->int (rect-width r)) + (float->int (rect-height r)))))) + +(define (make-region area name rank) + (let* ((window (current-window)) + (w (window-width window)) + (h (window-height window))) + (when (or (< (rect-left area) 0.0) + (< (rect-bottom area) 0.0) + (> (rect-right area) w) + (> (rect-top area) h)) + (raise-exception + (make-exception-with-message "region area exceeds window area"))) + (make <region> #:area area #:name name #:rank rank))) + +(define-method (replace-scene (r <region>) (new-scene <scene>)) + (let ((old-scene (scene r))) + (when old-scene (on-exit old-scene)) + (set! (scene r) new-scene) + (set! (regions new-scene) (cons r (regions new-scene))) + (on-enter new-scene))) + +(define-method (push-scene (region <region>) (new-scene <scene>)) + (let ((old-scene (scene region))) + (when old-scene + (array-list-push! (scene-stack region) old-scene)) + (replace-scene region new-scene))) + +(define-method (pop-scene (region <region>)) + (let ((stack (scene-stack region))) + (unless (array-list-empty? stack) + (replace-scene (array-list-pop! stack))))) + +(define-method (update (region <region>) dt) + (let ((s (scene region))) + (when s (update/around s dt)))) + +(define-method (render (region <region>) alpha) + (let ((s (scene region)) + (c (camera region))) + (when (and s c) + (parameterize ((current-camera c)) + (with-projection (projection-matrix (camera region)) + (render/around s alpha)))))) |