Initial bounce and slimeball implementation

5 files changed, 142 insertions, 163 deletions

diff --git a/art/slimeball.png b/art/slimeball.png
new file mode 100644
index 0000000..c270322
--- /dev/null
+++ b/art/slimeball.png
diff --git a/game.fnl b/game.fnl
index cbe3b57..4dfa9c4 100644
--- a/game.fnl
+++ b/game.fnl
@@ -17,143 +17,9 @@
 
 (local camera (require :camera))
 (local player (require :player))
+(local slimeball (require :slimeball))
 (local world (require :world))
 
-;; (local camera (camera.new 0 0))
-;; (local player (player.new 128 128))
-;; (local world (map.load "sandbox"))
-;; (local collision-map (make-collision-map player (. world :tiles)))
-
-
-;; (var fade-in-alpha 1)
-
-;; (fn draw [message]
-;;   (love.graphics.clear 1 1 1)
-;;   (draw-tiles (. world :tiles) (. camera :x-pos) (. camera :y-pos))
-;;   (let [x (- (. player :x-pos) (. camera :x-pos))
-;;         y (- (. player :y-pos) (. camera :y-pos))
-;;         animation-offset (. player-animations (. player :animation) :offset)]
-;;     (draw-sprite player-sheet
-;;                  animation-offset
-;;                  (. player :frame)
-;;                  (. player :orientation)
-;;                  x
-;;                  y))
-;;   (love.graphics.print (string.format "%d/%d" (. world :surfaces-slimed)
-;;                                       (. world :surfaces-total))
-;;                        0 0)
-
-;;   (when (< 0 fade-in-alpha)
-;;     (love.graphics.setColor 0 0 0 fade-in-alpha)
-;;     (love.graphics.rectangle "fill" 0 0 screen-width screen-height)
-;;     (set fade-in-alpha (- fade-in-alpha 0.01))))
-
-
-;; (fn update [dt set-mode]
-;;   
-;;   (local camera-lock-goal-x (math.floor (- (/ screen-width 2)
-;;                                            (/ (. player-sheet :width) 2))))
-;;   (local camera-lock-goal-y (math.floor (- (/ screen-height 2)
-;;                                            (/ (. player-sheet :height) 2))))
-;;   ;; Update animations.
-;;   (tset player :frame-timer (- (. player :frame-timer) 1))
-;;   (when (= 0 (. player :frame-timer))
-;;     (tset player :frame-timer (. player :frame-delay))
-;;     (tset player :frame (+ 1 (. player :frame)))
-;;     (when (<= (. player-animations (. player :animation) :frames) (. player :frame))
-;;       (tset player :frame 0)))
-
-;;   ;; Update camera.
-;;   (tset camera :x-pos (lume.lerp (. camera :x-pos)
-;;                                  (- (. player :x-pos) camera-lock-goal-x) (* 4 dt)))
-;;   (tset camera :y-pos (lume.lerp (. camera :y-pos)
-;;                                  (- (. player :y-pos) camera-lock-goal-x) (* 4 dt)))
-
-;;   ;; Lock camera so that it doesn't go out of bounds.
-;;   (when (> 0 (. camera :x-pos))
-;;     (tset camera :x-pos 0))
-
-;;   (when (> 0 (. camera :y-pos))
-;;     (tset camera :y-pos 0))
-
-;;   (let [max-x (- (* (. map :tiles :width) (. world :width)) screen-width)]
-;;     (when (>= (. camera :x-pos) max-x)
-;;       (tset camera :x-pos max-x)))
-
-;;   (let [max-y (- (* (. map :tiles :height) (. world :height)) screen-height)]
-;;     (when (>= (. camera :y-pos) max-y)
-;;       (tset camera :y-pos max-y)))
-
-;;   ;; Update the the player's velocities to reflect controls.
-;;   (let [goal-x-vel (if (. player :action :right) (. player :goal-x-vel)
-;;                        (. player :action :left) (- (. player :goal-x-vel))
-;;                        0)]
-;;     (tset player :x-vel (lume.lerp (. player :x-vel) goal-x-vel dt)))
-
-;;   (when (and (. player :action :jump) (. player :grounded))
-;;     (tset player :y-vel (- (. player :y-vel) (. player :goal-y-vel))))
-
-;;   ;; Update the y-velocity to reflect gravity.
-;;   (if (and (. player :grounded) (not (. player :action :jump)))
-;;       (tset player :y-vel 0)
-;;       (tset player :y-vel (+ (. player :y-vel) (* gravity dt))))
-
-;;   ;; Perform collision detection and update the player's position accordingly.
-;;   (let [goal-x (+ (. player :x-pos) (* dt (. player :x-vel)))
-;;         goal-y (+ (. player :y-pos) (* dt (. player :y-vel)))]
-;;     (let [(x y collisions length) (: collision-map :move player goal-x goal-y)]
-;;       (tset player :x-pos x)
-;;       (tset player :y-pos y)
-
-;;       (tset player :grounded false)
-;;       (each [_ collision (ipairs collisions)]
-;;         (let [tile (. collision :other)]
-;;           ;; Touching top.
-;;           (when (> 0 (. collision :normal :y))
-;;             (tset player :grounded true)
-;;             (when (not (. tile :slimed :top))
-;;               (tset world :surfaces-slimed (+ 1 (. world :surfaces-slimed)))
-;;               (tset tile :slimed :top true)))
-
-;;           ;; Touching bottom.
-;;           (when (< 0 (. collision :normal :y))
-;;             (when (not (. tile :slimed :bottom))
-;;               (tset world :surfaces-slimed (+ 1 (. world :surfaces-slimed)))
-;;               (tset tile :slimed :bottom true)))
-
-;;           ;; Touching left.
-;;           (when (> 0 (. collision :normal :x))
-;;             (when (not (. tile :slimed :left))
-;;               (tset world :surfaces-slimed (+ 1 (. world :surfaces-slimed)))
-;;               (tset tile :slimed :left true)))
-
-;;           ;; Touching right.
-;;           (when (< 0 (. collision :normal :x))
-;;             (when (not (. tile :slimed :right))
-;;               (tset world :surfaces-slimed (+ 1 (. world :surfaces-slimed)))
-;;               (tset tile :slimed :right true))))))))
-
-
-;; (fn keypressed [key set-mode]
-;;   (when (= key "right")
-;;     (player-turn-right player))
-
-;;   (when (= key "left")
-;;     (player-turn-left player))
-
-;;   (when (= key "z")
-;;     (tset player :action :jump true)))
-
-;; (fn keyreleased [key set-mode]
-;;   (when (= key "right")
-;;     (tset player :action :right false))
-
-;;   (when (= key "left")
-;;     (tset player :action :left false))
-
-;;   (when (= key "z")
-;;     (tset player :action :jump false)))
-
 (local current-player (player.new))
 (local current-world (world.new "sandbox" current-player))
 (local current-camera (camera.new current-world screen-width screen-height))
