# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1341798931 14400
# Node ID 458886294f3c0f2eae1f29ba6e079ec8e610f16b
# Parent  53ae2d22f81845939f2a77cb4837a1f0d03a0253
Add scrolling

diff -r 53ae2d22f818 -r 458886294f3c src/caves/core.clj
--- 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))