Skip to content

Commit

Permalink
Clean up datastructures and tests.
Browse files Browse the repository at this point in the history
  • Loading branch information
@ripley-on-rails
ripley-on-rails committed Feb 2, 2013
1 parent a560f0d commit 4500253
Show file tree
Hide file tree
Showing 3 changed files with 118 additions and 209 deletions.
145 changes: 47 additions & 98 deletions src/hulkure/board.clj
View file
@@ -1,63 +1,73 @@
(ns hulkure.board
(:require [clojure.data.json :as json]))
(:require [clojure.data.json :as json])
(:use [hulkure.utils :only [filter-first]]))

(defn make-board [width height]
{:width width,
:height height,
:fields (vec (take (* width height) (repeat nil))),
(defn make-board []
{:fields [], ; contains fields. The keys :x and :y are handled like unique keys
:figures [],
:round 0,
:current-player 0,
:figure-templates {}})
:current-player 0})

(defn load [path]
(json/read-str (slurp path) :key-fn keyword))

(defn- coordinates-to-index [board x y]
{:pre [(<= 0 x) (< x (board :width)) (<= 0 y) (< y (board :height))]}
(+ (* y (board :width)) x))
;; fields

(defn get-field [board x y]
((board :fields) (coordinates-to-index board x y)))
(defn- get-field-with-index [board x y]
"returns [index field]"
(or (filter-first #(and (= x (% :x))
(= y (% :y)))
(map-indexed vector (board :fields)))
[nil nil]))

(defn- set-field [board x y value]
(assoc-in board [:fields (coordinates-to-index board x y)] value))
(defn- get-field-index [board x y]
(first (get-field-with-index board x y)))

(defn- get-indexed-figure [board id]
(filter (fn[index figure] (= (figure :id) id)
(map-indexed vector (board :figures)))))
(defn get-field [board x y]
(last (get-field-with-index board x y)))

(defn get-figure-by-id [board id]
(second (get-indexed-figure board id)))
(defn set-field [board field]
"Update or add field if it does not exist"
(let [index (or (get-field-index board (field :x) (field :y))
(count (board :fields)))]
(assoc-in board [:fields index] field)))

(defn get-figure-index [board id]
(first (get-indexed-figure board id)))
;; figures

(defn get-figures-at [board x y]
(filterv (fn [figure] (= [x y]
(mapv figure [:x :y])))
(board :figures)))
(defn get-next-available-figure-id [board]
(if (empty? (board :figures))
0
(inc (apply max (map :id (board :figures))))))

