(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 (catbird)
  #:use-module (catbird asset)
  #:use-module (catbird kernel)
  #:use-module (catbird observer)
  #:use-module (catbird mode)
  #:use-module (catbird node)
  #:use-module (catbird node-2d)
  #:use-module (catbird scene)
  #:export (make-game-scene))


;;;
;;; Shadow label
;;;

(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 (slot-ref label 'font)
               #: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))))


;;;
;;; Heads-up display
;;;

(define-class <hud> (<node-2d>)
  (last-lives #:accessor last-lives #:init-value 0)
  (last-pollen #:accessor last-pollen #:init-value 0)
  (last-score #:accessor last-score #:init-value 0))

(define-method (on-boot (hud <hud>))
  (attach-to hud
             (make <shadow-label>
               #:name 'lives
               #:position (vec2 2.0 2.0)
               #:font monogram-font
               #:text "lives 0"
               #:color %text-color)
             (make <shadow-label>
               #:name 'pollen
               #:position (vec2 (/ %game-width 2.0) 2.0)
               #:font monogram-font
               #:text "pollen 0"
               #:align 'center
               #:color %text-color)
             (make <shadow-label>
               #:name 'score
               #:position (vec2 (- %game-width 2.0) 2.0)
               #:font monogram-font
               #:text "score 0"
               #:align 'right
               #:color %text-color)))

(define-method (update (hud <hud>) dt)
  (let ((p (& (parent hud) player)))
    (when (not (= (last-lives hud) (lives p)))
      (set! (text (& hud lives))
            (string-append "lives " (number->string (lives p)))))
    (when (not (= (last-pollen hud) (pollen p)))
      (let ((n (pollen p)))
        (set! (text (& hud pollen))
              (string-append "pollen "
                             (if (= n %max-pollen) "MAX" (number->string n))))))
    (when (not (= (last-score hud) (score p)))
      (set! (text (& hud score))
            (string-append "score " (number->string (score p)))))
    (set! (last-lives hud) (lives p))
    (set! (last-pollen hud) (pollen p))
    (set! (last-score hud) (score p))))


;;;
;;; Game scene
;;;

(define %game-bounds (make-rect 0.0 0.0 %game-width %game-height))
(define %default-player-position (vec2 (/ %game-width 2.0) 20.0))

(define-class <game-scene> (<scene>)
  (quadtree #:getter quadtree #:init-form (make-quadtree %game-bounds))
  (scroll-speed #:getter scroll-speed #:init-value 0.0)
  (music-source #:getter music-source #:init-form (make-source #:loop? #t))
  (intro-script #:accessor intro-script #:init-value #f))

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

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

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

(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 (& (parent turret) player))
                       (* (- (* (random:uniform) 2.0) 1.0) 0.2)))
             (speed 1.5))
         (audio-play (artifact enemy-shoot-sound))
         (add-bullet (& (parent turret) bullets)
                     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 (skip-intro (scene <game-scene>))
  (teleport (& scene player)
            (vec2-x %default-player-position)
            (vec2-y %default-player-position))
  (cancel-script (intro-script scene)))

(define-method (run-level (scene <game-scene>))
  (define (tutorial message continue?)
    (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 scene l)
      (if continue?
          (begin
            (wait-until (continue?))
            (sleep 1.0))
          (sleep 2.0))
      (detach l)))
  (run-script scene
    (fade-in scene 1.0))
  (run-script scene
    (set! (scoring-enabled? (& scene player)) #f)
    (set! (intro-script scene)
          (run-script scene
            ;; 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 (& scene bullets)
                            medium-enemy-bullet
                            (position popcorn)
                            (vec2* (direction-to popcorn flower) bullet-speed)))
              (spawn scene flower-1)
              (spawn scene flower-2)
              (spawn scene flower-3)
              (spawn scene flower-4)
              (spawn scene flower-5)
              (spawn scene flower-6)
              (spawn scene flower-7)
              (spawn scene flower-8)
              (spawn scene (make-flower (vec2 194.0 95.0)))
              (spawn scene (make-flower (vec2 102.0 82.0)))
              (spawn scene (make-flower (vec2 247.0 45.0)))
              (spawn scene (make-flower (vec2 159.0 40.0)))
              (spawn scene (make-flower (vec2 73.0 28.0)))
              (teleport (& scene player) 159.0 40.0)
              (play-music scene intro-music)
              (sleep 1.0)
              (audio-play (artifact pollen-release-sound))
              (sleep 0.6)
              (move-to (& scene player) 247.0 45.0 1.0)
              (sleep 0.2)
              (audio-play (artifact pollen-release-sound))
              (sleep 0.6)
              (move-to (& scene player) 102.0 76.0 1.0)
              (sleep 0.2)
              (audio-play (artifact pollen-release-sound))
              (sleep 2.0)
              (run-script scene
                (tween 1.0 1.0 0.0
                       (lambda (volume)
                         (set-source-volume! (music-source scene) volume))))
              (source-stop (music-source scene))
              (spawn scene 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 (artifact 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!)
              (replace-major-mode scene (make <play-mode>))
              (play-music scene main-music)
              (set-source-volume! (music-source scene) 1.0)
              ;; Tutorial
              (tutorial "move with ARROW keys or controller DPAD"
                        (lambda ()
                          (moving? (& scene player))))
              (tutorial "press Z key or A button to shoot"
                        (lambda ()
                          (shoot? (& scene player))))
              (sleep 2.0)
              (tutorial "shoot FLOWERS and collect POLLEN for special power" #f)
              (tutorial "press X key or B button to unleash stored power"
                        (lambda ()
                          (let ((p (& scene player)))
                            (or (bombing? p)
                                ;; Ensure bomb can be used to avoid a soft lock.
                                (begin
                                  (unless (= (pollen p) %max-pollen)
                                    (set! (pollen p) %max-pollen))
                                  #f)))))
              (tutorial "godspeed you, little bee!" #f))))
    (join (intro-script scene))
    (set! (intro-script scene) #f)
    ;; The intro and tutorial sequence set up a bunch of state, but if
    ;; the player skips it, we need to set it up here.  Each of the
    ;; following operations may be no-ops, depending on how far into
    ;; the intro the player was before they skipped it.
    (enable-pollen!)
    (unless (is-a? (major-mode scene) <play-mode>)
      (replace-major-mode scene (make <play-mode>)))
    (play-music scene main-music)
    (set-source-volume! (music-source scene) 1.0)
    (set! (pollen (& scene player)) 0)
    (and=> (& scene tutorial) detach)
    (clear-bullets (& scene bullets))
    (for-each-child (lambda (child)
                      (when (and (is-a? child <actor>)
                                 (not (is-a? child <player>)))
                        (detach child)))
                    scene)
    ;; Start the game
    (set! (scoring-enabled? (& scene player)) #t)
    (change-scroll-speed scene 15.0)
    (sleep 1.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 scene popcorn)
            (when script
              (run-script popcorn (script popcorn))))
          (sleep delay)
          (loop (+ i 1)))))
    (define (spawn-flower x)
      (spawn scene (make-flower (vec2 x (+ %game-height 32.0)))))
    (unless (getenv "SKIP_WAVE1")
      (spawn scene (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 scene (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 scene
        (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 scene (make-flower (vec2 (/ %game-width 2.0) (+ %game-height 32.0))))
      (sleep 1.0)
      (run-script scene
        (popcorn-line 30 (vec2 -16.0 220.0)
                      (vec2 2.0 -2.0) 0.2))
      (run-script scene
        (popcorn-line 30 (vec2 (+ %game-width 16.0) 220.0)
                      (vec2 -2.0 -2.0) 0.2))
      (spawn scene (make-flower (vec2 128.0 (+ %game-height 32.0))))
      (sleep 2.0)
      (run-script scene
        (popcorn-line 20 (vec2 -16.0 20.0)
                      (vec2 2.0 2.0) 0.2))
      (spawn scene (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 scene (make-turret (vec2 x (+ %game-height 32.0)))))
    (define (shoot-down enemy)
      (sleep 0.2)
      (repeat 10
        (add-bullet (& scene bullets)
                    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 scene
        (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 scene 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 (& scene player)) (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 scene 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 (artifact enemy-shoot-sound))
                (let arc-loop ((j 0))
                  (when (< j n)
                    (let ((theta (+ arc-start (* j arc-step))))
                      (add-bullet (& scene bullets)
                                  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 scene
        (repeat 8
          (audio-play (artifact alarm-sound))
          (sleep 1.0)))
      (run-script scene
        (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 scene warning)
          (blink warning 15 0.25)
          (detach warning)))
      (sleep 7.0)
      (spawn scene (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 scene speed)))
      (wait-until (dead? (& scene boss)))
      (clear-bullets (& scene bullets)))
    ;; Victory!
    (set! (invincible? (& scene player)) #t)
    (add-to-score (& scene player) (* (lives (& scene player)) 50000))
    (game-complete scene)))

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

(define-method (on-boot (scene <game-scene>))
  (attach-to scene
             (make <background>
               #:name 'background
               #:texture background-image)
             (make <particles>
               #:name 'particles
               #:particles (make-particles 2048
                                           #:texture (artifact particle-image)
                                           #:end-color (make-color 1.0 1.0 1.0 0.0)))
             (make <bullets>
               #:name 'bullets
               #:rank 4
               #:quadtree (quadtree scene))
             (make <hud>
               #:name 'hud
               #:rank 5)))

(define-method (game-complete (scene <game-scene>))
  (set! (scoring-enabled? (& scene player)) #f)
  (hide (& scene hud pollen))
  (tween 1.0 1.0 0.0
         (lambda (volume)
           (set-source-volume! (music-source scene) volume)))
  (source-stop (music-source scene))
  (play-music scene intro-music)
  (set-source-volume! (music-source scene) 1.0)
  (replace-major-mode scene (make <nothing-mode>))
  (let ((p (& scene player)))
    (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 (artifact pickup-sound))
  (spawn scene (make-flower (vec2 (/ %game-width 4) 160.0)))
  (sleep 1.0)
  (audio-play (artifact pickup-sound))
  (spawn scene (make-flower (vec2 (/ %game-width 2) 160.0)))
  (sleep 1.0)
  (audio-play (artifact pickup-sound))
  (spawn scene (make-flower (vec2 (- %game-width (/ %game-width 4)) 160.0)))
  (sleep 1.0)
  (replace-major-mode scene (make <game-complete-mode>))
  (let ((group (make <node-2d>
                 #:name 'game-complete
                 #:rank 5)))
    (attach-to scene 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 key or START button to play again"
                 #:align 'center
                 #:color %text-color)))
  (forever
   (add-bullet (& scene bullets)
               pollen-pickup
               (vec2 (random %game-width) (+ %game-height 0.0))
               (vec2 0.0 (- (+ (random:uniform) 0.5))))
   (sleep 0.1)))

(define-method (game-over (scene <game-scene>))
  (set! (scoring-enabled? (& scene player)) #f)
  (hide (& scene hud lives))
  (hide (& scene hud pollen))
  (replace-major-mode scene (make <game-over-mode>))
  (stop-scripts scene)
  (let ((p (& scene player)))
    (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 scene
    (tween 1.0 (scroll-speed scene) 0.0
           (lambda (speed)
             (change-scroll-speed scene speed))))
  (let ((group (make <node-2d>
                 #:name 'game-over
                 #:rank 5)))
    (attach-to scene 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 key or START button to try again"
                 #:align 'center
                 #:color %text-color))))

(define-method (toggle-pause (scene <game-scene>))
  (if (paused? scene)
      (begin
        (detach (& scene pause-overlay))
        (source-play (music-source scene))
        (resume scene))
      (let ((overlay (make <node-2d>
                       #:name 'pause-overlay
                       #:rank 99)))
        (pause scene)
        (source-pause (music-source scene))
        (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 scene overlay))))

(define-method (play-again (scene <game-scene>))
  (replace-major-mode scene (make <nothing-mode>))
  (run-script scene
    (tween 0.5 1.0 0.0
           (lambda (volume)
             (set-source-volume! (music-source scene) volume)))
    (source-stop (music-source scene))
    (set-source-volume! (music-source scene) 1.0))
  (run-script scene
    (fade-out scene 1.0)
    (replace-major-mode scene (make <intro-mode>))))

(define-method (clean-up-actors (scene <game-scene>))
  (let ((p (& scene player)))
    ;; This probably shouldn't be here, but it is.
    (shoot-maybe p (& scene bullets))
    ;; Remove dead actors and actors that have gone too far off
    ;; screen.
    (for-each-child (lambda (child)
                      (cond
                       ((dead? child)
                        (on-death child)
                        (quadtree-delete! (quadtree scene)
                                          (world-hitbox child)
                                          child)
                        (add-to-score (& scene player) (points child))
                        (detach child))
                       ((out-of-bounds? child)
                        (quadtree-delete! (quadtree scene)
                                          (world-hitbox child)
                                          child)
                        (detach child))))
                    scene)
    (when (= (lives p) 0) ; bummer
      (game-over scene))))

(define-method (update (scene <game-scene>) dt)
  (next-method)
  (let ((bg (& scene background)))
    (set! (scroll-y bg) (+ (scroll-y bg) (* (scroll-speed scene) dt)))))


;;;
;;; Modes
;;;

(define-method (close-game (mode <major-mode>))
  (exit-catbird))

(define-method (pause-game (mode <major-mode>))
  (toggle-pause (parent mode)))

(define-method (skip-intro (mode <major-mode>))
  (skip-intro (parent mode)))

(define-class <intro-mode> (<major-mode>))

(define-method (on-enter (mode <intro-mode>))
  (reset-game (parent mode)))

(define-method (update (mode <intro-mode>) dt)
  (clean-up-actors (parent mode)))

(bind-input <intro-mode> (key-press 'escape) close-game)
(bind-input <intro-mode> (key-press 'return) skip-intro)
(bind-input <intro-mode> (controller-press '0 'back) close-game)
(bind-input <intro-mode> (controller-press '0 'start) skip-intro)

(define-class <play-mode> (<major-mode>))

(define-method (update (mode <play-mode>) dt)
  (clean-up-actors (parent mode)))

(define (move-command accessor value)
  (lambda (mode)
    (set! (accessor (& (parent mode) player)) value)))

(define-method (player-shoot (mode <play-mode>))
  (set! (shoot? (& (parent mode) player)) #t))

(define-method (player-stop-shooting (mode <play-mode>))
  (set! (shoot? (& (parent mode) player)) #f))

(define-method (player-bomb (mode <play-mode>))
  (bomb (& (parent mode) player)))

(define-method (skip-intro-or-pause-game (mode <play-mode>))
  (let ((scene (parent mode)))
    (if (intro-script scene)
        (skip-intro scene)
        (toggle-pause scene))))

(bind-input <play-mode> (key-press 'left) (move-command move-left? #t))
(bind-input <play-mode> (key-press 'right) (move-command move-right? #t))
(bind-input <play-mode> (key-press 'down) (move-command move-down? #t))
(bind-input <play-mode> (key-press 'up) (move-command move-up? #t))
(bind-input <play-mode> (key-release 'left) (move-command move-left? #f))
(bind-input <play-mode> (key-release 'right) (move-command move-right? #f))
(bind-input <play-mode> (key-release 'down) (move-command move-down? #f))
(bind-input <play-mode> (key-release 'up) (move-command move-up? #f))
(bind-input <play-mode> (key-press 'z) player-shoot)
(bind-input <play-mode> (key-release 'z) player-stop-shooting)
(bind-input <play-mode> (key-press 'x) player-bomb)
(bind-input <play-mode> (key-press 'escape) close-game)
(bind-input <play-mode> (key-press 'return) skip-intro-or-pause-game)
(bind-input <play-mode> (controller-press 0 'dpad-left) (move-command move-left? #t))
(bind-input <play-mode> (controller-press 0 'dpad-right) (move-command move-right? #t))
(bind-input <play-mode> (controller-press 0 'dpad-down) (move-command move-down? #t))
(bind-input <play-mode> (controller-press 0 'dpad-up) (move-command move-up? #t))
(bind-input <play-mode> (controller-release 0 'dpad-left) (move-command move-left? #f))
(bind-input <play-mode> (controller-release 0 'dpad-right) (move-command move-right? #f))
(bind-input <play-mode> (controller-release 0 'dpad-down) (move-command move-down? #f))
(bind-input <play-mode> (controller-release 0 'dpad-up) (move-command move-up? #f))
(bind-input <play-mode> (controller-press 0 'a) player-shoot)
(bind-input <play-mode> (controller-release 0 'a) player-stop-shooting)
(bind-input <play-mode> (controller-press 0 'b) player-bomb)
(bind-input <play-mode> (controller-press 0 'back) close-game)
(bind-input <play-mode> (controller-press 0 'start) skip-intro-or-pause-game)

(define-class <game-over-mode> (<major-mode>))

(define-method (play-game-again (mode <major-mode>))
  (play-again (parent mode)))

(bind-input <game-over-mode> (key-press 'escape) close-game)
(bind-input <game-over-mode> (key-press 'return) play-game-again)
(bind-input <game-over-mode> (controller-press 0 'back) close-game)
(bind-input <game-over-mode> (controller-press 0 'start) play-game-again)

(define-class <game-complete-mode> (<major-mode>))

(bind-input <game-complete-mode> (key-press 'escape) close-game)
(bind-input <game-complete-mode> (key-press 'return) play-game-again)
(bind-input <game-complete-mode> (controller-press 0 'back) close-game)
(bind-input <game-complete-mode> (controller-press 0 'start) play-game-again)

(define (make-game-scene)
  (let ((scene (make <game-scene>)))
    (replace-major-mode scene (make <intro-mode>))
    scene))