~benaiah/ludum-dare-nov-2018

8d873832285551cfbd48bb43a9ed5f19ee59a53e — Benaiah Mischenko 2 years ago 5ca9e11
collision and platforming

a _lot_ of platforming features:

- stopping with friction

- stopping faster than you accelerate

- wall slides

- wall jumps

- fudge timers for jumps (you can jump slightly after you fall off a
  platform)
4 files changed, 199 insertions(+), 24 deletions(-)

M .gitmodules
M game.fnl
A modules/bump-lua
M modules/ces-fnl
M .gitmodules => .gitmodules +3 -0
@@ 7,3 7,6 @@
[submodule "modules/ces-fnl"]
	path = modules/ces-fnl
	url = git@github.com:benaiah/ces-fnl.git
[submodule "modules/bump-lua"]
	path = modules/bump-lua
	url = git@github.com:kikito/bump.lua.git

M game.fnl => game.fnl +194 -23
@@ 1,4 1,5 @@
(local lume (require "modules.lume.lume"))
(local bump (require "modules.bump-lua.bump"))
(local ces (require "modules.ces-fnl.ces"))
(local inspect (require "modules.fennel.fennelview"))
(local exports {})


@@ 23,6 24,24 @@
          (concat! tab ...)))
  tab)

;; ---------- Vector handling ----------
(local pi math.pi)
(local tau (* pi 2))
(local degtorad (fn [deg] (/ (* pi deg) 180)))
(local vector->coords lume.vector)
(fn coords->angle [x y] (lume.angle 0 0 x y))
(fn coords->distance [x y] (lume.distance 0 0 x y))
(fn coords->vector [x y]
  (values (coords->angle x y)
          (coords->distance x y)))
(fn vector-between-coords [x1 y1 x2 y2]
  (values (lume.angle x1 y1 x2 y2)
          (lume.distance x1 y1 x2 y2)))
(fn add-vectors [angle1 magnitude1 angle2 magnitude2]
  (let [(x1 y1) (vector->coords angle1 magnitude1)
        (x2 y2) (vector->coords angle2 magnitude2)]
    (coords->vector (+ x1 x2) (+ y1 y2))))

(fn create-system [name required-component-names func]
  {:name name
   :required-components required-component-names


@@ 38,25 57,31 @@
      (push! acc key (unpack data)))
    acc))

(fn make-player [p]
  (kv->components
   (lume.merge {:position [100 100] :momentum [0 0]} (or p {}))))
(local collision-filter (fn [] "slide"))

(fn make-player-map [p]
  (lume.merge {:position [100 100]
               :momentum [0 0]
               :gravity [1100]
               :controls [{:speed 1100 :jump 700 :max-speed 700}]
               :collision [-25 -25 50 50 collision-filter]
               :platform-checks [0 0 0]}
              (or p {})))

(fn make-world []
  (local world (ces.world.create
                {:position [:x :y] :momentum [:x :y] :gravity [:amount]}))
  (ces.world.run-creations
   world
   [(make-player)
    (make-player {:position [200 200] :gravity [500]})
    (make-player {:position [300 300] :gravity [400]})
    (make-player {:position [400 400] :gravity [300]})
    (make-player {:position [500 500] :gravity [200]})
    (make-player {:position [600 600] :gravity [100]})
    ])
                {:position [:x :y]
                 :momentum [:x :y]
                 :gravity [:amount]
                 :controls [:options]
                 :collision [:ox :oy :w :h :filter]
                 :draw-rect [:ox :oy :w :h :color]
                 :draw-circle [:on]
                 :platform-checks [:standing :left-wall :right-wall]
                 }))
  world)

(local updates-initial {:position {} :momentum {}})
(local updates-initial {:position {} :momentum {} :platform-checks {}})
(var updates updates-initial)

(local momentum-system


@@ 77,36 102,182 @@
        :gravity
        [:momentum :gravity]
        (fn gravity [dt momentum gravity]
          (let [[id _ dy] momentum
          (let [[id dx dy] momentum
                [_ amount] gravity]
            (tset updates.momentum id [nil (+ dy (* amount dt))])))))
            (tset updates.momentum id [dx (+ dy (* amount dt))])))))