@@ -172,6 +38,8 @@
     (tset current-camera :y-pos camera-y)))
 
 (fn keypressed [key set-mode]
+  (when (= key "x")
+    (: current-world :add-slimeball (slimeball.new current-player)))
   (let [method (if (= key "right") :move-right
                    (= key "left") :move-left
                    (= key "z") :jump)]
diff --git a/player.fnl b/player.fnl
index 0a1bf1f..013000a 100644
--- a/player.fnl
+++ b/player.fnl
@@ -71,6 +71,10 @@
   (when (> 10 (math.abs (. player :y-vel)))
     (tset player :y-vel (- (. player :goal-y-vel)))))
 
+(fn bounce [player x-normal y-normal]
+  (tset player :x-vel (- (* 8 x-normal) (. player :x-vel)))
+  (tset player :y-vel (- (math.abs (* 8 y-normal)) (. player :y-vel))))
+
 (local player-sheet
        {:img (love.graphics.newImage "art/swanky.png")
         :orientation-offset 128
@@ -159,6 +163,7 @@
    :move-left move-left
    :stop-left stop-left
    :jump jump
+   :bounce bounce
 
    :draw draw-player
    :update update-player-animations})
diff --git a/slimeball.fnl b/slimeball.fnl
new file mode 100644
index 0000000..7243aba
--- /dev/null
+++ b/slimeball.fnl
@@ -0,0 +1,61 @@
+;;;; Copyright (C) 2018 Jakob L. Kreuze, All Rights Reserved.
+;;;;
+;;;; This file is part of slime-the-world.
+;;;;
+;;;; slime-the-world is free software: you can redistribute it and/or modify it
+;;;; under the terms of the GNU General Public License as published by the Free
+;;;; Software Foundation, either version 3 of the License, or (at your option)
+;;;; any later version.
+;;;;
+;;;; slime-the-world is distributed in the hope that it will be useful, but
+;;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+;;;; more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License along
+;;;; with slime-the-world. If not, see <http://www.gnu.org/licenses/>.
+
+(local draw (require :draw))
+
+(local gravity 128)
+
+(local slimeball-sheet
+       {:img (love.graphics.newImage "art/slimeball.png")
+        :width 16 :height 16
+        :padding-x 0 :padding-y 0})
+
+(fn draw-slimeball [slimeball x y]
+  (draw.tile x y slimeball-sheet 0 0))
+
+(fn update-slimeball [slimeball dt]
+  (tset slimeball :y-vel (+ (. slimeball :y-vel) (* gravity dt))))
+
+(fn next-position [slimeball dt]
+  (values 
+   (+ (. slimeball :x-pos) (* (. slimeball :x-vel) dt))
+   (+ (. slimeball :y-pos) (* (. slimeball :y-vel) dt))))
+
+(fn new-slimeball [player]
+  (let [player-x (. player :x-pos)
+        player-y (. player :y-pos)
+        player-width (. player :width)
+        player-height (. player :height)
+        orientation (. player :orientation)]
+    {:is-slimeball true
+
+     :width (. slimeball-sheet :width)
+     :height (. slimeball-sheet :height)
+
+     :x-pos (if (= :right orientation)
+                (+ player-x player-width)
+                (- player-x player-width))
+     :y-pos player-y
+
+     :x-vel (if (= :right orientation) 128 (- 128))
+     :y-vel 0
+
+     :next-position next-position
+     :update update-slimeball
+     :draw draw-slimeball}))
+
+{:new new-slimeball}
diff --git a/world.fnl b/world.fnl
index f4a9cce..a43eb95 100644
--- a/world.fnl
+++ b/world.fnl
@@ -101,15 +101,19 @@
     (love.graphics.print health-msg 0 (- screen-height (* 2 font-height)))
     (love.graphics.print slime-msg 0 (- screen-height font-height))))
 
