path: root/scenes/game.scm

;;; The Inevitable Game
;;; Copyright © 2018, 2021 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This program 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.
;;;
;;; This program 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 this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (scenes game)
  #:use-module (chickadee)
  #:use-module (chickadee audio)
  #:use-module (chickadee data grid)
  #:use-module (chickadee math)
  #:use-module (chickadee math easings)
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module ((chickadee graphics color) #:select (make-color))
  #:use-module (chickadee graphics text)
  #:use-module (chickadee graphics path)
  #:use-module (chickadee graphics sprite)
  #:use-module (chickadee graphics texture)
  #:use-module (chickadee graphics tile-map)
  #:use-module (chickadee scripting)
  #:use-module (config)
  #:use-module (engine assets)
  #:use-module (characters lorenzo)
  #:use-module (characters reaper)
  #:use-module (utils)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (scene))

(define-asset game-map
  (load-tile-map "assets/maps/01.tmx"))
(define-asset vignette-image
  (load-image "assets/images/vignette.png"))
(define-asset fade-image
  (load-image "assets/images/fade.png"))
(define-asset game-font
  (load-bitmap-font "assets/fonts/good_neighbors_starling.xml"))
(define-asset music
  (load-audio "assets/sounds/birds.ogg" #:mode 'stream))

(define location
  (let ((positions
         (object-layer-objects
          (tile-map-layer-ref (asset-ref game-map) "positions")))
        (offset (vec2 0 0)))
    (lambda (name)
      "Look up the location for an object with the given NAME in the
map's positions layer."
      (or (and=> (find (lambda (obj)
                         (equal? (map-object-name obj) name))
                       positions)
                 (lambda (obj)
                   (let ((shape (map-object-shape obj)))
                     (vec2 (- (+ (vec2-x offset) (rect-x shape))
                              (/ (rect-width shape) 2))
                           (- (+ (vec2-y offset) (rect-y shape))
                              (/ (rect-height shape) 2))))))
          (vec2 0.0 0.0)))))

(define fade-box-fill (make-color 0 0 0 1.0))

(define agenda (make-agenda))
(define last-player-position
  (location "player"))
(define *player-previous-keys* (list))
(define *player* #false)
(define *reaper* #false)
(define *layers* #false)
(define grid (make-grid 16))
(define player-grid-x-offset 8)
(define player-grid-y-offset 0)

(define *background-music* #false)


(define (load-scene)
  (set! *background-music*
        (make-source #:audio (asset-ref music)
                     #:loop? #true))
  (source-play *background-music*)

  (set! *player* (lorenzo #:start-position
                          (location "player")))
  (update-animated-sprite *player*)
  (grid-add grid 'player
            (+ (vec2-x (position *player*)) player-grid-x-offset)
            (+ (vec2-y (position *player*)) player-grid-y-offset)
            16 16)
  (set! (walk-speed *player*) 1.5)

  (set! *reaper* (reaper #:start-position
                         (location "reaper")))
  (update-animated-sprite *reaper*)

  ;; XXX: Chickadee parses the object layer incorrectly, so all
  ;; objects are flipped vertically.  We use this to compute the
  ;; corrected shapes of layer objects only once.
  (set! *layers*
        (map (lambda (layer-name)
               (cons layer-name
                     (map (lambda (obj)
                            (let ((r-wrong (map-object-shape obj)))
                              (cons obj
                                    (make-rect (rect-x r-wrong)
                                               (- (rect-y r-wrong) (rect-height r-wrong))
                                               (rect-width r-wrong)
                                               (rect-height r-wrong)))))
                          (object-layer-objects
                           (tile-map-layer-ref (asset-ref game-map) layer-name)))))
             '("food" "positions" "actions" "collision")))

  (for-each (lambda (barrier)
              (let ((r (cdr barrier)))
                (grid-add grid (map-object-id (car barrier))
                          (rect-x r)
                          (rect-y r)
                          (rect-width r)
                          (rect-height r))))
            (assoc-ref *layers* "collision"))

  (with-agenda
   agenda
   (spawn-script
    (lambda ()
      (wait-until (any key-pressed? '(escape)))

      ;; Fade out
      (tween 2 0.0 1.0
             (lambda (alpha)
               (set! fade-box-fill
                     (make-color 0 0 0 alpha))))
      (throw 'switch-scene
             (@ (scenes death) scene))))
   (spawn-script
    (lambda ()
      (forever
       (sleep 1)
       ;; Stop any motion in a direction when the matching key has just
       ;; been released.
       (let ((released (filter key-released? *player-previous-keys*)))
         (unless (null? released)
           (walk *player* released 'stop)))

       ;; Detect newly pressed keys.
       (let ((active (filter key-pressed? '(left right up down))))
         (walk *player* (match active
                          (() '(idle))
                          (_ active)))
         (set! *player-previous-keys* active))

       ;; Update player position and respond to position-dependent
       ;; events.
       (let ((vel (velocity *player*)))
         (vec2-copy! world-position last-world-position)
         (vec2-add! world-position vel)

         ;; TODO
         ;; ;; Reset when the new position is invalid.
         ;; (when (collides? player game "collision")
         ;;   (vec2-sub! pos vel))
         ;; (and=> (collides? player game (items game))
         ;;        ;; TODO: do something to the item
         ;;        (match-lambda
         ;;          (() #f)
         ;;          (items (pk items))))
         ))))

   ;; Handle background noise fade in
   (spawn-script
    (lambda ()
      (tween 2 0.0 1.0
             (lambda (a)
               (set-source-volume! *background-music* a))
             #:ease ease-out-sine)))

   ;; Fade in
   (script
    (tween 1 1.0 0.0
           (lambda (alpha)
             (set! fade-box-fill
                   (make-color 0 0 0 alpha))))))
  (current-agenda agenda))

(define (draw-scene alpha)
  (define player-render-position
    (vec2 (round (lerp (vec2-x last-player-position)
                       (vec2-x (position *player*))
                       alpha))
          (round (lerp (vec2-y last-player-position)
                       (vec2-y (position *player*))
                       alpha))))

  ;; Always centered on the player
  (define camera
    (let ((player-half 16))
      (vec2- (position *player*)
             (vec2 (- (/ %width 2) player-half)
                   (- (/ %height 2) player-half)))))

  ;; The Void
  (draw-sprite
   (asset-ref fade-image)
   (vec2 0 0)
   #:tint (make-color 0.125 0.09 0.161 1.0))

  ;; The lower layers of the world
  (draw-tile-map (asset-ref game-map)
                 #:position (vec2 0 0)
                 #:camera camera
                 #:layers (list 0 1 2))

  ;; Reaper
  (draw-animated-sprite *reaper*
                        (vec2* camera -1.0))

  ;; Player
  (draw-animated-sprite *player*
                        (vec2* camera -1.0))

  ;; The upper layer hiding items and the player.
  (draw-tile-map (asset-ref game-map)
                 #:position (vec2 0 0)
                 #:camera camera
                 #:layers (list 3))

  ;; Vignette
  (draw-sprite (asset-ref vignette-image) (vec2 0 0))

  ;; Box for fading in/out everything
  (draw-sprite
   (asset-ref fade-image)
   (vec2 0 0)
   #:tint fade-box-fill))

(define (update-scene dt)
  (update-agenda dt)
  (update-animated-sprite *player*)
  (update-animated-sprite *reaper*))


(define scene
  (list
   #:name "game"
   #:load load-scene
   #:draw draw-scene
   #:update update-scene
   #:quit
   (lambda ()
     (and *background-music*
          (source-stop *background-music*)))))