(local check-platforms-system
       (create-system
        :check-platforms
        [:collision :position :platform-checks]
        (fn [options collision position platform-checks]
          (let [bump-world options.bump-world
                dt options.dt
                [id ox oy w h filter] collision
                [_ standing left-wall right-wall] platform-checks
                [_ x y] position
                (_ standing-ay) (: bump-world :check id (+ x ox) (+ y oy 1) filter)
                (left-wall-ax) (: bump-world :check id (+ x ox -1) (+ y oy) filter)
                (right-wall-ax) (: bump-world :check id (+ x ox 1) (+ y oy) filter)

                standing-fudge-timer 0.2
                wall-slide-fudge-timer 0.2]
            (tset updates.platform-checks id
                  [(if (= standing-ay (+ y oy))
                       standing-fudge-timer (math.max (- standing dt) 0))
                   (if (= left-wall-ax (+ x ox))
                       wall-slide-fudge-timer (math.max (- left-wall dt) 0))
                   (if (= right-wall-ax (+ x ox))
                       wall-slide-fudge-timer (math.max (- right-wall dt) 0))])))))

(local controls-system
       (create-system
        :controls
        [:controls :momentum :platform-checks]
        (fn controls [dt controls momentum platform-checks]
          (let [[id control-options] controls
                [_ dx dy] momentum
                [_ standing at-left-wall at-right-wall] platform-checks
                is-standing (~= standing 0)
                is-at-left-wall (~= at-left-wall 0)
                is-at-right-wall (~= at-right-wall 0)
                speed control-options.speed
                stop-speed (* speed 100)
                friction-speed (* speed 0.7)
                max-speed control-options.max-speed
                friction-impulse
                (if (and is-standing
                         (not (love.keyboard.isDown :a))
                         (not (love.keyboard.isDown :d))
                         (> (math.abs dx) 0))
                    (* (lume.sign dx) -1 (math.max dx friction-speed)) 0)
                left-impulse
                (if (love.keyboard.isDown :a)
                    (let [spd (if (and standing (> dx 0)) stop-speed speed)]
                      (* spd -1)) 0)
                clamped-left-impulse (lume.clamp left-impulse (- (* -1 max-speed) dx) 0)
                right-impulse
                (if (love.keyboard.isDown :d)
                    (let [spd (if (and is-standing (< dx 0)) stop-speed speed)]
                      spd) 0)
                clamped-right-impulse (lume.clamp right-impulse 0 (- max-speed dx))
                new-dx (+ dx (* dt (+ friction-impulse clamped-left-impulse clamped-right-impulse)))
                wall-slide-speed 200
                [jump-dy jump-dx]
                (if (and (love.keyboard.isDown :w) is-standing)
                    [(* -1 control-options.jump)]

(print (inspect momentum-system))
                    (and is-at-left-wall (> dy 0) (love.keyboard.isDown :a))
                    (if (love.keyboard.isDown :w)
                        [(* -.75 control-options.jump) (* 0.65 control-options.jump)]
                        [(math.min dy wall-slide-speed)])

                    (and is-at-right-wall (love.keyboard.isDown :d) )
                    (if (love.keyboard.isDown :w)
                        [(* -0.75 control-options.jump) (* -0.65 control-options.jump)]
                        [(math.min dy wall-slide-speed)])

                    (and (not is-standing)
                         (not (love.keyboard.isDown :w))
                         (< dy 0))
                    [(lume.lerp dy 0 (/ dt 0.07))]

                    :else [dy])]
            (when (~= dy jump-dy) (tset updates.platform-checks id [0 0 0]))
            (tset updates.momentum id [(or jump-dx new-dx) jump-dy])))))

