458886294f3c
Add scrolling
author | Steve Losh <steve@stevelosh.com> |
---|---|
date | Sun, 08 Jul 2012 21:55:31 -0400 |
parents | 53ae2d22f818 |
children | d621976b4a1b |
branches/tags | (none) |
files | src/caves/core.clj |
Changes
--- a/src/caves/core.clj Sun Jul 08 20:43:28 2012 -0400 +++ b/src/caves/core.clj Sun Jul 08 21:55:31 2012 -0400 @@ -38,21 +38,46 @@ (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.")) -(defmethod draw-ui :play [ui {{:keys [tiles]} :world :as game} screen] - (let [[cols rows] screen-size +(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 (max 0 (- center-x (int (/ vcols 2)))) + start-y (max 0 (- center-y (int (/ vrows 2)))) + + 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])) + +(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 0 - start-y 0 - end-x (+ start-x vcols) - end-y (+ start-y vrows)] + [start-x start-y end-x end-y] (get-viewport-coords game vcols vrows)] (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}))))) + (s/put-string screen vcol-idx vrow-idx glyph {:fg color}))) + (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-game [game screen] (clear-screen screen) @@ -71,11 +96,28 @@ (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)]) - \s (assoc game :world (smooth-world (:world game))) + :backspace (assoc game :uis [(new UI :win)]) + \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] @@ -102,7 +144,8 @@ (recur (process-input (dissoc game :input) input)))))) (defn new-game [] - (new Game nil [(new UI :start)] nil)) + (assoc (new Game nil [(new UI :start)] nil) + :location [40 20])) (defn main ([screen-type] (main screen-type false))