path: root/lib/game.fnl

(local state (require :lib.state))
(local cell (require :lib.cell))
(local cells (require :lib.cells))
(local vec (require :lib.vec))
(local entity (require :lib.entity))
(local player (require :lib.player))
(local transition (require :lib.transition))
(local fv (require :fennel.view))
(local music-state (require :lib.music-state))

(fn lerp* [a b c d x]
  (+ c (* (/ (- x a) (- b a)) (- d c))))

(fn new-grid [w h f]
  (var t {})
  (for [x 0 (- w 1)]
    (tset t x {})
    (for [y 0 (- h 1)]
      (tset (. t x) y (f x y))))
  t)

(fn update [self]
  (set music-state.screen :game)
  ;; (set ship-pos.x (+ self.ship.x 0.02))
  ;; (set ship-pos.y (+ self.ship.y 0.005))
  (var grid-alive? true)
  (set self.radius (lerp* 0 1 self.radius self.target-radius 0.3))

  (when (= self.tick 0)
    (set grid-alive? false)
    (set music-state.fire 0)
    (set music-state.alive 0)
    (for [x 0 (- self.width 1)]
      (for [y 0 (- self.height 1)]
        (fn get [v]
          (. self.grid
             (% (+ v.x x) self.width)
             (% (+ v.y y) self.height)))
        (if (. self.grid x y)
            ;; check if alive
            (do
              (tset self.grid-alt x y (cell.update (. self.grid x y)
                                                 get))
              (set grid-alive? true)
              (set music-state.alive (+ music-state.alive 1)))
            ;; check for neighbors and then use one at random
            (do
              (var neighbors [])
              (for [x -1 1]
                (for [y -1 1]
                  (table.insert neighbors (get {: x : y}))))
              (if (. neighbors 1)
                  (tset self.grid-alt x y
                        (cell.birth (. neighbors (math.random (length neighbors))) get))
                  (tset self.grid-alt x y nil))))))
    (set (self.grid self.grid-alt) (values self.grid-alt self.grid)))
  (set self.tick (% (+ self.tick 1) self.rate))
  ;; player steering
  (when self.entities.player
    (entity.steer self.entities.player
                  self
                  :player
                  {:up (love.keyboard.isDown :up)
                   :right (love.keyboard.isDown :right)
                   :left (love.keyboard.isDown :left)
                   :shoot (love.keyboard.isDown :z)
                   }))
  ;; entities
  (each [id e (pairs self.entities)]
    (tset e entity.position (vec.wrap
                              (vec.add (entity.position e) (entity.velocity e))
                              {:x self.width :y self.height}))
    (let [x (math.floor (. e entity.position :x))
          y (math.floor (. e entity.position :y))
          t (. self.grid x y)]
      (when t
        (entity.collide e self id x y)))
    (when (entity.duration e)
      (tset e entity.duration (- (entity.duration e) 1))
      (if (= (entity.duration e) 0)
          (tset self.entities id nil))))
  ;; TODO: we should do this for only the first death frame
  (if self.pause
      (do
        (set self.pause nil)
        (state.init transition
                    :pause
                    self
                    self))
      (not self.entities.player)
      ;; TODO: new game
      (state.init transition
                  :death
                  self
                  ((. (getmetatable self) :inner-init)
                   (getmetatable self) (if (> self.level 0) 1 0) self)
                  self.level)
      (not grid-alive?)
      (state.init transition
                  :win
                  self
                  ((. (getmetatable self) :inner-init)
                   (getmetatable self) (+ self.level 1) self)
                  self.level)
      true
      nil))

(fn id [x] x)

