;;; Catbird Game Engine
;;; Copyright © 2022 David Thompson <davet@gnu.org>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; 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 framebuffer)
  #:use-module (chickadee graphics sprite)
  #:use-module (chickadee math matrix)
  #: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
            freeze
            frozen?
            scene
            replace-scene
            push-scene
            pop-scene
            unfreeze)
  #: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)
  (framebuffer #:accessor framebuffer)
  (framebuffer-rect #:accessor framebuffer-rect)
  ;; Regions can be frozen for debugging purposes, so that the scene
  ;; they contain isn't updated or rendered.
  (frozen? #:accessor frozen? #:init-value #f))

(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! (framebuffer region)
          (make-framebuffer (float->int (rect-width r))
                            (float->int (rect-height r))))
    (set! (framebuffer-rect region)
          (make-rect 0.0 0.0
                     (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 (freeze (region <region>))
  (set! (frozen? region) #t))

(define-method (unfreeze (region <region>))
  (set! (frozen? region) #f))

(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 (and s (not (frozen? region)))
      (update/around s dt))))

(define %identity-matrix (make-identity-matrix4))
(define-method (render (region <region>) alpha)
  (let ((s (scene region))
        (c (camera region))
        (fb (framebuffer region)))
    (when (and s c)
      (parameterize ((current-camera c))
        ;; Don't render to the framebuffer if region is frozen.  Just
        ;; draw the frozen frame instead.
        (unless (frozen? region)
          (with-framebuffer fb
            (with-projection (projection-matrix (camera region))
              (render/around s alpha))))
        (draw-sprite* (framebuffer-texture fb)
                      (framebuffer-rect region)
                      %identity-matrix)))))