~technomancy/fennel-compendium

b425f57efa3dacb632e5013b4a2e6c2fbfc11bb8 — Phil Hagelberg 5 months ago f72fd7a
Add butterfly-effect game.
2 files changed, 1000 insertions(+), 8 deletions(-)

M Makefile
A butterfly-effect.fnl
M Makefile => Makefile +9 -8
@@ 88,14 88,15 @@ yahtzee-adventure: yahtzee-adventure/lib/fennel.lua
	cd $@ && love .

tic: amethyst.fnl hats.fnl life.fnl mech.fnl robotfindskitten.fnl \
		spilljackers.fnl xeno.fnl
		spilljackers.fnl xeno.fnl butterfly-effect.fnl

amethyst.fnl: fennel ; tic80 $@
hats.fnl: fennel ; tic80 $@
life.fnl: fennel ; tic80 $@
mech.fnl: fennel ; tic80 $@
robotfindskitten.fnl: fennel ; tic80 $@
spilljackers.fnl: fennel ; tic80 $@
xeno.fnl: fennel ; tic80 $@
amethyst.fnl: ; tic80 $@
hats.fnl: ; tic80 $@
life.fnl: ; tic80 $@
mech.fnl: ; tic80 $@
robotfindskitten.fnl: ; tic80 $@
spilljackers.fnl: ; tic80 $@
xeno.fnl: ; tic80 $@
butterfly-effect.fnl: ; tic80 $@

.PHONY: all love tic compiler

A butterfly-effect.fnl => butterfly-effect.fnl +991 -0
@@ 0,0 1,991 @@
;; title: Butterfly Effect
;; author: Adam Lloyd
;; script: fennel
;; vim: tw=56:cc=+3:et:fdm=marker:fen
;; TIC-80: use thin font!

; {{{ SETTINGS & CONSTANTS
(local SETTINGS
  {:dbg-boxes       false   ; draw intersection-areas
   :frames-to-drop  30      ; frames before dropping code
   :game-start-time [07 30] ; time when game starts
   :max-carried     3       ; max carry slots
   :max-mutations   20      ; max mutations retained
   :ms-per-second   1       ; scale real time -> game time
   :num-plots       96      ; max number of plants
   :plot-grp-size   4       ; group size for spawning
   :plot-width      12      ; size of a plot
   :rain-per-frame  3       ; new raindrops per frame
   :water-to-spawn  30      ; water needed before spawning
   :x-shift-buffer  30      ; # pixels from edge to shift
   })

(local CONST
  {:game-start-seconds (let
                         [[h m] SETTINGS.game-start-time]
                         (* 60 (+ m (* h 60))))
   :midday [12 30]
   :petal-shapes [:circle
                  :triangle
                  :inverted-triangle
                  :line]
   :player-types [{:name :butterfly
                   :height 16
                   :width 16
                   :carry-slots 3}
                  {:name :cloud
                   :height 16
                   :width 43
                   :rain true}]
   :seconds-per-day (* 24 60 60)
   :world-max-x (* SETTINGS.num-plots
                   SETTINGS.plot-width)})

(let [[hours minutes] CONST.midday]
  (tset CONST :seconds-at-midday
        (* 60 (+ minutes (* 60 hours)))))
; }}}

; {{{ COLORS
(local COLORS
  {:transparent 0   ; for sprites
   :sky 0
   :sun 1
   :stem 2
   :cloud 3 :star 3 :moon 3 :white 3
   :cloud-2 4 :gray 4
   :rain 5
   :butterfly-body 6 :bee-body-1 6
   :butterfly-eye 7 :bee-body-2 7 :dying-plant 7
   ;; rest are flowers
   8 8 9 9 10 10 11 11 12 12 13 13 14 14 15 15
   })

(local COLOR_ADDR
  (collect [color index (pairs COLORS)]
    (values color (+ 0x03FC0 (* 3 index)))))

(fn set-color! [name [r g b]]
  "Updates the named color in VRAM."
  (let [addr (. COLOR_ADDR name)]
    (poke addr r)
    (poke (+ addr 1) g)
    (poke (+ addr 2) b)))
; }}}

