--- a/src/caves/core.clj Mon Jul 09 19:00:19 2012 -0400
+++ b/src/caves/core.clj Tue Jul 10 22:00:32 2012 -0400
@@ -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]
@@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/ui/core.clj Tue Jul 10 22:00:32 2012 -0400
@@ -0,0 +1,3 @@
+(ns caves.ui.core)
+
+(defrecord UI [kind])
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/ui/drawing.clj Tue Jul 10 22:00:32 2012 -0400
@@ -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))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/caves/ui/input.clj Tue Jul 10 22:00:32 2012 -0400
@@ -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)))
--- a/src/caves/world.clj Mon Jul 09 19:00:19 2012 -0400
+++ b/src/caves/world.clj Tue Jul 10 22:00:32 2012 -0400
@@ -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)))
@@ -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))