Skip to content

Commit

Permalink
Refactoring.
Browse files Browse the repository at this point in the history
  • Loading branch information
sjl committed Jul 11, 2012
1 parent 1736646 commit aec137a
Show file tree
Hide file tree
Showing 5 changed files with 155 additions and 145 deletions.
145 changes: 4 additions & 141 deletions src/caves/core.clj
Original file line number Diff line number Diff line change
@@ -1,150 +1,13 @@
(ns caves.core
(:use [caves.world :only [random-world smooth-world]])
(:use [caves.ui.core :only [->UI]]
[caves.ui.drawing :only [draw-game]]
[caves.ui.input :only [get-input process-input]])
(:require [lanterna.screen :as s]))


; Constants -------------------------------------------------------------------
(def screen-size [80 24])

; Data Structures -------------------------------------------------------------
(defrecord UI [kind])
(defrecord Game [world uis input])

; Utility Functions -----------------------------------------------------------
(defn clear-screen [screen]
(let [[cols rows] screen-size
blank (apply str (repeat cols \space))]
(doseq [row (range rows)]
(s/put-string screen 0 row blank))))


; Drawing ---------------------------------------------------------------------
(defmulti draw-ui
(fn [ui game screen]
(:kind ui)))

(defmethod draw-ui :start [ui game screen]
(s/put-string screen 0 0 "Welcome to the Caves of Clojure!")
(s/put-string screen 0 1 "Press any key to continue.")
(s/put-string screen 0 2 "")
(s/put-string screen 0 3 "Once in the game, you can use enter to win,")
(s/put-string screen 0 4 "and backspace to lose."))

(defmethod draw-ui :win [ui game screen]
(s/put-string screen 0 0 "Congratulations, you win!")
(s/put-string screen 0 1 "Press escape to exit, anything else to restart."))

(defmethod draw-ui :lose [ui game screen]
(s/put-string screen 0 0 "Sorry, better luck next time.")
(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

tiles (:tiles (:world game))

map-rows (count tiles)
map-cols (count (first tiles))

start-x (- center-x (int (/ vcols 2)))
start-x (max 0 start-x)

start-y (- center-y (int (/ vrows 2)))
start-y (max 0 start-y)

end-x (+ start-x vcols)
end-x (min end-x map-cols)

end-y (+ start-y vrows)
end-y (min end-y map-rows)

start-x (- end-x vcols)
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-world [screen vrows vcols start-x start-y end-x end-y tiles]
(doseq [[vrow-idx mrow-idx] (map vector
(range 0 vrows)
(range start-y end-y))
:let [row-tiles (subvec (tiles mrow-idx) start-x end-x)]]
(doseq [vcol-idx (range vcols)
:let [{:keys [glyph color]} (row-tiles vcol-idx)]]
(s/put-string screen vcol-idx vrow-idx glyph {:fg color}))))

(defmethod draw-ui :play [ui game screen]
(let [world (:world game)
tiles (:tiles world)
[cols rows] screen-size
vcols cols
vrows (dec rows)
[start-x start-y end-x end-y] (get-viewport-coords game vcols vrows)]
(draw-world screen vrows vcols start-x start-y end-x end-y tiles)
(draw-crosshairs screen vcols vrows)))


(defn draw-game [game screen]
(clear-screen screen)
(doseq [ui (:uis game)]
(draw-ui ui game screen))
(s/redraw screen))


; Input -----------------------------------------------------------------------
(defmulti process-input
(fn [game input]
(:kind (last (:uis game)))))

(defmethod process-input :start [game input]
(-> game
(assoc :world (random-world))
(assoc :uis [(new UI :play)])))


(defn move [[x y] [dx dy]]
[(+ x dx) (+ y dy)])

(defmethod process-input :play [game input]
(case input
:enter (assoc game :uis [(new UI :win)])
:backspace (assoc game :uis [(new UI :lose)])
\q (assoc game :uis [])

\s (assoc game :world (smooth-world (:world game)))

\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])

game))

(defmethod process-input :win [game input]
(if (= input :escape)
(assoc game :uis [])
(assoc game :uis [(new UI :start)])))

(defmethod process-input :lose [game input]
(if (= input :escape)
(assoc game :uis [])
(assoc game :uis [(new UI :start)])))

(defn get-input [game screen]
(assoc game :input (s/get-key-blocking screen)))


; Main ------------------------------------------------------------------------
(defn run-game [game screen]
(loop [{:keys [input uis] :as game} game]
Expand All @@ -155,7 +18,7 @@
(recur (process-input (dissoc game :input) input))))))

