Refactor the drawing code a bit.
author |
Steve Losh <steve@stevelosh.com> |
date |
Fri, 13 Jul 2012 23:34:53 -0400 |
parents |
2a668110bcf8
|
children |
d4d14e381be0
|
branches/tags |
(none) |
files |
project.clj src/caves/core.clj src/caves/ui/drawing.clj src/caves/utils.clj |
Changes
--- 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
)
--- 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 []
--- 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))
--- /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)))