path: root/bonnie-bee/game.scm

(define-module (bonnie-bee game)
  #:use-module (bonnie-bee actor)
  #:use-module (bonnie-bee assets)
  #:use-module (bonnie-bee background)
  #:use-module (bonnie-bee boss)
  #:use-module (bonnie-bee bullet)
  #:use-module (bonnie-bee common)
  #:use-module (bonnie-bee flower)
  #:use-module (bonnie-bee moth)
  #:use-module (bonnie-bee player)
  #:use-module (bonnie-bee popcorn)
  #:use-module (bonnie-bee turret)
  #:use-module (chickadee)
  #:use-module (chickadee audio)
  #:use-module (chickadee data quadtree)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics particles)
  #:use-module (chickadee math)
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module (chickadee scripting)
  #:use-module (oop goops)
  #:use-module (starling asset)
  #:use-module (starling kernel)
  #:use-module (starling node)
  #:use-module (starling node-2d)
  #:use-module (starling scene)
  #:export (<game>))

(define %text-color (rgb #xfee761))

(define-class <shadow-label> (<label>))

(define-method (on-boot (label <shadow-label>))
  (next-method)
  (attach-to label
             (make <label>
               #:name 'shadow
               #:position (vec2 0.0 1.0)
               #:font (font label)
               #:text (text label)
               #:color (color label)))
  (set! (color label) black))

(define-method (on-change (label <shadow-label>) slot-name old new)
  (next-method)
  (case slot-name
    ((text)
     (set! (text (& label shadow)) new)))  )

(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height))

(define-class <game> (<scene-2d>)
  (state #:accessor state #:init-value 'play)
  (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds))
  (scroll-speed #:getter scroll-speed #:init-value 0.0)
  (last-lives #:accessor last-lives #:init-value 0)
  (last-pollen #:accessor last-pollen #:init-value 0)
  (last-score #:accessor last-score #:init-value 0)
  (music-source #:getter music-source #:init-form (make-source #:loop? #t)))

(define-method (change-scroll-speed (game <game>) speed)
  (slot-set! game 'scroll-speed speed))

(define-method (spawn (game <game>) (actor <actor>))
  (set! (quadtree actor) (quadtree game))
  (quadtree-insert! (quadtree game) (world-hitbox actor) actor)
  (attach-to game actor))

(define-method (player (game <game>))
  (& game player))

(define-method (bullets (game <game>))
  (& game bullets))

(define-method (particles (game <game>))
  (& game particles))

(define-method (on-boot (game <game>))
  (set! *random-state* (random-state-from-platform))
  (set-cameras! game)
  (attach-to game
             (make <background>
               #:name 'background
               #:texture background-image)
             (make <particles>
               #:name 'particles
               #:particles (make-particles 2048
                                           #:texture (asset-ref particle-image)
                                           #:end-color (make-color 1.0 1.0 1.0 0.0)))
             (make <bullets>
               #:name 'bullets
               #:rank 4
               #:quadtree (quadtree game))
             (make <shadow-label>
               #:name 'hud-lives
               #:rank 5
               #:position (vec2 2.0 2.0)
               #:font monogram-font
               #:text "lives 0"
               #:color %text-color)
             (make <shadow-label>
               #:name 'hud-pollen
               #:rank 5
               #:position (vec2 (/ %game-width 2.0) 2.0)
               #:font monogram-font
               #:text "pollen 0"
               #:align 'center
               #:color %text-color)
             (make <shadow-label>
               #:name 'hud-score
               #:rank 5
               #:position (vec2 (- %game-width 2.0) 2.0)
               #:font monogram-font
               #:text "score 0"
               #:align 'right
               #:color %text-color)))

(define-method (play-music (game <game>) music-asset)
  (set-source-audio! (music-source game) (asset-ref music-asset))
  (source-play (music-source game)))

(define* (make-turret p #:key (interval 0.5) (speed 1.0))
  (let ((turret (make <turret>
                  #:rank 1
                  #:position p
                  #:hitbox (make-rect -32.0 -32.0 64.0 64.0)
                  #:health 24
                  #:points 500)))
    (run-script turret
      (sleep (steps 1))
      (forever
       (let ((theta (+ (angle-to turret (player (parent turret)))
                       (* (- (* (random:uniform) 2.0) 1.0) 0.2)))
             (speed 1.5))
         (audio-play (asset-ref enemy-shoot-sound))
         (add-bullet (bullets (parent turret))
                     medium-enemy-bullet
                     (position turret)
                     (vec2 (* (cos theta) speed)
                           (* (sin theta) speed))))
       (sleep interval)))
    turret))

(define (make-flower p)
  (make <flower>
    #:rank 1
    #:position p
    #:hitbox (make-rect -32.0 -32.0 64.0 64.0)
    #:health 24
    #:points 100))

(define* (make-popcorn p #:optional (v (vec2 0.0 0.0)))
  (make <popcorn>
    #:rank 2
    #:position p
    #:velocity v
    #:hitbox (make-rect -16.0 -16.0 32.0 32.0)
    #:health 1
    #:points 10))

(define (make-moth p)
  (make <moth>
    #:rank 2
    #:position p
    #:velocity (vec2 0.0 -2.0)
    #:hitbox (make-rect -28.0 -19.0 56.0 38.0)
    #:health 20
    #:points 1000))

(define-method (change-state (game <game>) new-state)
  (set! (state game) new-state))

(define-method (run-level (game <game>))
  (define (tutorial message key)
    (let ((l (make <shadow-label>
               #:name 'tutorial
               #:rank 5
               #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
               #:font monogram-font
               #:text message
               #:align 'center
               #:color %text-color)))
      (attach-to game l)
      (if key
          (wait-until (key-pressed? key))
          (sleep 2.0))
      (detach l)))
  (run-script game
    (fade-in game 1.0))
  (run-script game
    (unless (getenv "SKIP_INTRO")
      ;; Intro
      (let ((popcorn (make-popcorn (vec2 (/ %game-width 2.0) (+ %game-height 16.0))))
            (bullet-speed 5.0)
            (flower-1 (make-flower (vec2 194.0 210.0)))
            (flower-2 (make-flower (vec2 50.0 206.0)))
            (flower-3 (make-flower (vec2 280.0 201.0)))
            (flower-4 (make-flower (vec2 121.0 197.0)))
            (flower-5 (make-flower (vec2 58.0 134.0)))
            (flower-6 (make-flower (vec2 145.0 135.0)))
            (flower-7 (make-flower (vec2 220.0 151.0)))
            (flower-8 (make-flower (vec2 290.0 129.0))))
        (define (shoot-at flower)
          (add-bullet (bullets game)
                      medium-enemy-bullet
                      (position popcorn)
                      (vec2* (direction-to popcorn flower) bullet-speed)))
        (change-state game 'intro)
        (spawn game flower-1)
        (spawn game flower-2)
        (spawn game flower-3)
        (spawn game flower-4)
        (spawn game flower-5)
        (spawn game flower-6)
        (spawn game flower-7)
        (spawn game flower-8)
        (spawn game (make-flower (vec2 194.0 95.0)))
        (spawn game (make-flower (vec2 102.0 82.0)))
        (spawn game (make-flower (vec2 247.0 45.0)))
        (spawn game (make-flower (vec2 159.0 40.0)))
        (spawn game (make-flower (vec2 73.0 28.0)))
        (teleport (player game) 159.0 40.0)
        (play-music game intro-music)
        (sleep 1.0)
        (audio-play (asset-ref pollen-release-sound))
        (sleep 0.6)
        (move-to (player game) 247.0 45.0 1.0)
        (sleep 0.2)
        (audio-play (asset-ref pollen-release-sound))
        (sleep 0.6)
        (move-to (player game) 102.0 76.0 1.0)
        (sleep 0.2)
        (audio-play (asset-ref pollen-release-sound))
        (sleep 2.0)
        (run-script game
          (tween 1.0 1.0 0.0
                 (lambda (volume)
                   (set-source-volume! (music-source game) volume))))
        (source-stop (music-source game))
        (spawn game popcorn)
        (change-velocity popcorn 0.0 -1.0)
        (tween 2.4 -1.0 0.0
               (lambda (dy)
                 (change-velocity popcorn 0.0 dy)))
        (shoot-at flower-1)
        (sleep 0.3)
        (shoot-at flower-2)
        (sleep 0.3)
        (shoot-at flower-3)
        (sleep 0.3)
        (shoot-at flower-4)
        (sleep 0.3)
        (shoot-at flower-8)
        (sleep 0.3)
        (shoot-at flower-7)
        (sleep 0.3)
        (shoot-at flower-6)
        (sleep 0.3)
        (shoot-at flower-5)
        (sleep 1.0)
        (audio-play (asset-ref hehehe-sound))
        (sleep 1.0)
        (tween 0.5 0.0 1.5
               (lambda (dy)
                 (change-velocity popcorn 0.0 dy)))
        (sleep 1.0)))
    (enable-pollen!)
    (change-state game 'play)
    (play-music game main-music)
    (set-source-volume! (music-source game) 1.0)
    (unless (getenv "SKIP_TUTORIAL")
      ;; Tutorial
      (tutorial "move with ARROW keys" #f)
      (tutorial "press Z to shoot" 'z)
      (sleep 2.0)
      (tutorial "shoot FLOWERS and collect POLLEN for special power" #f)
      (tutorial "press X to unleash stored power" 'x)
      (tutorial "godspeed you, little bee!" #f))
    (change-scroll-speed game 15.0)
    ;; Wave 1
    (define* (popcorn-line n spawn-point velocity delay #:optional script)
      (let loop ((i 0))
        (when (< i n)
          (let ((popcorn (make-popcorn (vec2-copy spawn-point) velocity)))
            (spawn game popcorn)
            (when script
              (run-script popcorn (script popcorn))))
          (sleep delay)
          (loop (+ i 1)))))
    (define (spawn-flower x)
      (spawn game (make-flower (vec2 x (+ %game-height 32.0)))))
    (unless (getenv "SKIP_WAVE1")
      (spawn game (make-flower (vec2 (- %game-width 64.0) (+ %game-height 32.0))))
      (popcorn-line 5 (vec2 64.0 (+ %game-height 16.0))
                    (vec2 0.0 -2.0) 0.2)
      (sleep 0.5)
      (popcorn-line 5 (vec2 (- %game-width 64.0) (+ %game-height 16.0))
                    (vec2 0.0 -2.0) 0.2)
      (sleep 0.5)
      (spawn game (make-flower (vec2 64.0 (+ %game-height 32.0))))
      (popcorn-line 5 (vec2 (/ %game-width 2.0) (+ %game-height 16.0))
                    (vec2 0.0 -2.0) 0.2)
      (sleep 1.0)
      (run-script game
        (popcorn-line 10 (vec2 -16.0 220.0)
                      (vec2 3.0 -0.5) 0.2))
      (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                    (vec2 -3.0 -0.5) 0.2)
      (spawn game (make-flower (vec2 (/ %game-width 2.0) (+ %game-height 32.0))))
      (sleep 1.0)
      (run-script game
        (popcorn-line 30 (vec2 -16.0 220.0)
                      (vec2 2.0 -2.0) 0.2))
      (run-script game
        (popcorn-line 30 (vec2 (+ %game-width 16.0) 220.0)
                      (vec2 -2.0 -2.0) 0.2))
      (spawn game (make-flower (vec2 128.0 (+ %game-height 32.0))))
      (sleep 2.0)
      (run-script game
        (popcorn-line 20 (vec2 -16.0 20.0)
                      (vec2 2.0 2.0) 0.2))
      (spawn game (make-flower (vec2 256.0 (+ %game-height 32.0))))
      (popcorn-line 20 (vec2 (+ %game-width 16.0) 20.0)
                    (vec2 -2.0 2.0) 0.2)
      (sleep 3.0))
    ;; Wave 2
    (define (spawn-turret x)
      (spawn game (make-turret (vec2 x (+ %game-height 32.0)))))
    (define (shoot-down enemy)
      (sleep 0.2)
      (repeat 10
       (add-bullet (bullets game)
                   medium-enemy-bullet
                   (position enemy)
                   (vec2 0.0 -2.0))
       (sleep 0.1)))
    (unless (getenv "SKIP_WAVE2")
      (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                    (vec2 -3.0 -0.5) 0.2)
      (spawn-flower 32.0)
      (sleep 1.0)
      (spawn-flower 270.0)
      (sleep 1.0)
      (spawn-flower 128.0)
      (sleep 1.0)
      (spawn-flower 77.0)
      (sleep 1.0)
      (spawn-flower 303.0)
      (sleep 1.0)
      (spawn-flower 153.0)
      (sleep 1.0)
      (spawn-flower 209.0)
      (popcorn-line 10 (vec2 -16.0 200.0)
                    (vec2 3.0 -0.5) 0.2)
      (sleep 1.0)
      (spawn-turret 32.0)
      (sleep 1.0)
      (spawn-flower 270.0)
      (sleep 1.0)
      (spawn-flower 128.0)
      (sleep 1.0)
      (spawn-flower 77.0)
      (sleep 1.0)
      (spawn-flower 303.0)
      (sleep 1.0)
      (spawn-flower 153.0)
      (sleep 1.0)
      (spawn-flower 209.0)
      (sleep 1.0)
      (spawn-flower 32.0)
      (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                    (vec2 -3.0 -0.5) 0.2)
      (sleep 1.0)
      (spawn-turret 270.0)
      (sleep 1.0)
      (spawn-flower 128.0)
      (sleep 1.0)
      (spawn-flower 77.0)
      (sleep 1.0)
      (spawn-turret 303.0)
      (sleep 1.0)
      (spawn-flower 153.0)
      (sleep 1.0)
      (spawn-turret 209.0)
      (sleep 1.0)
      (spawn-turret 32.0)
      (popcorn-line 10 (vec2 -16.0 200.0)
                    (vec2 3.0 -0.5) 0.2)
      (sleep 1.0)
      (spawn-turret 270.0)
      (sleep 1.0)
      (spawn-flower 128.0)
      (sleep 1.0)
      (spawn-turret 77.0)
      (sleep 1.0)
      (spawn-turret 303.0)
      (sleep 1.0)
      (spawn-flower 153.0)
      (sleep 1.0)
      (spawn-turret 209.0)
      (sleep 1.0)
      (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                    (vec2 -3.0 -0.5) 0.2)
      (sleep 1.0)
      (popcorn-line 10 (vec2 -16.0 200.0)
                    (vec2 3.0 -0.5) 0.2)
      (sleep 1.0)
      (popcorn-line 10 (vec2 (+ %game-width 16.0) 200.0)
                    (vec2 -3.0 -0.5) 0.2)
      (sleep 1.0)
      (run-script game
        (spawn-turret (* %game-width 0.25))
        (sleep 2.0)
        (spawn-turret (* %game-width 0.75))
        (sleep 2.0)
        (spawn-turret (* %game-width 0.25))
        (sleep 2.0)
        (spawn-turret (* %game-width 0.75))
        (sleep 2.0)
        (spawn-turret (* %game-width 0.25)))
      (repeat 100
        (let ((popcorn (make-popcorn (vec2 (+ (/ %game-width 2.0)
                                              (* (/ %game-width 4.0)
                                                 (- (random:uniform) 0.5)))
                                           (+ %game-height 16.0))
                                     (vec2 0.0 -2.0))))
          (spawn game popcorn)
          (run-script popcorn
            (sleep 0.5)
            (tween 0.5 -2.0 0.0
                   (lambda (dy)
                     (change-velocity popcorn 0.0 dy)))
            (let ((d (vec2-normalize
                      (vec2- (vec2+ (position (player game)) (vec2 0.0 16.0))
                             (position popcorn)))))
              (tween 0.5 0.0 4.0
                     (lambda (speed)
                       (change-velocity popcorn (* (vec2-x d) speed) (* (vec2-y d) speed)))))))
        (sleep 0.1))
      (sleep 8.0))
    ;; Wave 3
    (define (spawn-moth p)
      (let ((moth (make-moth p)))
        (spawn game moth)
        (run-script moth
          (sleep 0.2)
          (tween 1.0 -2.0 0.0
                 (lambda (dy)
                   (change-velocity moth 0.0 dy)))
          (change-velocity moth 0.0 0.0)
          (let loop ((i 0))
            (when (< i 8)
              (let* ((arc-start (- (* pi 1.5) 0.2))
                     (arc-end (+ (* pi 1.5) 0.2))
                     (n 9)
                     (arc-step (/ (- arc-end arc-start) n))
                     (speed 1.9))
                (audio-play (asset-ref enemy-shoot-sound))
                (let arc-loop ((j 0))
                  (when (< j n)
                    (let ((theta (+ arc-start (* j arc-step))))
                      (add-bullet (bullets game)
                                  medium-enemy-bullet
                                  (position moth)
                                  (vec2 (* (cos theta) speed)
                                        (* (sin theta) speed))))
                    (arc-loop (+ j 1)))))
              (sleep (* (current-timestep) 5))
              (loop (+ i 1))))
          (tween 1.0 0.0 -2.0
                 (lambda (dy)
                   (change-velocity moth 0.0 dy))))))
    (unless (getenv "SKIP_WAVE3")
      (spawn-moth (vec2 (* %game-width 0.5) (+ %game-height 16.0)))
      (spawn-flower (* %game-width 0.125))
      (sleep 4.0)
      (spawn-moth (vec2 (* %game-width 0.25) (+ %game-height 16.0)))
      (spawn-flower (* %game-width 0.375))
      (spawn-turret (* %game-width 0.875))
      (sleep 2.0)
      (spawn-moth (vec2 (* %game-width 0.5) (+ %game-height 16.0)))
      (sleep 2.0)
      (spawn-moth (vec2 (* %game-width 0.75) (+ %game-height 16.0)))
      (sleep 2.0)
      (spawn-moth (vec2 (* %game-width 0.5) (+ %game-height 16.0)))
      (spawn-flower (* %game-width 0.625))
      (spawn-turret (* %game-width 0.375))
      (sleep 1.0)
      (spawn-moth (vec2 (* %game-width 0.25) (+ %game-height 16.0)))
      (sleep 2.0)
      (spawn-moth (vec2 (* %game-width 0.5) (+ %game-height 16.0)))
      (sleep 1.0)
      (spawn-moth (vec2 (* %game-width 0.75) (+ %game-height 16.0)))
      (sleep 2.5)
      (spawn-moth (vec2 (* %game-width 0.25) (+ %game-height 16.0)))
      (spawn-moth (vec2 (* %game-width 0.75) (+ %game-height 16.0)))
      (sleep 3.0)
      (spawn-moth (vec2 (* %game-width 0.5) (+ %game-height 16.0)))
      (spawn-flower (* %game-width 0.125))
      (spawn-turret (* %game-width 0.625))
      (spawn-flower (* %game-width 0.875))
      (sleep 2.0)
      (spawn-moth (vec2 (* %game-width 0.25) (+ %game-height 16.0)))
      (spawn-moth (vec2 (* %game-width 0.5) (+ %game-height 16.0)))
      (spawn-moth (vec2 (* %game-width 0.75) (+ %game-height 16.0)))
      (sleep 7.0))
    ;; Boss
    (unless (getenv "SKIP_BOSS")
      (run-script game
        (repeat 8
          (audio-play (asset-ref alarm-sound))
          (sleep 1.0)))
      (run-script game
        (let ((warning (make <shadow-label>
                         #:name 'warning
                         #:rank 9
                         #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
                         #:font monogram-font
                         #:text "WARNING!! BIG OL' BAD THING AHEAD!"
                         #:align 'center
                         #:color %text-color)))
          (attach-to game warning)
          (blink warning 15 0.25)
          (detach warning)))
      (sleep 7.0)
      (spawn game (make <boss>
                    #:name 'boss
                    #:rank 2
                    #:position (vec2 (/ %game-width 2.0)
                                     (+ %game-height 32.0))
                    #:hitbox (make-rect -64.0 -32.0 128.0 64.0)
                    #:health 1200
                    #:points 100000))
      (sleep 4.5)
      (tween 1.0 15.0 0.0
             (lambda (speed)
               (change-scroll-speed game speed)))
      (wait-until (dead? (& game boss)))
      (clear-bullets (bullets game)))
    ;; Victory!
    (set! (invincible? (player game)) #t)
    (add-to-score (player game) (* (lives (player game)) 50000))
    (game-complete game)))

(define-method (reset-game (game <game>))
  (stop-scripts game)
  (disable-pollen!)
  (change-scroll-speed game 0.0)
  (clear-bullets (bullets game))
  (quadtree-clear! (quadtree game))
  (show (& game hud-lives))
  (show (& game hud-pollen))
  (for-each-child (lambda (child)
                    (when (or (is-a? child <actor>)
                              (memq (name child)
                                    '(game-over game-complete tutorial warning)))
                      (detach child)))
                  game)
  (spawn game
         (make <player>
           #:name 'player
           #:rank 3
           #:position (vec2 (/ %game-width 2.0) 20.0)
           #:hitbox (make-rect -0.5 -0.5 1.0 1.0)))
  (run-level game))

(define-method (on-enter (game <game>))
  (reset-game game))

(define-method (game-complete (game <game>))
  (hide (& game hud-pollen))
  (tween 1.0 1.0 0.0
         (lambda (volume)
           (set-source-volume! (music-source game) volume)))
  (source-stop (music-source game))
  (play-music game intro-music)
  (set-source-volume! (music-source game) 1.0)
  (change-state game 'pre-game-complete)
  (let ((p (player game)))
    (stop-scripts p)
    (set! (shoot? p) #f)
    (set! (move-left? p) #f)
    (set! (move-right? p) #f)
    (set! (move-down? p) #f)
    (set! (move-up? p) #f))
  (sleep 1.0)
  (audio-play (asset-ref pickup-sound))
  (spawn game (make-flower (vec2 (/ %game-width 4) 160.0)))
  (sleep 1.0)
  (audio-play (asset-ref pickup-sound))
  (spawn game (make-flower (vec2 (/ %game-width 2) 160.0)))
  (sleep 1.0)
  (audio-play (asset-ref pickup-sound))
  (spawn game (make-flower (vec2 (- %game-width (/ %game-width 4)) 160.0)))
  (sleep 1.0)
  (change-state game 'game-complete)
  (let ((group (make <node-2d>
                 #:name 'game-complete
                 #:rank 5)))
    (attach-to game group)
    (attach-to group
               (make <shadow-label>
                 #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
                 #:font monogram-font
                 #:text "WELL DONE, LITTLE BEE!"
                 #:align 'center
                 #:color %text-color)
               (make <shadow-label>
                 #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0))
                 #:font monogram-font
                 #:text "press ENTER to play again"
                 #:align 'center
                 #:color %text-color)))
  (forever
   (add-bullet (bullets game)
               pollen-pickup
               (vec2 (random %game-width) (+ %game-height 0.0))
               (vec2 0.0 (- (+ (random:uniform) 0.5))))
   (sleep 0.1)))

(define-method (game-over (game <game>))
  (hide (& game hud-lives))
  (hide (& game hud-pollen))
  (change-state game 'game-over)
  (stop-scripts game)
  (let ((p (player game)))
    (stop-scripts p)
    (hide p)
    (set! (shoot? p) #f)
    (set! (move-left? p) #f)
    (set! (move-right? p) #f)
    (set! (move-down? p) #f)
    (set! (move-up? p) #f))
  (run-script game
    (tween 1.0 (scroll-speed game) 0.0
           (lambda (speed)
             (change-scroll-speed game speed))))
  (let ((group (make <node-2d>
                 #:name 'game-over
                 #:rank 5)))
    (attach-to game group)
    (attach-to group
               (make <shadow-label>
                 #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
                 #:font monogram-font
                 #:text "GAME OVER"
                 #:align 'center
                 #:color %text-color)
               (make <shadow-label>
                 #:position (vec2 (/ %game-width 2.0) (- (/ %game-height 2.0) 20.0))
                 #:font monogram-font
                 #:text "press ENTER to try again"
                 #:align 'center
                 #:color %text-color))))

(define-method (toggle-pause (game <game>))
  (if (paused? game)
      (begin
        (detach (& game pause-overlay))
        (source-play (music-source game))
        (resume game))
      (let ((overlay (make <node-2d>
                       #:name 'pause-overlay
                       #:rank 99)))
        (pause game)
        (source-pause (music-source game))
        (attach-to overlay
                   (make <sprite>
                     #:texture darkness-image
                     #:tint (transparency 0.4))
                   (make <shadow-label>
                     #:position (vec2 (/ %game-width 2.0) (/ %game-height 2.0))
                     #:font monogram-font
                     #:text "PAUSED"
                     #:align 'center
                     #:vertical-align 'center
                     #:color %text-color))
        (attach-to game overlay))))

(define-method (play-again (game <game>))
  (change-state game 'play-again)
  (run-script game
    (tween 0.5 1.0 0.0
           (lambda (volume)
             (set-source-volume! (music-source game) volume)))
    (source-stop (music-source game))
    (set-source-volume! (music-source game) 1.0))
  (run-script game
    (fade-out game 1.0)
    (reset-game game)))

(define-method (close-game (game <game>))
  (pop-scene (current-kernel)))

(define-method (on-quit (game <game>))
  (close-game game))

(define-method (on-key-press (game <game>) key modifiers repeat?)
  (case (state game)
    ((play)
     (case key
       ((left)
        (set! (move-left? (player game)) #t))
       ((right)
        (set! (move-right? (player game)) #t))
       ((down)
        (set! (move-down? (player game)) #t))
       ((up)
        (set! (move-up? (player game)) #t))
       ((z)
        (set! (shoot? (player game)) #t))
       ((x)
        (bomb (player game)))
       ((escape)
        (close-game game))
       ((return)
        (toggle-pause game))))
    ((intro)
     (case key
       ((escape)
        (close-game game))
       ((return)
        (toggle-pause game))))
    ((game-over game-complete)
     (case key
       ((escape)
        (close-game game))
       ((return)
        (play-again game))))))

(define-method (on-key-release (game <game>) key modifiers)
  (case (state game)
    ((play)
     (case key
       ((left)
        (set! (move-left? (player game)) #f))
       ((right)
        (set! (move-right? (player game)) #f))
       ((down)
        (set! (move-down? (player game)) #f))
       ((up)
        (set! (move-up? (player game)) #f))
       ((z)
        (set! (shoot? (player game)) #f))))))

(define-method (update (game <game>) dt)
  (next-method)
  (let ((bg (& game background)))
    (set! (scroll-y bg) (+ (scroll-y bg) (* (scroll-speed game) dt))))
  (case (state game)
    ((intro play)
     (let ((p (player game)))
       (when (not (= (last-lives game) (lives p)))
         (set! (text (& game hud-lives))
               (string-append "lives " (number->string (lives p))))
         (when (= (lives p) 0)
           (game-over game)))
       (when (not (= (last-pollen game) (pollen p)))
         (let ((n (pollen p)))
           (set! (text (& game hud-pollen))
                 (string-append "pollen "
                                (if (= n %max-pollen) "MAX" (number->string n))))))
       (when (not (= (last-score game) (score p)))
         (set! (text (& game hud-score))
               (string-append "score " (number->string (score p)))))
       (set! (last-lives game) (lives p))
       (set! (last-pollen game) (pollen p))
       (set! (last-score game) (score p))
       (shoot-maybe p (bullets game))
       (for-each-child (lambda (child)
                         (cond
                          ((dead? child)
                           (on-death child)
                           (quadtree-delete! (quadtree game)
                                             (world-hitbox child)
                                             child)
                           (add-to-score (player game) (points child))
                           (detach child))
                          ((out-of-bounds? child)
                           (quadtree-delete! (quadtree game)
                                             (world-hitbox child)
                                             child)
                           (detach child))))
                       game)))))