(defn new-game []
(assoc (new Game nil [(new UI :start)] nil)
(assoc (->Game nil [(->UI :start)] nil)
:location [40 20]))

(defn main
Expand Down
3 changes: 3 additions & 0 deletions src/caves/ui/core.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
(ns caves.ui.core)

(defrecord UI [kind])
92 changes: 92 additions & 0 deletions src/caves/ui/drawing.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,92 @@
(ns caves.ui.drawing
(:require [lanterna.screen :as s]))


(def screen-size [80 24])

(defn clear-screen [screen]
(let [[cols rows] screen-size
blank (apply str (repeat cols \space))]
(doseq [row (range rows)]
(s/put-string screen 0 row blank))))


(defmulti draw-ui
(fn [ui game screen]
(:kind ui)))


(defmethod draw-ui :start [ui game screen]
(s/put-string screen 0 0 "Welcome to the Caves of Clojure!")
(s/put-string screen 0 1 "Press any key to continue.")
(s/put-string screen 0 2 "")
(s/put-string screen 0 3 "Once in the game, you can use enter to win,")
(s/put-string screen 0 4 "and backspace to lose."))


(defmethod draw-ui :win [ui game screen]
(s/put-string screen 0 0 "Congratulations, you win!")
(s/put-string screen 0 1 "Press escape to exit, anything else to restart."))


(defmethod draw-ui :lose [ui game screen]
(s/put-string screen 0 0 "Sorry, better luck next time.")
(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

tiles (:tiles (:world game))

map-rows (count tiles)
map-cols (count (first tiles))

start-x (- center-x (int (/ vcols 2)))
start-x (max 0 start-x)

start-y (- center-y (int (/ vrows 2)))
start-y (max 0 start-y)

end-x (+ start-x vcols)
end-x (min end-x map-cols)

end-y (+ start-y vrows)
end-y (min end-y map-rows)

start-x (- end-x vcols)
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-world [screen vrows vcols start-x start-y end-x end-y tiles]
(doseq [[vrow-idx mrow-idx] (map vector
(range 0 vrows)
(range start-y end-y))
:let [row-tiles (subvec (tiles mrow-idx) start-x end-x)]]
(doseq [vcol-idx (range vcols)
:let [{:keys [glyph color]} (row-tiles vcol-idx)]]
(s/put-string screen vcol-idx vrow-idx glyph {:fg color}))))

(defmethod draw-ui :play [ui game screen]
(let [world (:world game)
tiles (:tiles world)
[cols rows] screen-size
vcols cols
vrows (dec rows)
[start-x start-y end-x end-y] (get-viewport-coords game vcols vrows)]
(draw-world screen vrows vcols start-x start-y end-x end-y tiles)
(draw-crosshairs screen vcols vrows)))


(defn draw-game [game screen]
(clear-screen screen)
(doseq [ui (:uis game)]
(draw-ui ui game screen))
(s/redraw screen))
52 changes: 52 additions & 0 deletions src/caves/ui/input.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,52 @@
(ns caves.ui.input
(:use [caves.world :only [random-world smooth-world]]
[caves.ui.core :only [->UI]])
(:require [lanterna.screen :as s]))


(defmulti process-input
(fn [game input]
(:kind (last (:uis game)))))

(defmethod process-input :start [game input]
(-> game
(assoc :world (random-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])

game))

(defmethod process-input :win [game input]
(if (= input :escape)
(assoc game :uis [])
(assoc game :uis [(->UI :start)])))

(defmethod process-input :lose [game input]
(if (= input :escape)
(assoc game :uis [])
(assoc game :uis [(->UI :start)])))


(defn get-input [game screen]
(assoc game :input (s/get-key-blocking screen)))
8 changes: 4 additions & 4 deletions src/caves/world.clj
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,9 @@
(defrecord Tile [kind glyph color])

(def tiles
{:floor (new Tile :floor "." :white)
:wall (new Tile :wall "#" :white)
:bound (new Tile :bound "X" :black)})
{:floor (->Tile :floor "." :white)
:wall (->Tile :wall "#" :white)
:bound (->Tile :bound "X" :black)})

(defn get-tile [tiles x y]
(get-in tiles [y x] (:bound tiles)))
Expand Down Expand Up @@ -69,7 +69,7 @@


(defn random-world []
(let [world (new World (random-tiles))
(let [world (->World (random-tiles))
world (nth (iterate smooth-world world) 0)]
world))

0 comments on commit aec137a

Please sign in to comment.