(fn draw [self]
  (local (width height) (love.graphics.getDimensions))
  ;; (love.graphics.scale width height)
  (let [ship-pos (if self.entities.player
                     (entity.position self.entities.player)
                     self.ship-pos)
        camera-size (math.min width height)
        radius-x (* self.radius (/ width camera-size))
        radius-y (* self.radius (/ height camera-size))
        clipped-x (math.min radius-x self.max-radius)
        clipped-y (math.min radius-y self.max-radius)
        display-a {:x (* width (- 1 (/ clipped-x radius-x)) 0.5)
                   :y (* height (- 1 (/ clipped-y radius-y)) 0.5)}
        display-b {:x (- width display-a.x) :y (- height display-a.y)}
        display-size (vec.sub display-b display-a)
        ;; these are used to "wrap around" various entities so that they
        ;; always render in their proper position relative to the ship, even
        ;; over random edges. feels a bit hacky though
        camera-a-full {:x (- ship-pos.x (/ self.width 2))
                       :y (- ship-pos.y (/ self.height 2))}
        camera-b-full {:x (+ ship-pos.x (/ self.width 2))
                       :y (+ ship-pos.y (/ self.height 2))}
        camera-a {:x (- ship-pos.x clipped-x)
                  :y (- ship-pos.y clipped-y)}
        camera-b {:x (+ ship-pos.x clipped-x)
                  :y (+ ship-pos.y clipped-y)}
        cell-box (vec.lerp {:x 0 :y 0}
                            {:x (* 2 clipped-x)
                             :y (* 2 clipped-y)}
                            ;; TODO: this is wrong
                            {:x 0 :y 0}
                            display-size
                            {:x 1 :y 1})]
    ;; TODO: this is ugly and weird
    (set self.ship-pos ship-pos)
    (love.graphics.setScissor (- display-a.x 1) (- display-a.y 1)
                              (- display-b.x display-a.x -2)
                              (- display-b.y display-a.y -2))
    (love.graphics.setColor 0.2 0.2 0.2)
    (love.graphics.setLineWidth 4)
    (love.graphics.rectangle :line
                             display-a.x display-a.y
                             (- display-b.x display-a.x)
                             (- display-b.y display-a.y))
    (love.graphics.setScissor display-a.x display-a.y
                              (- display-b.x display-a.x)
                              (- display-b.y display-a.y))
    (love.graphics.clear)
    (for [x (math.floor camera-a.x) (math.floor camera-b.x)]
      (for [y (math.floor camera-a.y) (math.floor camera-b.y)]
        (let [pos {:x (% x self.width) :y (% y self.height)}
              render-a (vec.lerp camera-a camera-b display-a display-b
                                  {: x : y})
              render-b (vec.lerp camera-a camera-b display-a display-b
                                  {:x (+ x 1) :y (+ y 1)})
              the (. self.grid pos.x pos.y)
              color (and the (cell.color the))]
          (when color
            (love.graphics.setColor (unpack color))
            (love.graphics.rectangle :fill
                                     (id render-a.x)
                                     (id render-a.y)
                                     (id cell-box.x)
                                     (id cell-box.y))))))
    ;; draw other stuff
    (each [id v (pairs self.entities)]
      (love.graphics.push)
      (let [pos (entity.position v)
            render-pos (vec.lerp camera-a camera-b display-a display-b
                                 (vec.add camera-a-full
                                          (vec.wrap (vec.sub pos camera-a-full)
                                                    (vec.sub camera-b-full camera-a-full))))]
        (love.graphics.translate render-pos.x render-pos.y)
        (love.graphics.scale cell-box.x
                             cell-box.y))
      (entity.draw v self id)
      (love.graphics.pop))
    ))
    ;; (love.graphics.setLineWidth 0.1)
    ;; (love.graphics.line 0 0 0.3 0.3)
    ;; (love.graphics.polygon :line 0.3 0.3 0.6 0.3 0.4 0.6)
    ;; (love.graphics.line 0.4 0.8 0.4 0.8)
    ;; (love.graphics.print :Gaming))

(fn keypressed [self key scancode repeat]
  (when (= key "escape")
    (set self.pause true))
  (when (= key "=")
    (set self.target-radius
         (math.max
           self.min-radius
           (math.min
             self.max-radius
             (- self.target-radius 4)))))
  (when (= key "-")
    (set self.target-radius
         (math.max
           self.min-radius
           (math.min
             self.max-radius
             (+ self.target-radius 4))))))

(fn make-level [level width height]
  (if (= level 0)
      (new-grid width height
                #(if (or (and (= $2 61) (or (= $1 61) (= $1 62) (= $1 63)))
                         (and (= $2 62) (= $1 61))
                         (and (= $2 63) (= $1 62)))
                     (cell.init cells.life)
                     nil))
      true
      (new-grid width height
                #(if (= (math.random 6) 1)
                     (if (> $1 44)
                         (cell.init cells.life)
                         (< $1 10)
                         (cell.init cells.brain)
                         nil)
                     nil))))

(fn inner-init [self level past]
  (let [past (or past {})
        width 64
        height 64]
    (setmetatable
      {:width width
       :height height
       :radius (or past.radius 32)
       :target-radius (or past.radius 32)
       :max-radius (/ (math.min height width) 2)
       :min-radius 16
       :level level
       :tick 0
       :rate 6
       :ship-pos {:x 31.5 :y 31.5}
       :entities (if (= level -1)
                     {}
                     {:player (entity.init player {:x 31.5 :y 31.5})})
       :grid (make-level level width height)
       :grid-alt (new-grid width height #nil)
       }
      self)))

;; what the hell
(fn init [self]
  (state.init transition
              :menu
              (self.inner-init self -1)
              (self.inner-init self 0)))

{: inner-init state.draw draw state.init init state.update update state.keypressed keypressed}