;;; Lisparuga
;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
;;;
;;; Lisparuga 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.
;;;
;;; Lisparuga 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 Lisparuga.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Main scene.
;;
;;; Code:

(define-module (lisparuga)
  #:use-module ((chickadee) #:select (key-pressed?))
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module (chickadee render color)
  #:use-module (chickadee render texture)
  #:use-module (ice-9 match)
  #:use-module (lisparuga asset)
  #:use-module (lisparuga config)
  #:use-module (lisparuga game)
  #:use-module (lisparuga kernel)
  #:use-module (lisparuga node)
  #:use-module (lisparuga node-2d)
  #:use-module (lisparuga player)
  #:use-module (lisparuga scene)
  #:use-module (oop goops)
  #:export (launch-lisparuga))

(define %framebuffer-width 320)
(define %framebuffer-height 240)

(define-asset background (load-image (scope-asset "images/background.png")))

(define-class <lisparuga> (<scene-2d>)
  (state #:accessor state #:init-value 'play))

(define (game-over? lisparuga)
  (zero? (lives (& lisparuga actor-canvas game player))))

(define-method (on-boot (lisparuga <lisparuga>))
  ;; Scale a small framebuffer up to the window size.
  (set! (views lisparuga)
    (list (make <view-2d>
            #:camera (make <camera-2d>
                       #:width %framebuffer-width
                       #:height %framebuffer-height)
            #:area (let ((wc (window-config (current-kernel))))
                     (make-rect 0 0 (window-width wc) (window-height wc))))))
  ;; This 160x240 canvas is where the actual game actors will get
  ;; rendered.
  (let ((actor-canvas (make <canvas>
                        #:name 'actor-canvas
                        #:rank 1
                        #:views (list (make <view-2d>
                                        #:camera (make <camera-2d>
                                                   #:width 160
                                                   #:height 240)
                                        #:area (make-rect 80 0 160 240)
                                        #:clear-color (make-color 0.0 0.0 0.0 1.0))))))
    (attach-to lisparuga
               (make <sprite>
                 #:name 'background
                 #:rank 0
                 #:texture background)
               actor-canvas)
    (new-game-transition lisparuga)))

(define (new-game-transition lisparuga)
  (set! (state lisparuga) 'play)
  (let ((game-over (& lisparuga game-over)))
    (and game-over (detach game-over)))
  (let ((old-game (& lisparuga actor-canvas game)))
    (and old-game (detach old-game)))
  (attach-to (& lisparuga actor-canvas) (make <game> #:name 'game)))

(define (game-over-transition lisparuga)
  (set! (state lisparuga) 'game-over)
  (let ((game-over (make <node-2d>
                     #:name 'game-over
                     #:rank 999)))
    (attach-to game-over
               (make <label>
                 #:name 'game-over
                 #:text "GAME OVER"
                 #:position (vec2 (- 160.0 (/ (* 9.0 8.0) 2.0))
                                  116.0)
                 #:rank 999))
    (attach-to lisparuga game-over)))

(define-method (update (lisparuga <lisparuga>) dt)
  (match (state lisparuga)
    ('play
     (if (game-over? lisparuga)
         (game-over-transition lisparuga)
         (steer-player (& lisparuga actor-canvas game)
                       (key-pressed? 'up)
                       (key-pressed? 'down)
                       (key-pressed? 'left)
                       (key-pressed? 'right))))
    (_ #f)))

(define-method (on-key-press (lisparuga <lisparuga>) key scancode modifiers repeat?)
  (match (state lisparuga)
    ('play
     (unless repeat?
       (match key
         ('z (start-player-shooting (& lisparuga actor-canvas game)))
         ('x (toggle-player-polarity (& lisparuga actor-canvas game)))
         ('c (fire-player-homing-missiles (& lisparuga actor-canvas game)))
         (_ #t))))
    ('game-over
     (match key
       ('return (new-game-transition lisparuga))
       (_ #f)))
    (_ #f)))

(define-method (on-key-release (lisparuga <lisparuga>) key scancode modifiers)
  (match (state lisparuga)
    ('play
     (match key
       ('z (stop-player-shooting (& lisparuga actor-canvas game)))
       (_ #t)))
    (_ #f)))

(define* (launch-lisparuga #:key (window-width 640) (window-height 480))
  (boot-kernel (make <kernel>
                 #:window-config (make <window-config>
                                   #:title "Lisparuga"
                                   #:width window-width
                                   #:height window-height))
               (lambda () (make <lisparuga>))))