1. Steve Losh
  2. caves

Commits

Steve Losh  committed f5fdc66

Refactor the drawing code a bit.

  • Participants
  • Parent commits 2a66811
  • Branches default

Comments (0)

Files changed (4)

File project.clj

View file
   :url "http://stevelosh.com/blog/2012/07/caves-of-clojure-01/"
   :license {:name "MIT/X11"}
   :dependencies [[org.clojure/clojure "1.4.0"]
-                 [clojure-lanterna "0.9.0"]]
+                 [clojure-lanterna "0.9.1"]
+                 [com.googlecode.lanterna/lanterna "2.0.1-SNAPSHOT"]]
 
+  :repositories {"sonatype-snapshots" "https://oss.sonatype.org/content/repositories/snapshots"}
   ; :main caves.core
 
   )

File src/caves/core.clj

View file
   (->Game nil [(->UI :start)] nil))
 
 (defn main
+  ([] (main :swing false))
   ([screen-type] (main screen-type false))
   ([screen-type block?]
    (letfn [(go []

File src/caves/ui/drawing.clj

View file
 (ns caves.ui.drawing
+  (:use [caves.utils :only (map2d shear)])
   (: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))))
-
-
+; Definitions -----------------------------------------------------------------
 (defmulti draw-ui
   (fn [ui game screen]
     (:kind ui)))
 
 
+; Start -----------------------------------------------------------------------
 (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."))
+  (s/put-sheet screen 0 0
+               ["Welcome to the Caves of Clojure!"
+                ""
+                "Press any key to continue."]))
 
 
+; Win -------------------------------------------------------------------------
 (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."))
+  (s/put-sheet screen 0 0
+               ["Congratulations, you win!"
+                "Press escape to exit, anything else to restart."]))
 
 
+; Lose ------------------------------------------------------------------------
 (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."))
+  (s/put-sheet screen 0 0
+               ["Sorry, better luck next time."
+                "Press escape to exit, anything else to restart."]))
 
 
-(defn get-viewport-coords [game player-location vcols vrows]
+; Play ------------------------------------------------------------------------
+(defn get-viewport-coords
+  "Find the top-left coordinates of the viewport in the overall map, centering on the player."
+  [game player-location vcols vrows]
   (let [[center-x center-y] player-location
 
         tiles (:tiles (:world game))
 
         start-x (- end-x vcols)
         start-y (- end-y vrows)]
-    [start-x start-y end-x end-y]))
+    [start-x start-y]))
+
+(defn get-viewport-coords-of
+  "Get the viewport coordiates for the given real coords, given the viewport start coords."
+  [start-x start-y coords]
+  (let [[cx cy] coords]
+    [(- cx start-x) (- cy start-y)]))
+
 
 (defn draw-hud [screen game start-x start-y]
-  (let [hud-row (dec (second screen-size))
+  (let [hud-row (dec (second (s/get-size screen)))
         [x y] (get-in game [:world :entities :player :location])
         info (str "loc: [" x "-" y "]")
         info (str info " start: [" start-x "-" start-y "]")]
     (s/put-string screen 0 hud-row info)))
 
+
 (defn draw-entity [screen start-x start-y {:keys [location glyph color]}]
-  (let [[entity-x entity-y] location
-        x (- entity-x start-x)
-        y (- entity-y start-y)]
-      (s/put-string screen x y glyph {:fg color})))
+  (let [[x y] (get-viewport-coords-of start-x start-y location)]
+    (s/put-string screen x y glyph {:fg color})))
 
-(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}))))
+
+(defn draw-world [screen vrows vcols start-x start-y tiles]
+  (letfn [(render-tile [tile]
+            [(:glyph tile) {:fg (:color tile)}])]
+    (let [tiles (shear tiles start-x start-y vcols vrows)
+          sheet (map2d render-tile tiles)]
+      (s/put-sheet screen 0 0 sheet))))
+
 
 (defn highlight-player [screen start-x start-y player]
-  (let [[player-x player-y] (:location player)
-        x (- player-x start-x)
-        y (- player-y start-y)]
+  (let [[x y] (get-viewport-coords-of start-x start-y (:location player))]
     (s/move-cursor screen x y)))
 
+
 (defmethod draw-ui :play [ui game screen]
   (let [world (:world game)
         {:keys [tiles entities]} world
         player (:player entities)
-        [cols rows] screen-size
+        [cols rows] (s/get-size screen)
         vcols cols
         vrows (dec rows)
-        [start-x start-y end-x end-y] (get-viewport-coords game (:location player) vcols vrows)]
-    (draw-world screen vrows vcols start-x start-y end-x end-y tiles)
+        [start-x start-y] (get-viewport-coords game (:location player) vcols vrows)]
+    (draw-world screen vrows vcols start-x start-y tiles)
     (doseq [entity (vals entities)]
       (draw-entity screen start-x start-y entity))
     (draw-hud screen game start-x start-y)
     (highlight-player screen start-x start-y player)))
 
 
+; Entire Game -----------------------------------------------------------------
 (defn draw-game [game screen]
-  (clear-screen screen)
+  (s/clear screen)
   (doseq [ui (:uis game)]
     (draw-ui ui game screen))
   (s/redraw screen))

File src/caves/utils.clj

View file
+(ns caves.utils)
+
+
+(defn map2d
+  "Map a function across a two-dimensional sequence."
+  [f s]
+  (map (partial map f) s))
+
+(defn slice
+  "Slice a sequence."
+  [s start width]
+  (->> s
+    (drop start)
+    (take width)))
+
+(defn shear
+  "Shear a two-dimensional sequence, returning a smaller one."
+  [s x y w h]
+  (map #(slice % x w)
+       (slice s y h)))