(defn set-figure [board id new-figure]
(assoc-in board [:figures (get-figure-index board id)] new-figure))
(defn- get-figure-with-index [board id]
"returns [index field]"
(or (filter-first #(= id (% :id)) (board :figures))
[nil nil]))

(defn update-figure [board id attributes]
(set-figure board id (merge (get-figure-by-id id) attributes)))
(defn- get-figure-index [board id]
(second (get-figure-with-index board id)))

(defn place-figure [board id x y]
{:pre [(not (nil? (get-field board x y)))]}
(update-figure board id {:x x :y y}))
(defn get-figure [board id]
(first (get-figure-with-index board id)))

(defn next-available-figure-id [board]
(if (empty? (board :figures))
0
(inc (apply max (map :id (board :figures))))))

(defn add-figure [board figure]
(let [id (next-available-figure-id board)]
(assoc-in board
[:figures (count (board :figures))]
(assoc figure :id id))))
(defn set-figure [board figure]
"updates or adds a figure. If no :id is given the next available one will be associated with the figure"
(let [[index figure] (if (figure :id)
[(or (get-figure-index board (figure :id))
(count (board :figures)))
figure]
[(count (board :figures)) (assoc figure :id (next-available-figure-id board))])]
(assoc-in board [:figures index] figure)))

(defn get-figures-at [board x y]
(filterv (fn [figure] (= [x y]
(mapv figure [:x :y])))
(board :figures)))

;; movement related
(def movement-offset
Expand All @@ -82,64 +92,3 @@

(defn relative-movement-to-offset [movement heading]
(matrix-vector-mult (rotation_matrix heading) (movement-offset movement)))

(defmulti figure (fn [board & args] ()))

(defmethod figure :by-id [board id]
((board :figures) id))

(defmethod figure :by-coordinates [board x y]
(let [id (get-field x y)] (figure id)))

(defn template [board name]) ;; multi name or figure

(comment
(defn- flood-fill [grid x y replacement]
(let [grid-ref (atom grid)
target (get-in grid [y x])
stack (atom [])]
(reset! stack (conj @stack [x y]))
(while (not-empty @stack)
(let [[x y] (peek @stack)]
(swap! stack pop)
(cond (= (get-in @grid-ref [y x]) target)
(do
(reset! grid-ref (assoc-in @grid-ref [y x] replacement))
(cond (> x 0)
(reset! stack (conj @stack [(dec x) y])))
(cond (> y 0)
(reset! stack (conj @stack [x (dec y)])))
(cond (< x (dec (count (first @grid-ref))))
(reset! stack (conj @stack [(inc x) y])))
(cond (< y (dec (count @grid-ref)))
(reset! stack (conj @stack [x (inc y)])))))))
@grid-ref))

(defn upper-case? [str] (boolean (re-matches #"[A-Z]" str)))

(defn load-board [path]
(let [char-map (atom (mapv vec (vec (.split (slurp path) "\n"))))
tile-count (atom 0)]
(doseq [x (range (count (first @char-map))), y (range (count @char-map))]
(let [val (get-in @char-map [y x])
void? (= val \.)]
(if (instance? Character val)
(do
(reset! char-map (flood-fill @char-map x y (if void?
nil
[@tile-count (upper-case? (str val))])))
(if (not void?)
(swap! tile-count inc))))
(comment (let [board (atom (make-board (count (first char-map)) (count char-map)))]
(doseq [ [row y] (map vector char-map (range))
[val x] (map vector row (range))]
(reset! board (set-field @board x y [])))
@board))))
(let [board (atom (make-board (count (first @char-map)) (count @char-map)))]
(doseq [[row y] (map vector @char-map (range))
[[tile-id room?] x] (map vector row (range))]
(cond tile-id
(reset! board (set-field @board x y {:tile-id tile-id, :room room?})))
)
@board)))
)
4 changes: 4 additions & 0 deletions src/hulkure/utils.clj
View file
@@ -0,0 +1,4 @@
(ns hulkure.utils)

(defn filter-first [pred coll]
(first (filter pred coll)))
178 changes: 67 additions & 111 deletions test/hulkure/test/board.clj
View file
Expand Up @@ -8,116 +8,72 @@
`(let ~(reduce #(conj %1 %2 `(ns-resolve '~ns '~%2)) [] fns)
~@tests))

(with-private-fns [hulkure.board [coordinates-to-index]]
;;(with-private-fns [hulkure.board [coordinates-to-index]])

(def board )
(deftest add-figure-tests
(let [board (board/load "test/fixtures/map.json")]
(testing "figures with coordinates"
(let [figure-1 {:x 3, :y 1, :id 3}
figure-2 {:x 7, :y 2}
figure-3 {:x 7, :y 2}
board (set-figure (set-figure (set-figure board
figure-1)
figure-2)
figure-3)]
(is (= (board :figures)
[{:x 3, :y 1, :id 3},
{:x 7, :y 2, :id 4},
{:x 7, :y 2, :id 5}]))
(is (= (get-figures-at board 3 1)
[{:x 3, :y 1, :id 3}]))
(is (= (get-figures-at board 7 2)
[{:x 7, :y 2, :id 4},
{:x 7, :y 2, :id 5}]))))
(testing "figures without coordinates"
(let [figure-1 {}
figure-2 {}
board (set-figure (set-figure board figure-1) figure-2)]
(is (= (board :figures) [{:id 0}, {:id 1}]))))))

(deftest make-board-tests
(testing "empty board"
(let [board (make-board 20 15)]
(is (= (board :width) 20))
(is (= (board :height) 15))
(is (= (board :fields) (vec (take 300 (repeat nil))))))))

(deftest coordinates-to-index-tests
(let [board (assoc-in (make-board 20 15) [:fields] (vec (range 300)))]
(testing "valid coordintates"
(is (= (coordinates-to-index board 0 0) 0))
(is (= (coordinates-to-index board 12 0) 12))
(is (= (coordinates-to-index board 19 0) 19))
(is (= (coordinates-to-index board 0 1) 20))
(is (= (coordinates-to-index board 19 14) 299)))
(testing "invalid coordinates"
(is (thrown? AssertionError (coordinates-to-index board -1 0)))
(is (thrown? AssertionError (coordinates-to-index board 0 -1)))
(is (thrown? AssertionError (coordinates-to-index board -1 -1)))
(is (thrown? AssertionError (coordinates-to-index board 20 0)))
(is (thrown? AssertionError (coordinates-to-index board 21 1)))
(is (thrown? AssertionError (coordinates-to-index board 0 15)))
(is (thrown? AssertionError (coordinates-to-index board 1 16)))
(is (thrown? AssertionError (coordinates-to-index board 20 15)))
(is (thrown? AssertionError (coordinates-to-index board 21 16))))))

(deftest add-figure-tests
(let [board (board/load "test/fixtures/map.json")]
(testing "figures with coordinates"
(let [figure-1 {:x 3, :y 1}
figure-2 {:x 7, :y 2}
figure-3 {:x 7, :y 2}
board (add-figure (add-figure (add-figure board
figure-1)
figure-2)
figure-3)]
(is (= (board :figures)
[{:x 3, :y 1, :id 0},
{:x 7, :y 2, :id 1},
{:x 7, :y 2, :id 2}]))
(is (= (get-figures-at board 3 1)
[{:x 3, :y 1, :id 0}]))
(is (= (get-figures-at board 7 2)
[{:x 7, :y 2, :id 1},
{:x 7, :y 2, :id 2}]))))
(testing "figures without coordinates"
(let [figure-1 {}
figure-2 {}
board (add-figure (add-figure board figure-1) figure-2)]
(is (= (board :figures) [{:id 0}, {:id 1}]))))))

(deftest relative-movement-to-offset-tests
(testing "forward movement"
(is (= (relative-movement-to-offset :forward :north) [ 0 -1]))
(is (= (relative-movement-to-offset :forward :west) [-1 0]))
(is (= (relative-movement-to-offset :forward :south) [ 0 1]))
(is (= (relative-movement-to-offset :forward :east) [ 1 0])))
(testing "backward movement"
(is (= (relative-movement-to-offset :backward :north) [ 0 1]))
(is (= (relative-movement-to-offset :backward :west) [ 1 0]))
(is (= (relative-movement-to-offset :backward :south) [ 0 -1]))
(is (= (relative-movement-to-offset :backward :east) [-1 0])))
(testing "left movement"
(is (= (relative-movement-to-offset :left :north) [-1 0]))
(is (= (relative-movement-to-offset :left :west) [ 0 1]))
(is (= (relative-movement-to-offset :left :south) [ 1 0]))
(is (= (relative-movement-to-offset :left :east) [ 0 -1])))
(testing "right movement"
(is (= (relative-movement-to-offset :right :north) [ 1 0]))
(is (= (relative-movement-to-offset :right :west) [ 0 -1]))
(is (= (relative-movement-to-offset :right :south) [-1 0]))
(is (= (relative-movement-to-offset :right :east) [ 0 1])))
(testing "forward-left movement"
(is (= (relative-movement-to-offset :forward-left :north) [-1 -1]))
(is (= (relative-movement-to-offset :forward-left :west) [-1 1]))
(is (= (relative-movement-to-offset :forward-left :south) [ 1 1]))
(is (= (relative-movement-to-offset :forward-left :east) [ 1 -1])))
(testing "forward-right movement"
(is (= (relative-movement-to-offset :forward-right :north) [ 1 -1]))
(is (= (relative-movement-to-offset :forward-right :west) [-1 -1]))
(is (= (relative-movement-to-offset :forward-right :south) [-1 1]))
(is (= (relative-movement-to-offset :forward-right :east) [ 1 1])))
(testing "backward-left movement"
(is (= (relative-movement-to-offset :backward-left :north) [-1 1]))
(is (= (relative-movement-to-offset :backward-left :west) [ 1 1]))
(is (= (relative-movement-to-offset :backward-left :south) [ 1 -1]))
(is (= (relative-movement-to-offset :backward-left :east) [-1 -1])))
(testing "backward-right movement"
(is (= (relative-movement-to-offset :backward-right :north) [ 1 1]))
(is (= (relative-movement-to-offset :backward-right :west) [ 1 -1]))
(is (= (relative-movement-to-offset :backward-right :south) [-1 -1]))
(is (= (relative-movement-to-offset :backward-right :east) [-1 1])))
)

(comment
(deftest figure-tests
(let [board (add-figure
(add-figure (set-field (set-field
(make-board 10 10) 3 2 {}) 5 2 {})
{:x 3, :y 2}) {:x 5, :y 2})]
(testing "figure by id"
(is (= (figure board 0) {:x 3, :y 2, :id 0}))
(is (= (figure board 1) {:x 5, :y 2, :id 1}))
(is (= (figure board 2) :foo)))
(testing "figure by coordinates"
(is (= (figure board 3 2) {:x 3, :y 2, :id 0}))
(is (= (figure board 5 2) {:x 5, :y 2, :id 1}))
(is (= (figure board 1 1) nil)))
))))
(deftest relative-movement-to-offset-tests
(testing "forward movement"
(is (= (relative-movement-to-offset :forward :north) [ 0 -1]))
(is (= (relative-movement-to-offset :forward :west) [-1 0]))
(is (= (relative-movement-to-offset :forward :south) [ 0 1]))
(is (= (relative-movement-to-offset :forward :east) [ 1 0])))
(testing "backward movement"
(is (= (relative-movement-to-offset :backward :north) [ 0 1]))
(is (= (relative-movement-to-offset :backward :west) [ 1 0]))
(is (= (relative-movement-to-offset :backward :south) [ 0 -1]))
(is (= (relative-movement-to-offset :backward :east) [-1 0])))
(testing "left movement"
(is (= (relative-movement-to-offset :left :north) [-1 0]))
(is (= (relative-movement-to-offset :left :west) [ 0 1]))
(is (= (relative-movement-to-offset :left :south) [ 1 0]))
(is (= (relative-movement-to-offset :left :east) [ 0 -1])))
(testing "right movement"
(is (= (relative-movement-to-offset :right :north) [ 1 0]))
(is (= (relative-movement-to-offset :right :west) [ 0 -1]))
(is (= (relative-movement-to-offset :right :south) [-1 0]))
(is (= (relative-movement-to-offset :right :east) [ 0 1])))
(testing "forward-left movement"
(is (= (relative-movement-to-offset :forward-left :north) [-1 -1]))
(is (= (relative-movement-to-offset :forward-left :west) [-1 1]))
(is (= (relative-movement-to-offset :forward-left :south) [ 1 1]))
(is (= (relative-movement-to-offset :forward-left :east) [ 1 -1])))
(testing "forward-right movement"
(is (= (relative-movement-to-offset :forward-right :north) [ 1 -1]))
(is (= (relative-movement-to-offset :forward-right :west) [-1 -1]))
(is (= (relative-movement-to-offset :forward-right :south) [-1 1]))
(is (= (relative-movement-to-offset :forward-right :east) [ 1 1])))
(testing "backward-left movement"
(is (= (relative-movement-to-offset :backward-left :north) [-1 1]))
(is (= (relative-movement-to-offset :backward-left :west) [ 1 1]))
(is (= (relative-movement-to-offset :backward-left :south) [ 1 -1]))
(is (= (relative-movement-to-offset :backward-left :east) [-1 -1])))
(testing "backward-right movement"
(is (= (relative-movement-to-offset :backward-right :north) [ 1 1]))
(is (= (relative-movement-to-offset :backward-right :west) [ 1 -1]))
(is (= (relative-movement-to-offset :backward-right :south) [-1 -1]))
(is (= (relative-movement-to-offset :backward-right :east) [-1 1])))
)

0 comments on commit 4500253

Please sign in to comment.