;;; 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 'init))

(define-method (game-over? (lisparuga <lisparuga>))
  (game-over? (& lisparuga game)))

(define-method (complete? (lisparuga <lisparuga>))
  (complete? (& lisparuga game)))

(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))))))
  (attach-to lisparuga
             (make <sprite>
               #:name 'background
               #:rank 0
               #:texture background)
             (make <game>
               #:name 'game
               #:rank 1
               #:position (vec2 80.0 0.0))))

(define-method (on-enter (lisparuga <lisparuga>))
  (new-game-transition lisparuga))

(define-method (new-game-transition lisparuga)
  (set! (state lisparuga) 'play)
  (let ((game-over (& lisparuga game-over)))
    (and game-over (detach game-over)))
  (reset (& lisparuga game))
  (set! (state lisparuga) 'play)
  (start-stage (& lisparuga game)))

(define-method (game-over-transition (lisparuga <lisparuga>))
  (stop-stage (& lisparuga game))
  (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 120.0)
                 #:align 'center
                 #:vertical-align 'center)
               (make <label>
                 #:name 'instructions
                 #:text "press ENTER to play again"
                 #:position (vec2 160.0 90.0)
                 #:align 'center))
    (attach-to lisparuga game-over)))

(define-method (win-transition (lisparuga <lisparuga>))
  (set! (state lisparuga) 'win))

(define-method (pause-transition (lisparuga <lisparuga>))
  (set! (state lisparuga) 'pause)
  (pause (& lisparuga game))
  (let ((container (make <node-2d>
                     #:name 'pause
                     #:rank 999)))
    (attach-to container
               (make <filled-rect>
                 #:region (make-rect 80.0 0.0 160.0 240.0)
                 #:color (make-color 0.0 0.0 0.0 0.4))
               (make <label>
                 #:name 'pause
                 #:rank 1
                 #:text "PAUSE"
                 #:position (vec2 160.0 120.0)
                 #:align 'center
                 #:vertical-align 'center))
    (attach-to lisparuga container)))

(define-method (resume-transition (lisparuga <lisparuga>))
  (set! (state lisparuga) 'play)
  (detach (& lisparuga pause))
  (resume (& lisparuga game))
  (if (key-pressed? 'z)
      (start-player-shooting (& lisparuga game))
      (stop-player-shooting (& lisparuga game))))

(define-method (update (lisparuga <lisparuga>) dt)
  (match (state lisparuga)
    ('play
     (cond
      ((game-over? lisparuga)
       (game-over-transition lisparuga))
      ((complete? lisparuga)
       (win-transition lisparuga))
      (else
       (steer-player (& lisparuga 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
     (match key
       ('z (start-player-shooting (& lisparuga game)))
       ('x (unless repeat?
             (toggle-player-polarity (& lisparuga game))))
       ('c (unless repeat?
             (fire-player-homing-missiles (& lisparuga game))))
       ('return (pause-transition lisparuga))
       (_ #t)))
    ('pause
     (match key
       ('return (resume-transition lisparuga))
       (_ #t)))
    ((or 'win '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 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>))))