;;; 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>
            <full-region>
            area
            area-x
            area-y
            area-width
            area-height
            camera
            refresh-camera
            set-camera
            freeze
            frozen?
            move
            scene
            replace-scene
            push-scene
            pop-scene
            unfreeze
            on-window-resize)
  #:re-export (name
               rank
               render
               update))

(define-root-class <region> (<renderable> <updatable> <nameable> <rankable>)
  (area #:getter 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)
  ;; 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)
  (refresh-framebuffer region)
  (refresh-camera region))

(define-method (set-camera (region <region>) new-camera)
  (set! (camera region) new-camera)
  (refresh-camera region))

(define-method (refresh-camera (region <region>))
  (let ((c (camera region)))
    (when c (resize c (width region) (height region)))))

(define-method (refresh-framebuffer (region <region>))
  (let ((r (area region)))
    (set! (framebuffer region)
          (make-framebuffer (float->int (rect-width r))
                            (float->int (rect-height r))))))

(define-method (resize (region <region>) width height)
  (let ((r (area region))
        (c (camera region))
        (s (scene region)))
    (set-rect-width! r width)
    (set-rect-height! r height)
    (refresh-framebuffer region)
    (refresh-camera region)
    (when s (on-region-resize s))))

(define-method (move (region <region>) x y)
  (let ((r (area region)))
    (set-rect-x! r x)
    (set-rect-y! r y )))

(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)
                      (area region)
                      %identity-matrix)))))

(define-method (on-window-resize (region <region>) width height)
  #t)


;;;
;;; Full region
;;;

(define (current-window-area)
  (let ((window (current-window)))
    (make-rect 0.0 0.0 (window-width window) (window-height window))))

(define-class <full-region> (<region>)
  (area #:getter area #:init-thunk current-window-area))

(define-method (on-window-resize (region <full-region>) width height)
  (resize region width height))