Permalink
Browse files

Radial messages, and styling.

  • Loading branch information...
1 parent 56c3eec commit bdd67fdfa401fd9705fa884bf592e341e4b6795f @sjl committed Jul 18, 2012
View
@@ -1,4 +1,24 @@
-(ns caves.coords)
+(ns caves.coords
+ (:use [caves.utils :only [abs]]))
+
+
+(defn radial-distance
+ "Return the radial distance between two points.
+
+ There might be a better name for this, but in a nutshell:
+
+ 3333333
+ 3222223
+ 3211123
+ 321.123
+ 3211123
+ 3222223
+ 3333333
+
+ "
+ [[x1 y1] [x2 y2]]
+ (max (abs (- x1 x2))
+ (abs (- y1 y2))))
(def directions
@@ -1,5 +1,6 @@
(ns caves.entities.aspects.receiver
- (:use [caves.entities.core :only [defaspect]]))
+ (:use [caves.entities.core :only [defaspect]]
+ [caves.world :only [get-entities-around]]))
(defaspect Receiver
@@ -12,3 +13,9 @@
(receive-message entity (apply format message args) world)
world))
+(defn send-message-nearby [coord message world]
+ (let [entities (get-entities-around world coord 7)
+ sm #(send-message %2 message [] %1)]
+ (reduce sm world entities)))
+
+
@@ -1,5 +1,6 @@
(ns caves.entities.lichen
(:use [caves.entities.core :only [Entity get-id add-aspect]]
+ [caves.entities.aspects.receiver :only [send-message-nearby]]
[caves.entities.aspects.destructible :only [Destructible]]
[caves.world :only [find-empty-neighbor]]))
@@ -17,10 +18,12 @@
(defn should-grow []
(< (rand) (/ 1 500)))
-(defn grow [lichen world]
- (if-let [target (find-empty-neighbor world (:location lichen))]
- (let [new-lichen (make-lichen target)]
- (assoc-in world [:entities (:id new-lichen)] new-lichen))
+(defn grow [{:keys [location]} world]
+ (if-let [target (find-empty-neighbor world location)]
+ (let [new-lichen (make-lichen target)
+ world (assoc-in world [:entities (:id new-lichen)] new-lichen)
+ world (send-message-nearby location "The lichen grows." world)]
+ world)
world))
View
@@ -1,5 +1,5 @@
(ns caves.ui.drawing
- (:use [caves.utils :only (map2d shear)])
+ (:use [caves.utils :only (map2d shear enumerate)])
(:require [lanterna.screen :as s]))
@@ -108,8 +108,8 @@
(defn draw-messages [screen messages]
- (when (seq messages)
- (s/put-sheet screen 0 0 messages)))
+ (doseq [[i msg] (enumerate messages)]
+ (s/put-string screen 0 i msg {:fg :black :bg :white})))
(defmethod draw-ui :play [ui game screen]
View
@@ -1,6 +1,13 @@
(ns caves.utils)
+; lolclojure
+(defn abs [i]
+ (if (neg? i)
+ (- i)
+ i))
+
+
(defn map2d
"Map a function across a two-dimensional sequence."
[f s]
@@ -18,3 +25,7 @@
[s x y w h]
(map #(slice % x w)
(slice s y h)))
+
+
+(defn enumerate [s]
+ (map vector (iterate inc 0) s))
View
@@ -1,5 +1,5 @@
(ns caves.world
- (:use [caves.coords :only [neighbors]]))
+ (:use [caves.coords :only [neighbors radial-distance]]))
; Constants -------------------------------------------------------------------
@@ -86,9 +86,19 @@
(set-tile world coord (:floor tiles)))
+(defn get-entities-at [world coord]
+ (filter #(= coord (:location %))
+ (vals (:entities world))))
+
(defn get-entity-at [world coord]
- (first (filter #(= coord (:location %))
- (vals (:entities world)))))
+ (first (get-entities-at world coord)))
+
+(defn get-entities-around
+ ([world coord] (get-entities-around world coord 1))
+ ([world coord radius]
+ (filter #(<= (radial-distance coord (:location %))
+ radius)
+ (vals (:entities world)))))
(defn is-empty? [world coord]
(and (#{:floor} (get-tile-kind world coord))

0 comments on commit bdd67fd

Please sign in to comment.