; {{{ GAME STATE
;;; Player's state
(var player-type 1) ; index in CONST.player-types
(var player (. CONST.player-types player-type))
(var x 90)
(var y 40)
(var direction :right)
(var carrying [])
(var just-picked-up [])
(var x-shift 0)

;;; State of the world
(var plants [])
(var raindrops [])

;;; Current happenings
(var frames-intersected 0)
(var intersected-with nil)

;;; Clock stuff
; How many seconds have elapsed in the game.
(var seconds-elapsed 0)
; How many days have elapsed in the game.
(var days-elapsed 0)
; Clock time in the game: [hour minute].
(var clock-time [0 0])
; 0 at midday, increases toward 1 until midday tomorrow.
(var fraction-past-midday 0)
; Where is the sun? [x y]
(var sun-position [0 0])
; How much light from the sun is there now?
(var amount-of-light 0)
; }}}

; {{{ CODE MANIPULATION MACROS
(local fennel (require :fennel))
(local {: list : sequence : sym} fennel)

(macro eval [body opts ...]
  "Evaluates fennel code from a data structure."
  `(fennel.eval (fennel.view ,body) ,opts ,...))

(macro deval [body]
  "Turns a fennel form into a data structure that
  can be manipulated and sent back to eval."
  (fn do-deval [form]
    (if
      (sym? form) `(sym ,(view form))

      (list? form)
      `(list ,(table.unpack
                (icollect [_ subform (ipairs form)]
                  (do-deval subform))))

      (sequence? form)
      `(sequence ,(table.unpack
                    (icollect [_ subform (ipairs form)]
                      (do-deval subform))))

      (table? form)
      (collect [key subform (pairs form)]
        (values key (do-deval subform)))

      form))

  (do-deval body))

(macro deview [body]
  "Turns a fennel form into a fennel string."
  `(fennel.view (deval ,body)))
; }}}

; {{{ OTHER HELPFUL MACROS & UTILITIES
(macro append! [seq item]
  "Appends item to seq."
  `(tset ,seq (+ 1 (length ,seq)) ,item))

(macro inc! [variable]
  `(set ,variable (+ 1 ,variable)))

(fn circ-coords [[cx cy] angle radius ?adjust]
  "Returns (as a sequence) the x and y coordinates of
  the point on a circle with the given radius at the
  given angle.

  If given, adds ?adjust to angle."
  (let [adjusted-angle
        (if ?adjust (+ angle ?adjust) angle)]
    [(+ cx (* radius (math.cos adjusted-angle)))
     (+ cy (* radius (math.sin adjusted-angle)))]))

(fn clamp [min max value]
  "Returns value when min < value < max, min when
  value <= min, or max when value >= max."
  (math.max min (math.min max value)))

(fn contains? [seq thing]
  "Returns true if thing is in seq."
  (var found false)
  (each [_ contained (ipairs seq)]
    (when (= thing contained)
      (set found true)))
  found)

(fn modify! [tbl field func]
  "Modifies the value of field in tbl by setting it to
  the result of applying func to the its current value."
  (doto tbl
        (tset field (func (. tbl field)))))

(fn rand-nth [seq]
  "Returns a random entry from a sequence."
  (. seq (math.random (length seq))))

(fn rand-remove-nth! [seq]
  "Removes and returns a random entry from a sequence."
  (table.remove seq (math.random (length seq))))

(fn resolve [func-seq]
  "Turns a sequence of functions (e.g., an plant's code)
  into a single form that calls those functions with obj
  as the first argument and returns obj afterward."
  (var result (deval (doto obj)))
  (each [_ func (ipairs func-seq)]
    (append! result func))
  result)

(fn %wrap [num divisor]
  "Exactly like %, but returns the divisor where % would
  return 0."
  (let [result (% num divisor)]
    (if (= result 0) divisor result)))

(fn screen-x->world-x [screen-x]
  "Translates an on-screen x coordinate to an absolute
  x coordinate in the world."
  (+ screen-x x-shift))

(fn world-x->screen-x [world-x]
  "Translates an absolute x coordinate in the world to
  an x coordinate on screen."
  (% (- world-x x-shift) CONST.world-max-x))
; }}}

; {{{ PLANTS
(fn plot-x [plot]
  "Returns the x coordinate for the plot."
  (world-x->screen-x
    (* (- plot 1) SETTINGS.plot-width)))

;; When called with no arg, each function will produce
;; a sensible default value.  Called with an argument,
;; it will adjust that value to fit within reasonable
;; bounds.
(local PLANT_FIELDS
  {:color
   (fn color [?color]
     "What color is this plant's flower?"
     (if ?color (+ 8 (% ?color 8))
       (math.random 0x8 0xf)))

   :flower-size
   (fn flower-size [?flower-size]
     "How big is this plant's flower?"
     (if ?flower-size (math.max 5 ?flower-size)
       (math.random 6 10)))

   :petals
   (fn petals [?petals]
     "How many petals does this plant's flower have?"
     (if ?petals (math.max 2 ?petals)
       (math.random 3 6)))

   :petal-shape
   (fn petal-shape [?petal-shape]
     "What shape are this plant's petals?"
     (if ?petal-shape ?petal-shape
       (rand-nth CONST.petal-shapes)))
   })

(local plant-methods
  {:adjust!
   (fn plant-adjust! [plant]
     "Updates an plant to make sure it fits within
     reasonable bounds.  Prevents its modifier functions
     from doing crazy things."
     (each [field adjuster (pairs PLANT_FIELDS)]
       (tset plant field (adjuster (. plant field))))

     (when (> (length plant.code) SETTINGS.max-mutations)
       (local trimmed-code [])
       (table.move
         plant.code
         (- (length plant.code) SETTINGS.max-mutations)
         (length plant.code)
         1 trimmed-code)
       (tset plant :code trimmed-code)))

   :percentage-grown
   (fn plant-percentage-grown [plant]
     "A plant will eventually be fully grown.  This
     returns a number from 0 (just born) to 1 (fully
     grown)."
     ;; TODO: make growth speed genetic.
     (math.min 1 (* 8 plant.age)))

   :fully-grown?
   (fn plant-fully-grown? [plant]
     (= (plant:percentage-grown) 1))

   :almost-dead?
   (fn plant-almost-dead? [plant]
     (> plant.age 0.9))

   :dead?
   (fn plant-dead? [plant]
     (> plant.age 1))

   :height
   (fn height [plant]
     "Calculates this plant's current height."
     (* plant.max-height (plant:percentage-grown)))

   :flower-center
   (fn plant-flower-center [plant]
     "Returns the coordinates of the center of the
     flower."
     [(+ 2 (plot-x plant.plot))
      (- 136 (* 6 plant.max-height))])

   :draw
   (fn plant-draw [plant]
     "Draws this plant."

     (let [current-height (plant:height)
           pixel-height (* 6 current-height)
           x (plot-x plant.plot)
           [center-x center-y] (plant:flower-center)

           foliage-color
           (if (plant:almost-dead?)
             COLORS.dying-plant
             COLORS.stem)

           flower-color
           (if (plant:almost-dead?)
             COLORS.dying-plant
             plant.color)

           flower-rotation
           (math.rad plant.flower-rotation)]

       (fn draw-stem []
         (line center-x 136
               center-x (- 136 pixel-height)
               foliage-color))

       (fn draw-leaves []
         (for [y
               (- 136 6)
               (- 136 (* 6 current-height))
               -6]
           (print :v x y foliage-color true))
         (when (not (plant:fully-grown?))
           (print :v
                  (+ 1 x) (- 136 (* 6 current-height))
                  foliage-color true 1 true)))

       (fn draw-circle-flower []
         (let [petal-radius (// plant.flower-size 2)
               petal-spacing
               (* plant.petals
                  (math.min 1 (/ plant.flower-size 2.5)))]
           (for [i 1 plant.petals]
             (let [petal-angle
                   (+ flower-rotation
                      (/ (* i 2 math.pi) plant.petals))

                   [petal-cx petal-cy]
                   (circ-coords [center-x center-y]
                                petal-angle
                                petal-spacing)]
               (line center-x center-y
                     petal-cx petal-cy
                     foliage-color)
               (circ petal-cx petal-cy
                     petal-radius flower-color)
               (circb petal-cx petal-cy
                      petal-radius COLORS.transparent)))))

       (fn draw-triangle-flower []
         (for [i 1 plant.petals]
           (let [petal-angle
                 (+ flower-rotation
                    (/ (* i 2 math.pi) plant.petals))

                 center [center-x center-y]

                 petal-short-side-half
                 (/ plant.flower-size 4)

                 [x1 y1] (circ-coords
                           center petal-angle
                           plant.flower-size)

                 [x2 y2] (circ-coords
                           center petal-angle
                           petal-short-side-half
                           (/ math.pi 2))

                 [x3 y3] (circ-coords
                           center petal-angle
                           petal-short-side-half
                           (- (/ math.pi 2)))]

             (tri x1 y1 x2 y2 x3 y3 flower-color)))

         (for [i 1 plant.petals]
           (let [[x1 y1] [center-x center-y]
                 [x2 y2] (circ-coords
                           [x1 y1]
                           (+ flower-rotation
                              (/ (* i 2 math.pi)
                                 plant.petals))
                           (/ plant.flower-size 3)
                           (/ math.pi plant.petals))]
             (line x1 y1 x2 y2 COLORS.transparent))))

       (fn draw-inverted-triangle-flower []
         (for [i 1 plant.petals]
           (let [petal-angle
                 (+ flower-rotation
                    (/ (* i 2 math.pi) plant.petals))

                 center [center-x center-y]

                 petal-short-side-half
                 (/ plant.flower-size 4)

                 [x2 y2] (circ-coords
                           center petal-angle
                           plant.flower-size
                           (* 0.6
                              (/ math.pi plant.petals)))

                 [x3 y3] (circ-coords
                           center petal-angle
                           plant.flower-size
                           (* -0.6
                              (/ math.pi plant.petals)))]

             (tri center-x center-y
                  x2 y2
                  x3 y3
                  flower-color)))

         (for [i 1 plant.petals]
           (let [[x1 y1] [center-x center-y]
                 [x2 y2] (circ-coords
                           [x1 y1]
                           (+ flower-rotation
                              (/ (* i 2 math.pi)
                                 plant.petals))
                           plant.flower-size
                           (/ math.pi plant.petals))]
             (line x1 y1 x2 y2 COLORS.transparent))))

       (fn draw-line-flower []
         (let [num-petals (* 4 plant.petals)]
           (for [i 1 num-petals]
             (let [petal-angle
                   (+ flower-rotation
                      (/ (* i 2 math.pi) num-petals))

                   [x1 y1] (circ-coords
                             [center-x center-y]
                             petal-angle
                             plant.flower-size)]
               (line center-x center-y
                     x1 y1
                     flower-color)))))

       (fn draw-flower []
         (when (= current-height plant.max-height)
           (match plant.petal-shape
             :circle
             (draw-circle-flower)

             :triangle
             (draw-triangle-flower)

             :inverted-triangle
             (draw-inverted-triangle-flower)

             :line
             (draw-line-flower))
           (when (not (plant:almost-dead?))
             (pix center-x center-y 6))
           (when SETTINGS.dbg-boxes
             (circb center-x center-y
                    plant.flower-size 1))))

       (draw-stem)
       (draw-leaves)
       (draw-flower)))

   :intersects?
   (fn plant-intersects? [plant [x1 y1]]
     "Does this plant intersect with the box?"
     (when (plant:fully-grown?)
       (let [[cx cy] (plant:flower-center)]
         (< (+ (^ (- x1 cx) 2)
               (^ (- y1 cy) 2))
            (^ plant.flower-size 2)))))

   :grow!
   (fn plant-grow! [plant]
     (tset plant :age (/ (- seconds-elapsed plant.born)
                         plant.lifespan))
     )
   })

(local plant-mt
  {:__index plant-methods})

;; What is a plant?
;; plot - its position in the world
;; age - fraction of total lifespan
;; born - when this plant was created
;; code - bits of code that made this plant
;; carrying - bits of code that have been dropped here
;; lifespan - how long this plant lives
;; max-height - its maximum height
;; water - how much rain this plant has gotten
(fn make-plant [base]
  (let [plant {:plot nil  ; will be set when planted
               :max-height (or base.max-height 1)
               :age 0
               :born seconds-elapsed
               :carrying (list)
               :code (sequence)
               :flower-rotation (math.random 0 360)
               ;; Default lifespan: 5 days in seconds
               :lifespan (or base.lifespan 432000)
               :water 0
               }]
    (when base.code
      (table.move
        base.code 1 (length base.code)
        1 plant.code))
    (each [field adjust (pairs PLANT_FIELDS)]
      (when (. plant field)
        (trace
          (string.format
            "Warning: plant already has field '%s' set"
            field)))
      (tset plant field (adjust (. base field))))
    (setmetatable plant plant-mt)
    (plant:adjust!)
    plant))

(fn spawn-mutant [plant mutations]
  "Spawns a new plant based on this one, applying the
  given mutations.

  Returns the new plant. For...planting."
  (let [new-plant (make-plant plant)
        mutate! (resolve mutations)]
    (eval mutate!
          {:env {: math
                 : modify!
                 : string
                 : time
                 :obj new-plant}})
    (table.move
      mutations 1 (length mutations)
      (+ 1 (length new-plant.code)) new-plant.code)
    (new-plant:adjust!)
    new-plant))

(tset plant-methods
      :spawn
      (fn plant-spawn [{: carrying : water &as plant}]
        "If this plant has received enough water, this
        produces a new plant based on this plant,
        applying the mutations this plant is carrying."
        ;; FIXME: amount of water should differ
        (when (> water SETTINGS.water-to-spawn)
          (tset plant :water 0)
          (spawn-mutant plant carrying))))
; }}}

; {{{ INTERACTIONS
(fn take-code! [from]
  "Takes a piece of code from from, if we're not already
  carrying it or full."
  (when (< (length carrying) player.carry-slots)
    (let [code (rand-nth from.code)]
      (when (not (contains? just-picked-up code))
        (trace (.. "picked up code "
                   (fennel.view code)))
        (append! just-picked-up code)))))

(fn drop-code! [to]
  "Drops a piece of code we're carrying on to.  Has no
  effect on to if to is already carrying that code."
  (when (> (length carrying) 0)
    (let [code (rand-remove-nth! carrying)]
      (trace (.. "dropped code "
                 (fennel.view code)))
      (when (not (contains? to.carrying code))
        (append! to.carrying code)))))

(fn handle-intersection [current-intersectee]
  (if
    (and intersected-with
         (= intersected-with
            current-intersectee))
    (do
      (inc! frames-intersected)
      (when (= 0 (% frames-intersected
                  SETTINGS.frames-to-drop))
        (drop-code! current-intersectee)
        (take-code! current-intersectee)))

    (= current-intersectee nil)
    (do
      (set frames-intersected 0)
      (set intersected-with nil)
      (table.move
        just-picked-up 1 (length just-picked-up)
        (+ 1 (length carrying)) carrying)
      (set just-picked-up []))

    (do
      (set frames-intersected 1)
      (set intersected-with current-intersectee)
      (trace (string.format
               "intersected %s"
               (fennel.view current-intersectee))))))

(fn plant! [plant plot]
  "Plants plant in plot, unless there's something there."
  (when (not (. plants plot))
    (tset plants plot plant)
    (tset plant :plot plot)))

(fn do-spawning-cycle! []
  (each [plot plant (pairs plants)]
    (when (not= seconds-elapsed plant.born)
      (let [spawned (plant:spawn)]
        (when spawned
          (let [new-plot
                (%wrap (+ plot (- 2 (math.random 0 4)))
                       SETTINGS.num-plots)]
            (plant! spawned new-plot)))))))
; }}}

; {{{ RAIN
(fn spawn-raindrop! [cloud-width]
  (let [loc (+ (screen-x->world-x x)
               (math.random cloud-width) -1)]
    (when (not (. raindrops loc))
      (tset raindrops loc (- 136 (+ y 12))))))

(fn make-it-rain! []
  (match player
    {:rain true :width width}
    (for [i 1 SETTINGS.rain-per-frame]
      (spawn-raindrop! width))))

(fn advance-rain! []
  "Advance the falling of rain."
  (each [loc height (pairs raindrops)]
    (if (> height 0) (tset raindrops loc (- height 2))
      (let [receiving-plot
            (%wrap
              (+ 1 (// loc SETTINGS.plot-width))
              SETTINGS.num-plots)

            receiving-plant
            (. plants receiving-plot)]
        (tset raindrops loc nil)
        (when receiving-plant
          (inc! receiving-plant.water))))))

(fn draw-rain []
  (each [loc height (pairs raindrops)]
    (let [x (world-x->screen-x loc)
          y (- 136 height)]
      (pix x y COLORS.rain)
      (pix x (+ y 1) COLORS.rain))))
; }}}

; {{{ GAME TIME MANAGEMENT
(fn update-clock! []
  "Calculates and sets all of the game clock-related
  state."

  (set seconds-elapsed
       (+ CONST.game-start-seconds
          (// (time) SETTINGS.ms-per-second)))
  (set days-elapsed
       (/ seconds-elapsed CONST.seconds-per-day))

  (let [minutes-elapsed (// seconds-elapsed 60)
        hours-elapsed (// minutes-elapsed 60)]
    (set clock-time [(% hours-elapsed 24)
                     (% minutes-elapsed 60)]))

  (set fraction-past-midday
       (/ (% (- seconds-elapsed CONST.seconds-at-midday)
             CONST.seconds-per-day)
          CONST.seconds-per-day))

  ;; at sunset, x=scrn y=3/4
  ;; at noon, x=scrn/2 y=0
  ;; at sunrise x=0 y=3/4
  ;; sunrise = 06:30, sunset = 18:30
  ;; 0% through day === midday === 12:30
  (let [sun-x (+ 120
                 (* 140 (math.cos
                          (+ (/ math.pi 2)
                             (* math.pi 2
                                fraction-past-midday)))))
        sun-y (- 136
                 (* 136 (math.sin
                          (+ (/ math.pi 2)
                             (* math.pi 2
                                fraction-past-midday)))))]
    (set sun-position [sun-x sun-y])
    (set amount-of-light
         (clamp 0 1 (/ (- 170 sun-y) 80)))))
; }}}

; {{{ THE SKY AND STUFF
(macro set-color-range! [color-name midday-color]
  "Sets color-name to a version of midday-color color,
  adjusted for the amount of available sunlight."

  (fn split-colors [color]
    "Turns a 24-bit color value into three 8-bit
    single-color values."
    (values (band 0xff (rshift color 16))
            (band 0xff (rshift color 8))
            (band 0xff color)))

  (let [(day-r day-g day-b) (split-colors midday-color)
        mod-r (* 0.7 day-r)
        mod-g (* 0.5 day-g)
        mod-b (* 0.3 day-b)]
    ; FIXME: this probably doesn't need to be so hideous.
    `(set-color!
       ,color-name
       [(if
          (> amount-of-light 0.3)
          (math.min
            0xff
            (+ ,day-r
               (* ,mod-r (- 1 amount-of-light))))
          ; amount-of-light <= 0.3
          (- ,day-r
             (* ,mod-r
                (/ (- 0.35 amount-of-light) 0.35))))
        (- ,day-g (* ,mod-g (- 1 amount-of-light)))
        (- ,day-b (* ,mod-b (- 1 amount-of-light)))])))