;; using object maps, create entities in both the CES world and the
;; bump world.
(fn create-entities-and-collisions [ces-world bump-world entity-maps]
  (let [entity-ids (ces.world.run-creations ces-world (lume.map entity-maps kv->components))]
    (each [i entity-map (ipairs entity-maps)]
      (when entity-map.collision
        (let [id (. entity-ids i)
              [x y] entity-map.position
              [ox oy w h] entity-map.collision]
          (: bump-world :add id (+ x ox) (+ y oy) w h))))
    entity-ids))

(fn filter-position-updates-with-collisions [dt ces-world bump-world]
  (ces.world.call-on-common-components
   ces-world [:collision :position :momentum]
   (fn [_ collision position momentum]
     (let [[id x y] position
           [_ dx dy] momentum
           [_ ox oy w h filter] collision
           position-update (. updates.position id)]
       (when position-update
         (let [[newx newy] position-update
               (ax ay) (: bump-world :move id (+ newx ox) (+ newy oy) filter)]
           (let [resolvedx (- ax ox)
                 resolvedy (- ay oy)]
             (tset updates.momentum id [(/ (- resolvedx x) dt) (/ (- resolvedy y) dt)])
             (tset updates.position id [resolvedx resolvedy])
             )))))))

(fn exports.load []
  {:world (make-world)})
  (let [world (make-world)
        bump-world (bump.newWorld)
        player-maps [(make-player-map {:draw-circle [:on]})
                     {:position [0 250]
                      :collision [0 0 1000 10 collision-filter]
                      :draw-rect [0 0 1000 10 [255 255 255]]}
                     {:position [400 600]
                      :collision [0 0 1000 10 collision-filter]
                      :draw-rect [0 0 1000 10 [255 255 255]]}
                     {:position [0 800]
                      :collision [0 0 1000 10 collision-filter]
                      :draw-rect [0 0 1000 10 [255 255 255]]}
                     {:position [1200 0]
                      :collision [0 0 10 600 collision-filter]
                      :draw-rect [0 0 10 600 [255 255 255]]}
                     ]
        player-ids (create-entities-and-collisions world bump-world player-maps)]
    {:world world :bump-world bump-world}))

(fn exports.init [state]
  (print (inspect state.world))
  (lume.merge state {}))

(fn exports.update [dt state]
  (local world state.world)
  (run-system world gravity-system dt)
  (ces.world.run-updates world updates)
  (set updates updates-initial)

  (run-system world check-platforms-system {:bump-world state.bump-world :dt dt})
  (ces.world.run-updates world updates)
  (set updates updates-initial)

  (run-system world controls-system dt)
  (ces.world.run-updates world updates)
  (set updates updates-initial)

  (run-system world momentum-system dt)
  (filter-position-updates-with-collisions dt world state.bump-world updates.position)
  (ces.world.run-updates world updates)
  (set updates updates-initial)

  (lume.merge state {:world world}))

(fn exports.draw [state]
  (love.graphics.setBackgroundColor [0.05 0.05 0.05])
  (let [world state.world]
    (when world

      (love.graphics.setColor [0.95 0.95 0.95])
      (ces.world.call-on-common-components
       world [:position]
       (fn draw-ellipses [opts position]
       world [:draw-circle :position]
       (fn draw-ellipses [opts draw-circle position]
         (let [[id x y] position]
           (love.graphics.ellipse :fill x y 25 25)))))))
           (love.graphics.ellipse :fill x y 25 25))))

      (ces.world.call-on-common-components
       world [:draw-rect :position]
       (fn draw-rects [opts draw-rect position]
         (let [[id ox oy w h color] draw-rect
               [_ x y] position]
           (love.graphics.rectangle :fill (+ x ox) (+ y oy) w h)))))))

(fn exports.repl-env [state] {})
(fn exports.repl-env [state] {:ces ces})

exports

A modules/bump-lua => modules/bump-lua +1 -0
@@ 0,0 1,1 @@
Subproject commit 7cae5d1ef796068a185d8e2d0c632a030ac8c148

M modules/ces-fnl => modules/ces-fnl +1 -1
@@ 1,1 1,1 @@
Subproject commit 569a205585801d4edd3233cbf132df1aea2bf19e
Subproject commit 7191549e7d96bd0493e307e83c7c3f7be1bff2dd