(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))))))