(fn adjust-colors! []
  (set-color-range! :sun            0xffcd75)
  (set-color-range! :stem           0x5ec788)
  (set-color-range! :cloud          0xfefff7)
  (set-color-range! :cloud-2        0xcdebeb)
  (set-color-range! :rain           0x618cba)
  (set-color-range! :butterfly-body 0xffcd75)
  (set-color-range! :butterfly-eye  0x333c57)
  (set-color-range! 8               0xfbc546)
  (set-color-range! 9               0xf46006)
  (set-color-range! 10              0x7b118b)
  (set-color-range! 11              0xc0e5d5)
  (set-color-range! 12              0xf4659a)
  (set-color-range! 13              0x02aacf)
  (set-color-range! 14              0x9d274c)
  (set-color-range! 15              0xe8094a))

(fn draw-sun []
  (let [[x y] sun-position]
    (circ x y 20 COLORS.sun)))

(fn _G.SCN [line]
  (poke COLOR_ADDR.sky
        (// (* amount-of-light (// line 2)) 1))
  (poke (+ 1 COLOR_ADDR.sky)
        (// (* amount-of-light line) 1))
  (poke (+ 2 COLOR_ADDR.sky)
        (// (* (math.max 0.3 amount-of-light)
               (+ 120 line)) 1)))
; }}}

