;;; Copyright 2023 David Thompson
;;;
;;; 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.

(define-module (super-bloom main)
  #:use-module (catbird)
  #:use-module (catbird camera)
  #:use-module (catbird kernel)
  #:use-module (catbird mixins)
  #:use-module (catbird region)
  #:use-module (catbird scene)
  #:use-module (chickadee)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee math rect)
  #:use-module (oop goops)
  #:use-module (super-bloom common)
  #:use-module (super-bloom game)
  #:export (launch-game))

(define-class <upscaled-centered-region> (<region>)
  (area #:getter area #:init-form (make-rect 0.0 0.0 1.0 1.0))
  (unscaled-width #:getter unscaled-width #:init-keyword #:unscaled-width)
  (unscaled-height #:getter unscaled-height #:init-keyword #:unscaled-height))

(define-method (initialize (region <upscaled-centered-region>) initargs)
  (next-method)
  (refresh-area region
                (window-width (current-window))
                (window-height (current-window))))

(define-method (on-window-resize (region <upscaled-centered-region>) width height)
  (refresh-area region width height))

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

(define-method (refresh-area (region <upscaled-centered-region>) width height)
  (let* ((w (unscaled-width region))
         (h (unscaled-height region))
         (scale (max (min (truncate-quotient width w)
                          (truncate-quotient height h))
                     1))
         (new-w (* w scale))
         (new-h (* h scale)))
    (move region
          (truncate-quotient (- width new-w) 2)
          (truncate-quotient (- height new-h) 2))
    (resize region new-w new-h)))

(define* (create-upscaled-centered-region width height #:key (rank 0) (name #f))
  (let ((region (make <upscaled-centered-region>
                  #:name name
                  #:rank rank
                  #:unscaled-width width
                  #:unscaled-height height)))
    (add-region (current-kernel) region)
    region))

(define-class <game-scene> (<scene>))

(define-method (width (scene <game-scene>))
  %game-width:float)

(define-method (height (scene <game-scene>))
  %game-height:float)

(define (init)
  (let ((region (create-upscaled-centered-region %game-width %game-height #:name 'main))
        (scene (make <game-scene> #:name 'super-bloom))
        (camera (make <camera-2d> #:width %game-width #:height %game-height)))
    (replace-scene region scene)
    (set-camera region camera)
    (replace-major-mode scene (make <super-bloom-mode>))))

(define (launch-game)
  (run-catbird init
               #:title "SUPER BLOOM (Spring Lisp Game Jam 2023)"
               #:clear-color black
               #:width %default-width
               #:height %default-height))