# HG changeset patch # User Steve Losh # Date 1341972032 14400 # Node ID 0e18cc5ab72620a72beedcbd469d1162ef365b9d # Parent 454c6e1c9cfd39f7eee5e2be655723c664091e0a Refactoring. diff -r 454c6e1c9cfd -r 0e18cc5ab726 src/caves/core.clj --- 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 diff -r 454c6e1c9cfd -r 0e18cc5ab726 src/caves/ui/core.clj --- /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]) diff -r 454c6e1c9cfd -r 0e18cc5ab726 src/caves/ui/drawing.clj --- /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)) diff -r 454c6e1c9cfd -r 0e18cc5ab726 src/caves/ui/input.clj --- /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))) diff -r 454c6e1c9cfd -r 0e18cc5ab726 src/caves/world.clj --- 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))