; {{{ THE PLAYER
(fn draw-player []
  (match player
    {:name :butterfly}
    (spr
      (if intersected-with 0
        (* 2 (// (% seconds-elapsed 2500) 1250)))
      x y
      COLORS.transparent 1
      (if (= direction :right) 0 1)
      (if intersected-with 3 0)
      2 2)

    {:name :cloud}
    (do
      (spr 4 x y COLORS.transparent 1 0 0 2 2)
      (spr 4 (+ x 16) y COLORS.transparent 1 1 0 2 2)
      (spr 4 (+ x 27) y COLORS.transparent 1 1 0 2 2))))

(fn switch-player-type! []
  (let [current-width player.width]
    (set player-type
         (%wrap (+ player-type 1)
                (length CONST.player-types)))
    (set player (. CONST.player-types player-type))
    (set x (+ x (// (- current-width player.width) 2)))))
; }}}

; {{{ RUN LOOP STUFF
(fn handle-input! []
  ;; move up
  (when (btn 0) (set y (- y 1)))
  ;; move down
  (when (btn 1) (set y (+ y 1)))
  ;; move left
  (when (btn 2)
    (set x (- x 1))
    (set direction :left))
  ;; move right
  (when (btn 3)
    (set x (+ x 1))
    (set direction :right))

  ;; A: make it rain
  (when (or (btn 4) (key 48))
    (make-it-rain!))

  ;; X: switch player type
  (when (or (btnp 7) (keyp 50))
    (switch-player-type!)))
; }}}

; {{{ GAME INITIALIZATION
(fn init! []
  (local proto-plant
    (make-plant
      {:max-height 6}))

  (local mutations [])
  (for [i 1 20]
    (let [field (rand-nth [:color
                           :flower-size
                           :max-height
                           :petals])

          modifier (rand-nth [(deval #(+ $ 2))
                              (deval #(- $ 1))
                              (deval #(+ $ 1))
                              (deval #(* $ 2))
                              (deval #(// $ 2))])

          mutation (list (sym :modify!)
                         field
                         modifier)]
      (append! mutations mutation)))

  (each [_ shape (ipairs CONST.petal-shapes)]
    (append! mutations
             (list (sym :modify!)
                   :petal-shape
                   (list (sym :hashfn) shape))))

  (set plants [])
  (for [plot-group 1
        (math.ceil (/ SETTINGS.num-plots
                      SETTINGS.plot-grp-size))]
    (let [plot-offset (* SETTINGS.plot-grp-size
                         (- plot-group 1))
          plot (+ (math.random SETTINGS.plot-grp-size)
                  plot-offset)
          plant (spawn-mutant
                  proto-plant
                  [(rand-nth mutations)
                   (rand-nth mutations)
                   (rand-nth mutations)
                   (rand-nth mutations)])]
      ; Randomize birth time so that initial plants
      ; don't all die at the same time.
      (tset plant :born (- (math.random
                             1 (// plant.lifespan 3))))
      (plant! plant plot)))

  (set carrying [])
  (set raindrops []))
; }}}

(poke 0x03FF8 COLORS.white)
(init!)
(fn _G.TIC []
  (update-clock!)
  (adjust-colors!)

  (cls COLORS.sky)
  (draw-sun)

  (handle-input!)

  (when (> (+ x player.width SETTINGS.x-shift-buffer) 240)
    (set x (- 240 SETTINGS.x-shift-buffer player.width))
    (set x-shift (% (+ x-shift 1)
                    CONST.world-max-x)))

  (when (< x SETTINGS.x-shift-buffer)
    (set x SETTINGS.x-shift-buffer)
    (set x-shift (% (- x-shift 1)
                    CONST.world-max-x)))

  (set y (clamp 0 136 y))

  (when player.carry-slots
    ;; TODO: plants only use the box start coordinate
    ;; to determine intersection, so a lot of this is
    ;; unnecessary.
    (let [box-width 2
          box-height 2

          box-start-x (+ x (if (= direction :right) 10 4))
          box-start-y (+ y 10)

          player-box [box-start-x box-start-y
                      (+ box-start-x box-width)
                      (+ box-start-y box-height)]]
      (var intersected-this-frame? false)
      (each [_ plant (pairs plants)]
        (when (plant:intersects? player-box)
          (set intersected-this-frame? true)
          (handle-intersection plant)))
      (when (not intersected-this-frame?)
        (handle-intersection nil))
      (when SETTINGS.dbg-boxes
        (rectb box-start-x box-start-y
               box-width box-height
               (if intersected-this-frame? 12 2))))

    (for [i 1 player.carry-slots]
      (print "carrying"
             (+ 3 (* player.carry-slots 6)) 1
             COLORS.gray false 1 true)
      (let [draw (if (<= i (length carrying))
                   circ circb)]
        (draw (+ 3 (* (- i 1) 6)) 3 2 COLORS.gray)))

    (when intersected-with
      (print "picked up"
             (+ 3 (* player.carry-slots 6)) 7
             COLORS.gray false 1 true)
      (for [i 0 (- player.carry-slots (length carrying))]
        (let [draw (if (<= i (length just-picked-up))
                     circ circb)]
          (draw (+ 3 (* (- i 1) 6)) 9 2 COLORS.gray)))))

  (each [plot plant (pairs plants)]
    (plant:grow!)
    (plant:draw)

    (when (plant:dead?)
      (tset plants plot nil)))

  (do-spawning-cycle!)

  (advance-rain!)
  (draw-rain)

  (draw-player)

  (print (string.format
           "%02d:%02d"
           (table.unpack clock-time))
         (- 240 (* 5 6)) 1 COLORS.gray true))

;; <TILES>
;; 000:0000000000dddd000dddddd0dddddddddddddddd0ddddddd0ddddddd00dddddd
;; 001:00ddd0000dddddd0ddddddddddddddddddddddd0ddddddd0dddddd00ddddd000
;; 004:0000000000000000000000440000044400044443004444330444433304444333
;; 005:0000000044444400444444404333344433333344333333343333333333333333
;; 016:00dddddd000ddddd0666dddd0006666600000000000000000000000000000000
;; 017:ddddd000dddd0000ddd667606666660000000000000000000000000000000000
;; 018:0000000000666666066ddddd00dddddd0ddddddddddddddd0dddddd000ddd000
;; 019:0000000066666760dddd6660ddddd000dddddd00ddddddd0dddddd0000ddd000
;; 020:4444333344433333444333334444333304443333004443330000444300000000
;; 021:3333333333333333333333333333333333333333333333333333334400000000
;; </TILES>

;; <WAVES>
;; 000:00000000ffffffff00000000ffffffff
;; 001:0123456789abcdeffedcba9876543210
;; 002:0123456789abcdef0123456789abcdef
;; </WAVES>

;; <SFX>
;; 000:000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000304000000000
;; </SFX>

;; <PALETTE>
;; 000:1a1c2cef7d5738b764f4f4f494b0c241a6f6ffcd75333c575d275db13e53a7f07025717929366f3b5dc973eff7566c86
;; 001:1a1c2c5d275db13e53ef7d57ffcd75a7f07038b76425717929366f3b5dc941a6f673eff7f4f4f494b0c2566c86333c57
;; </PALETTE>