+(fn draw-object [object camera-x camera-y]
+  (let [x-pos (. object :x-pos)
+        y-pos (. object :y-pos)
+        x (- x-pos camera-x)
+        y (- y-pos camera-y)]
+    (: object :draw x y)))
+
 (fn draw-world [world camera-x camera-y screen-width screen-height]
   (love.graphics.clear 0.1 0.1 0.1)
   (draw-map world camera-x camera-y screen-width screen-height)
-  (let [player (. world :player)
-        player-x (. player :x-pos)
-        player-y (. player :y-pos)
-        x (- player-x camera-x)
-        y (- player-y camera-y)]
-    (: player :draw x y))
+  (draw-object (. world :player) camera-x camera-y)
+  (each [_ slimeball (ipairs (. world :slimeballs))]
+    (draw-object slimeball camera-x camera-y))
   (draw-hud world screen-width screen-height))
 
 ;; Returns whether or not `tile' exists in `checked'.
@@ -177,12 +181,12 @@
     (when seed
       (count-surfaces-recur world seed []))))
 
-(fn add-player-to-collision-map [collision-map player]
-  (let [x (. player :x-pos)
-        y (. player :y-pos)
-        width (. player :width)
-        height (. player :height)]
-    (: collision-map :add player x y width height)))
+(fn add-object-to-collision-map [collision-map object]
+  (let [x (. object :x-pos)
+        y (. object :y-pos)
+        width (. object :width)
+        height (. object :height)]
+    (: collision-map :add object x y width height)))
 
 (fn add-tile-to-collision-map [collision-map tile]
   (let [x (. tile :x-pos)
@@ -196,7 +200,7 @@
   (let [collision-map (bump.newWorld 32)
         width (. world :width)
         height (. world :height)]
-    (add-player-to-collision-map collision-map player)
+    (add-object-to-collision-map collision-map player)
     (for [x 0 (- width 1)]
       (for [y 0 (- height 1)]
         (let [tile (tile-at world x y)]
@@ -207,7 +211,9 @@
 ;; Creates a new tile object of the given `type-type' positioned at world
 ;; coordinates (`x', `y').
 (fn new-tile [tile-type x y]
-  {:width (. tile-sheet :width)
+  {:is-tile true
+
+   :width (. tile-sheet :width)
    :height (. tile-sheet :height)
 
    :x-pos x
@@ -259,36 +265,73 @@
       (tset world :surfaces-slimed (+ 1 surfaces-slimed))
       (tset tile :slimed orientation true))))
 
+(fn move-slimeball [world slimeball dt]
+  (let [collision-map (. world :collision-map)
+        (goal-x goal-y) (: slimeball :next-position dt)
+        filter (fn [] "cross")
+        (x y collisions _) (: collision-map :move slimeball goal-x goal-y filter)]
+    (each [_ collision (ipairs collisions)]
+      (let [other (. collision :other)
+            x-normal (. collision :normal :x)
+            y-normal (. collision :normal :y)]
+        (when (. other :is-tile)
+          (if (> 0 y-normal) (slime-tile world other :top)
+              (< 0 y-normal) (slime-tile world other :bottom)
+              (> 0 x-normal) (slime-tile world other :left)
+              (< 0 x-normal) (slime-tile world other :right))
+
+          (for [i 1 (# (. world :slimeballs))]
+            (when (= slimeball (. (. world :slimeballs) i))
+              (table.remove (. world :slimeballs) i))))))
+    (tset slimeball :x-pos x)
+    (tset slimeball :y-pos y)))
+
 (fn update-world [world dt]
   (let [player (. world :player)
+        slimeballs (. world :slimeballs)
         collision-map (. world :collision-map)
         (goal-x goal-y) (: player :next-position dt)
-        (x y collisions _) (: collision-map :move player goal-x goal-y)]
+        filter (fn [_ other] (if (. other :is-tile) "slide" "cross"))
+        (x y collisions _) (: collision-map :move player goal-x goal-y filter)]
+    (each [_ slimeball (ipairs slimeballs)]
+      (move-slimeball world slimeball dt)
+      (: slimeball :update dt))
+
     (tset player :x-pos x)
     (tset player :y-pos y)
 
     (tset player :grounded false)
     (each [_ collision (ipairs collisions)]
-      ;; Touching top of surface.
-      (when (> 0 (. collision :normal :y))
-        (tset player :grounded true)
-        (slime-tile world (. collision :other) :top))
+      (let [other (. collision :other)
+            x-normal (. collision :normal :x)
+            y-normal (. collision :normal :y)]
+        (when (. other :is-tile)
+          ;; Touching top of surface.
+          (when (> 0 y-normal)
+            (tset player :grounded true)
+            (slime-tile world other :top))
 
-      ;; Touching bottom of surface.
-      (when (< 0 (. collision :normal :y))
-        (slime-tile world (. collision :other) :bottom))
+          ;; Touching bottom of surface.
+          (when (< 0 y-normal)
+            (slime-tile world other :bottom))
 
-      ;; Touching left of surface.
-      (when (> 0 (. collision :normal :x))
-        (slime-tile world (. collision :other) :left))
+          ;; Touching left of surface.
+          (when (> 0 x-normal)
+            (slime-tile world other :left)
+            (: player :bounce x-normal y-normal))
 
-      ;; Touching right of surface.
-      (when (< 0 (. collision :normal :x))
-        (slime-tile world (. collision :other) :right)))
+          ;; Touching right of surface.
+          (when (< 0 x-normal)
+            (slime-tile world other :right)
+            (: player :bounce x-normal y-normal)))))
 
     (tset player :x-vel (: player :next-x-vel dt))
     (tset player :y-vel (: player :next-y-vel dt))))
 
+(fn add-slimeball [world slimeball]
+  (table.insert (. world :slimeballs) slimeball)
+  (add-object-to-collision-map (. world :collision-map) slimeball))
+
 ;; Loads the map of the given name into a new world containing `player'. Will
 ;; error out if either 'maps/${name}.png' or 'maps/${name}.fnl' do not exist.
 (fn new-world [name player]
@@ -296,10 +339,12 @@
         meta-path (.. "maps/" name ".fnl")
         res (load-tiles (love.image.newImageData tiles-path))
         res (lume.extend res {:player player})
+        res (lume.extend res {:slimeballs []})
         res (lume.extend res {:surfaces-slimed 0 :meta (load-meta meta-path)})
         res (lume.extend res {:surfaces-total (count-surfaces res)})
         res (lume.extend res {:collision-map (new-collision-map res player)})
         res (lume.extend res {:position-player-at position-player-at})
+        res (lume.extend res {:add-slimeball add-slimeball})
         res (lume.extend res {:draw draw-world})
         res (lume.extend res {:update update-world})]
     res))