# HG changeset patch # User Steve Losh # Date 1342236893 14400 # Node ID f5fdc662f11f8a89e534aa11fdf0f47f6a09884e # Parent 2a668110bcf811ea1f580e641d95bbfbdd44dd85 Refactor the drawing code a bit. diff -r 2a668110bcf8 -r f5fdc662f11f project.clj --- a/project.clj Fri Jul 13 00:57:10 2012 -0400 +++ b/project.clj Fri Jul 13 23:34:53 2012 -0400 @@ -3,8 +3,10 @@ :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 ) diff -r 2a668110bcf8 -r f5fdc662f11f src/caves/core.clj --- a/src/caves/core.clj Fri Jul 13 00:57:10 2012 -0400 +++ b/src/caves/core.clj Fri Jul 13 23:34:53 2012 -0400 @@ -28,6 +28,7 @@ (->Game nil [(->UI :start)] nil)) (defn main + ([] (main :swing false)) ([screen-type] (main screen-type false)) ([screen-type block?] (letfn [(go [] diff -r 2a668110bcf8 -r f5fdc662f11f src/caves/ui/drawing.clj --- a/src/caves/ui/drawing.clj Fri Jul 13 00:57:10 2012 -0400 +++ b/src/caves/ui/drawing.clj Fri Jul 13 23:34:53 2012 -0400 @@ -1,40 +1,40 @@ (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)) @@ -56,53 +56,59 @@ 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)) diff -r 2a668110bcf8 -r f5fdc662f11f src/caves/utils.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/caves/utils.clj Fri Jul 13 23:34:53 2012 -0400 @@ -0,0 +1,20 @@ +(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)))