Gravity. Thanks, Mineflayer!
Changes
--- a/src/clojurecraft/actions.clj Tue Aug 09 09:23:07 2011 -0400
+++ b/src/clojurecraft/actions.clj Tue Aug 09 21:55:15 2011 -0400
@@ -1,5 +1,6 @@
(ns clojurecraft.actions
- (:use [clojurecraft.util]))
+ (:use [clojurecraft.util])
+ (:require [clojurecraft.physics :as physics]))
(defn move [bot x-change y-change z-change]
@@ -14,3 +15,11 @@
(alter player merge {:loc new-location}))))
nil)
+(defn jump [bot]
+ (let [player (:player bot)]
+ (dosync
+ (let [location (:loc @player)]
+ (alter player assoc-in [:loc :onground] false)
+ (alter player assoc :velocity physics/JUMP-VELOCITY))))
+ nil)
+
--- a/src/clojurecraft/core.clj Tue Aug 09 09:23:07 2011 -0400
+++ b/src/clojurecraft/core.clj Tue Aug 09 21:55:15 2011 -0400
@@ -5,6 +5,7 @@
(:use [clojurecraft.util])
(:use [clojure.contrib.pprint :only (pprint)])
(:require [clojurecraft.chunks :as chunks])
+ (:require [clojurecraft.physics :as physics])
(:require [clojurecraft.actions :as act])
(:require (clojurecraft.data))
(:import [clojurecraft.data Location Entity Block Chunk World Bot])
@@ -55,39 +56,18 @@
(println "done - input handler"))
-; TODO: Investigate this. I'm not convinced.
-(def G -9.8) ; meters/second^2
-(def TICK 50/1000) ; seconds
-
-(defn apply-gravity [player]
- (let [y (:y (:loc player))
- stance (:stance (:loc player))
- velocity (:velocity player)
- new-y (+ y (* velocity TICK))
- new-stance (+ stance (* velocity TICK))
- new-velocity (max -4.0 (+ velocity (* G TICK)))]
- [new-y ; TODO: More research on terminal velocity.
- new-stance
- new-velocity]))
-
-(defn should-apply-gravity? [bot]
- (let [y (:y (:loc @(:player bot)))]
- (or (> (- y (Math/floor y)) 0.2)
- (non-solid-blocks (:type (chunks/block-beneath bot))))))
-
(defn update-location [bot]
(when (chunks/current bot)
(dosync
- (let [player (:player bot)]
- (if (should-apply-gravity? bot)
- (let [[new-y new-stance new-velocity] (apply-gravity @player)]
- (alter player assoc :velocity new-velocity)
- (alter player assoc-in [:loc :y] new-y)
- (alter player assoc-in [:loc :stance] new-stance)
- (alter player assoc-in [:loc :onground] false))
- (do
- (alter player assoc :velocity 0.0)
- (alter player assoc-in [:loc :onground] true)))))))
+ (let [player (:player bot)
+ loc (:loc @player)
+ [bounds-min bounds-max] (physics/player-bounds loc)
+ new-data-y (physics/update-loc-y bot bounds-min bounds-max)
+ {new-y :y new-onground :onground new-velocity :vel} new-data-y]
+ (alter player assoc :velocity new-velocity)
+ (alter player assoc-in [:loc :y] new-y)
+ (alter player assoc-in [:loc :stance] (+ new-y physics/CHAR-HEIGHT-EYES))
+ (alter player assoc-in [:loc :onground] new-onground)))))
(defn location-handler [bot]
(let [conn (:connection bot)
--- a/src/clojurecraft/in.clj Tue Aug 09 09:23:07 2011 -0400
+++ b/src/clojurecraft/in.clj Tue Aug 09 21:55:15 2011 -0400
@@ -427,6 +427,7 @@
(defn -update-single-block [bot x y z type meta]
+ (println "Updating block" x y z "to be type" type)
(dosync (let [chunk (chunk-containing x z (:chunks (:world bot)))
i (block-index-in-chunk x y z)]
(when chunk
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/clojurecraft/physics.clj Tue Aug 09 21:55:15 2011 -0400
@@ -0,0 +1,75 @@
+(ns clojurecraft.physics
+ (:use [clojurecraft.mappings])
+ (:use [clojurecraft.util])
+ (:use [clojure.contrib.combinatorics :only (cartesian-product)])
+ (:require [clojurecraft.chunks :as chunks]))
+
+; TODO: Investigate these. I'm not convinced.
+(def G -27.0) ; meters/second^2
+(def TICK 50/1000) ; seconds
+(def CHAR-HEIGHT-EYES 1.62) ; meters
+(def CHAR-HEIGHT-TOP 1.74) ; meters
+(def CHAR-HEIGHT-HALF (/ CHAR-HEIGHT-TOP 2)) ; meters
+(def CHAR-RADIUS 0.32) ; meters
+(def TERMINAL-VELOCITY 18.0) ; meters/second
+(def MAX-HORIZONTAL-VELOCITY 4.0) ; meters/second
+(def JUMP-VELOCITY 8.2) ; meters/second
+
+
+(defn player-bounds [{x :x y :y z :z}]
+ [(map floorint [(- x CHAR-RADIUS) y (- z CHAR-RADIUS)])
+ (map floorint [(+ x CHAR-RADIUS) (+ y CHAR-HEIGHT-TOP) (+ z CHAR-RADIUS)])])
+
+
+(defn bound-velocity-vertical [velocity]
+ (if (> 0 velocity)
+ (min velocity TERMINAL-VELOCITY)
+ (max velocity (* -1 TERMINAL-VELOCITY))))
+
+(defn bound-velocity-horizontal [velocity]
+ (if (> 0 velocity)
+ (min velocity MAX-HORIZONTAL-VELOCITY)
+ (max velocity (* -1 MAX-HORIZONTAL-VELOCITY))))
+
+
+(defn collision [bot [min-x min-y min-z] [max-x max-y max-z]]
+ (let [block-coords (cartesian-product (range min-x (+ 1 max-x))
+ (range min-y (+ 1 max-y))
+ (range min-z (+ 1 max-z)))
+ is-solid (comp not non-solid-blocks :type)
+ coords-are-solid (fn [[x y z]]
+ (is-solid (chunks/block bot x y z)))]
+ (any? (map coords-are-solid block-coords))))
+
+
+(defn resolve-collision-y [y velocity]
+ (+ y
+ ; If we're traveling downwards, and there was a collison, we need our new
+ ; y to be on top of the block beneath us (add 1 to y).
+ ;
+ ; If we're traveling upwards, and there was a collison, we need the top of our
+ ; head to be just beneath the block above us (subtract our height from y).
+ ;
+ ; We also go just a bit further to make sure we're out.
+ (* (if (< velocity 0)
+ 1
+ (* -1 CHAR-HEIGHT-TOP))
+ 1.001)))
+
+
+(defn update-loc-y [bot [min-x min-y min-z] [max-x max-y max-z]]
+ (let [player (:player bot)
+ old-y (:y (:loc @player))
+ unbounded-vel (+ (:velocity @player)
+ (* G TICK))
+ new-vel (bound-velocity-vertical unbounded-vel)
+ tentative-new-y (+ old-y (* new-vel TICK))
+ block-y (floorint (+ tentative-new-y
+ CHAR-HEIGHT-HALF
+ (* (sign new-vel) CHAR-HEIGHT-HALF)))]
+ (if (collision bot [min-x block-y min-z] [max-x block-y max-z])
+ (let [resolved-y (resolve-collision-y block-y new-vel)
+ new-onground (if (< new-vel 0) true false)]
+ {:y resolved-y :onground new-onground :vel 0})
+ {:y tentative-new-y :onground false :vel new-vel})))
+
--- a/src/clojurecraft/util.clj Tue Aug 09 09:23:07 2011 -0400
+++ b/src/clojurecraft/util.clj Tue Aug 09 21:55:15 2011 -0400
@@ -30,6 +30,14 @@
(aset-byte new-arr i b)
new-arr))
+(defn sign [i]
+ (if (> i 0) 1 -1))
+
+(defn floorint [f]
+ (int (Math/floor f)))
+
+(defn any? [s]
+ (not (empty? (filter identity s))))
; Bytes ----------------------------------------------------------------------------
(defn byte-seq [b]