;;; Catbird Game Engine
;;; Copyright © 2022 David Thompson <davet@gnu.org>
;;;
;;; Catbird is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Catbird is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Catbird.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Rectangular sub-regions of the game window to which a scene can be
;; rendered.
;;
;;; Code:
(define-module (catbird region)
  #:use-module (catbird camera)
  #:use-module (catbird config)
  #:use-module (catbird mixins)
  #:use-module (catbird node)
  #:use-module (catbird pushdown)
  #: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-state #:accessor scene-state #:init-thunk make-pushdown-state)
  (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 (width (region <region>))
  (area-width region))

(define-method (area-height (region <region>))
  (rect-height (area region)))

(define-method (height (region <region>))
  (area-height 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 (scene (region <region>))
  (state-current (scene-state region)))

(define-method (replace-scene (region <region>) (new-scene <scene>))
  (let ((old-scene (scene region)))
    (when old-scene (on-exit old-scene))
    (state-push! (scene-state region) new-scene)
    (set! (regions new-scene) (cons region (regions new-scene)))
    (on-enter new-scene)))

(define-method (push-scene (region <region>) (new-scene <scene>))
  (let ((old-scene (scene region)))
    (when old-scene
      (on-exit old-scene))
    (state-push! (scene-state region))
    (set! (regions new-scene) (cons region (regions new-scene)))
    (on-enter new-scene)))

(define-method (pop-scene (region <region>))
  (let ((old-scene (state-pop! (scene-state region))))
    (on-exit old-scene)
    (set! (regions old-scene)
          (delq region (regions old-scene))))
  (let ((restored-scene (scene region)))
    (when restored-scene
      (on-enter restored-scene))))

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