--- a/src/caves/coords.clj Wed Jul 11 21:10:17 2012 -0400
+++ b/src/caves/coords.clj Thu Jul 12 18:52:17 2012 -0400
@@ -1,6 +1,16 @@
(ns caves.coords)
+(def directions
+ {:w [-1 0]
+ :e [1 0]
+ :n [0 -1]
+ :s [0 1]
+ :nw [-1 -1]
+ :ne [1 -1]
+ :sw [-1 1]
+ :se [1 1]})
+
(defn offset-coords
"Offset the starting coordinate by the given amount, returning the result coordinate."
[[x y] [dx dy]]
@@ -9,17 +19,14 @@
(defn dir-to-offset
"Convert a direction to the offset for moving 1 in that direction."
[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]))
+ (directions dir))
(defn destination-coords
"Take an origin's coords and a direction and return the destination's coords."
[origin dir]
(offset-coords origin (dir-to-offset dir)))
+
+(defn neighbors
+ "Return the coordinates of all neighboring squares of the given coord."
+ [origin]
+ (map offset-coords (vals directions) (repeat origin)))
--- a/src/caves/core.clj Wed Jul 11 21:10:17 2012 -0400
+++ b/src/caves/core.clj Thu Jul 12 18:52:17 2012 -0400
@@ -1,6 +1,7 @@
(ns caves.core
(:use [caves.ui.core :only [->UI]]
[caves.ui.drawing :only [draw-game]]
+ [caves.entities.core :only [tick]]
[caves.ui.input :only [get-input process-input]])
(:require [lanterna.screen :as s]))
@@ -9,12 +10,18 @@
(defrecord Game [world uis input])
; Main ------------------------------------------------------------------------
+(defn tick-entity [world entity]
+ (tick entity world))
+
+(defn tick-all [world]
+ (reduce tick-entity world (vals (:entities world))))
+
(defn run-game [game screen]
(loop [{:keys [input uis] :as game} game]
(when-not (empty? uis)
(draw-game game screen)
(if (nil? input)
- (recur (get-input game screen))
+ (recur (get-input (update-in game [:world] tick-all) screen))
(recur (process-input (dissoc game :input) input))))))
(defn new-game []
--- a/src/caves/entities/core.clj Wed Jul 11 21:10:17 2012 -0400
+++ b/src/caves/entities/core.clj Thu Jul 12 18:52:17 2012 -0400
@@ -1,7 +1,15 @@
(ns caves.entities.core)
+(def ids (ref 0))
+
(defprotocol Entity
(tick [this world]
"Update the world to handle the passing of a tick for this entity."))
+
+(defn get-id []
+ (dosync
+ (let [id @ids]
+ (alter ids inc)
+ id)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/entities/lichen.clj Thu Jul 12 18:52:17 2012 -0400
@@ -0,0 +1,19 @@
+(ns caves.entities.lichen
+ (:use [caves.entities.core :only [Entity get-id]]))
+
+
+(defrecord Lichen [id glyph color location])
+
+(defn should-grow []
+ (< (rand) 0.01))
+
+
+(extend-type Lichen Entity
+ (tick [this world]
+ world))
+
+
+(defn make-lichen [location]
+ (->Lichen (get-id) "F" :green location))
+
+
--- a/src/caves/entities/player.clj Wed Jul 11 21:10:17 2012 -0400
+++ b/src/caves/entities/player.clj Thu Jul 12 18:52:17 2012 -0400
@@ -3,10 +3,10 @@
[caves.entities.aspects.mobile :only [Mobile move can-move?]]
[caves.entities.aspects.digger :only [Digger dig can-dig?]]
[caves.coords :only [destination-coords]]
- [caves.world :only [find-empty-tile get-tile-kind set-tile-floor]]))
+ [caves.world :only [get-tile-kind set-tile-floor]]))
-(defrecord Player [id glyph location])
+(defrecord Player [id glyph color location])
(defn check-tile
"Check that the tile at the destination passes the given predicate."
@@ -21,7 +21,7 @@
(extend-type Player Mobile
(move [this world dest]
{:pre [(can-move? this world dest)]}
- (assoc-in world [:player :location] dest))
+ (assoc-in world [:entities :player :location] dest))
(can-move? [this world dest]
(check-tile world dest #{:floor})))
@@ -33,11 +33,12 @@
(check-tile world dest #{:wall})))
-(defn make-player [world]
- (->Player :player "@" (find-empty-tile world)))
+
+(defn make-player [location]
+ (->Player :player "@" :white location))
(defn move-player [world dir]
- (let [player (:player world)
+ (let [player (get-in world [:entities :player])
target (destination-coords (:location player) dir)]
(cond
(can-move? player world target) (move player world target)
--- a/src/caves/ui/drawing.clj Wed Jul 11 21:10:17 2012 -0400
+++ b/src/caves/ui/drawing.clj Thu Jul 12 18:52:17 2012 -0400
@@ -60,17 +60,16 @@
(defn draw-hud [screen game start-x start-y]
(let [hud-row (dec (second screen-size))
- [x y] (get-in game [:world :player :location])
+ [x y] (get-in game [:world :entities :player :location])
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]
- (let [[player-x player-y] (:location player)
- x (- player-x start-x)
- y (- player-y start-y)]
- (s/put-string screen x y (:glyph player) {:fg :white})
- (s/move-cursor screen x y)))
+(defn draw-entity [screen start-x start-y {:keys [location glyph color]}]
+ (let [[entity-x entity-y] location
+ x (- entity-x start-x)
+ y (- entity-y start-y)]
+ (s/put-string screen x y glyph {:fg color})))
(defn draw-world [screen vrows vcols start-x start-y end-x end-y tiles]
(doseq [[vrow-idx mrow-idx] (map vector
@@ -81,16 +80,25 @@
:let [{:keys [glyph color]} (row-tiles vcol-idx)]]
(s/put-string screen vcol-idx vrow-idx glyph {:fg color}))))
+(defn highlight-player [screen start-x start-y player]
+ (let [[player-x player-y] (:location player)
+ x (- player-x start-x)
+ y (- player-y start-y)]
+ (s/move-cursor screen x y)))
+
(defmethod draw-ui :play [ui game screen]
(let [world (:world game)
- {:keys [tiles player]} world
+ {:keys [tiles entities]} world
+ player (:player entities)
[cols rows] screen-size
vcols cols
vrows (dec rows)
[start-x start-y end-x end-y] (get-viewport-coords game (:location player) vcols vrows)]
(draw-world screen vrows vcols start-x start-y end-x end-y tiles)
- (draw-player screen start-x start-y player)
- (draw-hud screen game start-x start-y)))
+ (doseq [entity (vals entities)]
+ (draw-entity screen start-x start-y entity))
+ (draw-hud screen game start-x start-y)
+ (highlight-player screen start-x start-y player)))
(defn draw-game [game screen]
--- a/src/caves/ui/input.clj Wed Jul 11 21:10:17 2012 -0400
+++ b/src/caves/ui/input.clj Thu Jul 12 18:52:17 2012 -0400
@@ -1,15 +1,26 @@
(ns caves.ui.input
- (:use [caves.world :only [random-world smooth-world]]
+ (:use [caves.world :only [random-world smooth-world find-empty-tile]]
[caves.ui.core :only [->UI]]
- [caves.entities.player :only [move-player make-player]])
+ [caves.entities.player :only [move-player make-player]]
+ [caves.entities.lichen :only [make-lichen]])
(:require [lanterna.screen :as s]))
+(defn add-lichen [world]
+ (let [{:as lichen :keys [id]} (make-lichen (find-empty-tile world))]
+ (assoc-in world [:entities id] lichen)))
+
+(defn populate-world [world]
+ (let [world (assoc-in world [:entities :player]
+ (make-player (find-empty-tile world)))
+ world (nth (iterate add-lichen world) 30)]
+ world))
+
(defn reset-game [game]
(let [fresh-world (random-world)]
(-> game
(assoc :world fresh-world)
- (assoc-in [:world :player] (make-player fresh-world))
+ (update-in [:world] populate-world)
(assoc :uis [(->UI :play)]))))
--- a/src/caves/world.clj Wed Jul 11 21:10:17 2012 -0400
+++ b/src/caves/world.clj Thu Jul 12 18:52:17 2012 -0400
@@ -1,11 +1,12 @@
-(ns caves.world)
+(ns caves.world
+ (:use [caves.coords :only [neighbors]]))
; Constants -------------------------------------------------------------------
(def world-size [160 50])
; Data structures -------------------------------------------------------------
-(defrecord World [tiles])
+(defrecord World [tiles entities])
(defrecord Tile [kind glyph color])
(def tiles
@@ -66,7 +67,7 @@
(defn random-world []
- (let [world (->World (random-tiles))
+ (let [world (->World (random-tiles) {})
world (nth (iterate smooth-world world) 3)]
world))
@@ -85,9 +86,22 @@
(set-tile world coord (:floor tiles)))
+(defn get-entity-at [world coord]
+ (first (filter #(= coord (:location %))
+ (vals (:entities world)))))
+
+(defn is-empty? [world coord]
+ (and (#{:floor} (get-tile-kind world coord))
+ (not (get-entity-at world coord))))
+
(defn find-empty-tile [world]
(loop [coord (random-coordinate)]
- (if (#{:floor} (get-tile-kind world coord))
+ (if (is-empty? world coord)
coord
(recur (random-coordinate)))))
+(defn find-empty-neighbor [world coord]
+ (let [candidates (filter #(is-empty? world %) (neighbors coord))]
+ (when (seq candidates)
+ (rand-nth candidates))))
+