--- a/src/caves/core.clj Tue Jul 10 22:00:39 2012 -0400
+++ b/src/caves/core.clj Wed Jul 11 00:52:51 2012 -0400
@@ -18,8 +18,7 @@
(recur (process-input (dissoc game :input) input))))))
(defn new-game []
- (assoc (->Game nil [(->UI :start)] nil)
- :location [40 20]))
+ (->Game nil [(->UI :start)] nil))
(defn main
([screen-type] (main screen-type false))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/entities/aspects/digger.clj Wed Jul 11 00:52:51 2012 -0400
@@ -0,0 +1,7 @@
+(ns caves.entities.aspects.digger)
+
+(defprotocol Digger
+ (dig [this world dx dy]
+ "Dig a location.")
+ (can-dig? [this world dx dy]
+ "Return whether the entity can dig the new location."))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/entities/aspects/mobile.clj Wed Jul 11 00:52:51 2012 -0400
@@ -0,0 +1,9 @@
+(ns caves.entities.aspects.mobile)
+
+
+(defprotocol Mobile
+ (move [this world dx dy]
+ "Move this entity to a new location.")
+ (can-move? [this world dx dy]
+ "Return whether the entity can move to the new location."))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/entities/core.clj Wed Jul 11 00:52:51 2012 -0400
@@ -0,0 +1,7 @@
+(ns caves.entities.core)
+
+
+(defprotocol Entity
+ (tick [this world]
+ "Update the world to handle the passing of a tick for this entity."))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/entities/player.clj Wed Jul 11 00:52:51 2012 -0400
@@ -0,0 +1,64 @@
+(ns caves.entities.player
+ (:use [caves.entities.core :only [Entity]]
+ [caves.entities.aspects.mobile :only [Mobile move can-move?]]
+ [caves.entities.aspects.digger :only [Digger dig can-dig?]]
+ [caves.world :only [find-empty-tile get-tile-kind set-tile-floor]]))
+
+
+(defrecord Player [id loc])
+
+(defn offset-coords [[x y] dx dy]
+ [(+ x dx) (+ y dy)])
+
+(defn check-tile
+ "Take a player and an offset, and check that the tile at the destination
+ passes the given predicate."
+ [player world dx dy pred]
+ (let [[x y] (offset-coords (:loc player) dx dy)
+ dest-tile (get-tile-kind world x y)]
+ (pred dest-tile)))
+
+(defn dir-to-offset [dir]
+ (case dir
+ :w [-1 0]
+ :e [1 0]
+ :n [0 -1]
+ :s [0 1]
+ :nw [-1 -1]
+ :ne [1 -1]
+ :sw [-1 1]
+ :se [1 1]))
+
+
+(extend-type Player Entity
+ (tick [this world]
+ world))
+
+(extend-type Player Mobile
+ (move [this world dx dy]
+ (if (can-move? this world dx dy)
+ (update-in world [:player :loc] offset-coords dx dy)
+ world))
+ (can-move? [this world dx dy]
+ (check-tile this world dx dy #{:floor})))
+
+(extend-type Player Digger
+ (dig [this world dx dy]
+ (if (can-dig? this world dx dy)
+ (let [[tx ty] (offset-coords (:loc this) dx dy)]
+ (set-tile-floor world tx ty))
+ world))
+ (can-dig? [this world dx dy]
+ (check-tile this world dx dy #{:wall})))
+
+
+(defn make-player [world]
+ (->Player :player (find-empty-tile world)))
+
+(defn move-player [world direction]
+ (let [player (:player world)
+ [dx dy] (dir-to-offset direction)]
+ (cond
+ (can-move? player world dx dy) (move player world dx dy)
+ (can-dig? player world dx dy) (dig player world dx dy)
+ :else world)))
--- a/src/caves/ui/drawing.clj Tue Jul 10 22:00:39 2012 -0400
+++ b/src/caves/ui/drawing.clj Wed Jul 11 00:52:51 2012 -0400
@@ -34,9 +34,8 @@
(s/put-string screen 0 1 "Press escape to exit, anything else to restart."))
-(defn get-viewport-coords [game vcols vrows]
- (let [location (:location game)
- [center-x center-y] location
+(defn get-viewport-coords [game player-location vcols vrows]
+ (let [[center-x center-y] player-location
tiles (:tiles (:world game))
@@ -59,11 +58,19 @@
start-y (- end-y vrows)]
[start-x start-y end-x end-y]))
-(defn draw-crosshairs [screen vcols vrows]
- (let [crosshair-x (int (/ vcols 2))
- crosshair-y (int (/ vrows 2))]
- (s/put-string screen crosshair-x crosshair-y "X" {:fg :red})
- (s/move-cursor screen crosshair-x crosshair-y)))
+(defn draw-hud [screen game start-x start-y]
+ (let [hud-row (dec (second screen-size))
+ [x y] (get-in game [:world :player :loc])
+ info (str "loc: [" x "-" y "]")
+ info (str info " start: [" start-x " " start-y "]")
+ ]
+ (s/put-string screen 0 hud-row info)))
+
+(defn draw-player [screen start-x start-y [player-x player-y]]
+ (let [x (- player-x start-x)
+ y (- player-y start-y)]
+ (s/put-string screen x y "@" {:fg :white})
+ (s/move-cursor screen x y)))
(defn draw-world [screen vrows vcols start-x start-y end-x end-y tiles]
(doseq [[vrow-idx mrow-idx] (map vector
@@ -77,12 +84,14 @@
(defmethod draw-ui :play [ui game screen]
(let [world (:world game)
tiles (:tiles world)
+ player-location (get-in world [:player :loc])
[cols rows] screen-size
vcols cols
vrows (dec rows)
- [start-x start-y end-x end-y] (get-viewport-coords game vcols vrows)]
+ [start-x start-y end-x end-y] (get-viewport-coords game player-location vcols vrows)]
(draw-world screen vrows vcols start-x start-y end-x end-y tiles)
- (draw-crosshairs screen vcols vrows)))
+ (draw-player screen start-x start-y player-location)
+ (draw-hud screen game start-x start-y)))
(defn draw-game [game screen]
--- a/src/caves/ui/input.clj Tue Jul 10 22:00:39 2012 -0400
+++ b/src/caves/ui/input.clj Wed Jul 11 00:52:51 2012 -0400
@@ -1,6 +1,7 @@
(ns caves.ui.input
(:use [caves.world :only [random-world smooth-world]]
- [caves.ui.core :only [->UI]])
+ [caves.ui.core :only [->UI]]
+ [caves.entities.player :only [move-player make-player]])
(:require [lanterna.screen :as s]))
@@ -9,31 +10,27 @@
(:kind (last (:uis game)))))
(defmethod process-input :start [game input]
- (-> game
- (assoc :world (random-world))
- (assoc :uis [(->UI :play)])))
+ (let [fresh-world (random-world)]
+ (-> game
+ (assoc :world fresh-world)
+ (assoc-in [:world :player] (make-player fresh-world))
+ (assoc :uis [(->UI :play)]))))
-(defn move [[x y] [dx dy]]
- [(+ x dx) (+ y dy)])
-
(defmethod process-input :play [game input]
(case input
:enter (assoc game :uis [(->UI :win)])
:backspace (assoc game :uis [(->UI :lose)])
\q (assoc game :uis [])
- \s (update-in game [:world] smooth-world)
-
- \h (update-in game [:location] move [-1 0])
- \j (update-in game [:location] move [0 1])
- \k (update-in game [:location] move [0 -1])
- \l (update-in game [:location] move [1 0])
-
- \H (update-in game [:location] move [-5 0])
- \J (update-in game [:location] move [0 5])
- \K (update-in game [:location] move [0 -5])
- \L (update-in game [:location] move [5 0])
+ \h (update-in game [:world] move-player :w)
+ \j (update-in game [:world] move-player :s)
+ \k (update-in game [:world] move-player :n)
+ \l (update-in game [:world] move-player :e)
+ \y (update-in game [:world] move-player :nw)
+ \u (update-in game [:world] move-player :ne)
+ \b (update-in game [:world] move-player :sw)
+ \n (update-in game [:world] move-player :se)
game))
--- a/src/caves/world.clj Tue Jul 10 22:00:39 2012 -0400
+++ b/src/caves/world.clj Wed Jul 11 00:52:51 2012 -0400
@@ -16,6 +16,9 @@
(defn get-tile [tiles x y]
(get-in tiles [y x] (:bound tiles)))
+(defn set-tile-floor [world x y]
+ (assoc-in world [:tiles y x] (:floor tiles)))
+
; Debugging -------------------------------------------------------------------
(defn print-row [row]
@@ -70,6 +73,23 @@
(defn random-world []
(let [world (->World (random-tiles))
- world (nth (iterate smooth-world world) 0)]
+ world (nth (iterate smooth-world world) 3)]
world))
+
+; Querying a world ------------------------------------------------------------
+(defn random-coordinate []
+ (let [[cols rows] world-size]
+ [(rand-int cols) (rand-int rows)]))
+
+(defn find-empty-tile [world]
+ (loop [[x y] (random-coordinate)]
+ (let [{:keys [kind]} (get-tile (:tiles world) x y)]
+ (if (#{:floor} kind)
+ [x y]
+ (recur (random-coordinate))))))
+
+
+(defn get-tile-kind [world x y]
+ (:kind (get-tile (:tiles world) x y)))
+