dee99c486fc1
Initial commit
author | Steve Losh <steve@stevelosh.com> |
---|---|
date | Sat, 12 Dec 2015 15:44:46 +0000 |
parents | |
children | 92c64081b5f8 |
branches/tags | (none) |
files | .hgignore README.md project.clj src/silt/core.clj |
Changes
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgignore Sat Dec 12 15:44:46 2015 +0000 @@ -0,0 +1,10 @@ +syntax:glob +target +classes +checkouts +pom.xml +pom.xml.asc +*.jar +*.class +.lein-* +.nrepl-port
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/README.md Sat Dec 12 15:44:46 2015 +0000 @@ -0,0 +1,36 @@ +# silt + +FIXME: description + +## Installation + +Download from http://example.com/FIXME. + +## Usage + +FIXME: explanation + + $ java -jar silt-0.1.0-standalone.jar [args] + +## Options + +FIXME: listing of options this app accepts. + +## Examples + +... + +### Bugs + +... + +### Any Other Sections +### That You Think +### Might be Useful + +## License + +Copyright © 2015 FIXME + +Distributed under the Eclipse Public License either version 1.0 or (at +your option) any later version.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/project.clj Sat Dec 12 15:44:46 2015 +0000 @@ -0,0 +1,12 @@ +(defproject silt "0.1.0-SNAPSHOT" + :description "FIXME: write description" + :url "http://example.com/FIXME" + :license {:name "Eclipse Public License" + :url "http://www.eclipse.org/legal/epl-v10.html"} + :dependencies [[org.clojure/clojure "1.7.0"] + [clojure-lanterna "0.9.5"] + [roul "0.2.0"] + ] + :main ^:skip-aot silt.core + :target-path "target/%s" + :profiles {:uberjar {:aot :all}})
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/silt/core.clj Sat Dec 12 15:44:46 2015 +0000 @@ -0,0 +1,147 @@ +(ns silt.core + (:require [lanterna.screen :as s] + [roul.random :as rr] + [clojure.stacktrace :refer [print-stack-trace]]) + (:gen-class)) + + +; Data ------------------------------------------------------------------------ +(def fps 20) +(def world-width 600) +(def world-height 400) + +(def screen (s/get-screen :swing)) +(defonce running (atom true)) +(def window-loc (ref [0 0])) +(defonce last-timestamp (atom 0)) + +(defonce terrain (ref [])) +(def terrain-rate 1) +(def terrain-objects + [{:name :rock :glyph "*"} + {:name :shrub :glyph "%"}]) + +(def landmarks (ref + #{{:name :monolith :glyph "#" :loc [0 0] :styles {:fg :black :bg :yellow}} + {:name :colossus :glyph "@" :loc [200 100] :styles {:fg :black :bg :red}} + })) + + +; Utils ----------------------------------------------------------------------- +(defmacro while-let [binding-form & body] + `(loop [] + (when-let ~binding-form + ~@body + (recur)))) + + +; World Generation ------------------------------------------------------------ +(defn generate-terrain [] + (for [x (range world-width) + y (range world-height) + :when (rr/rand-bool terrain-rate)] + (assoc (rr/rand-nth terrain-objects) + :loc [x y]))) + +(defn reset-terrain! [] + (let [new-terrain (generate-terrain)] + (dosync + (ref-set terrain new-terrain)) + nil)) + + +; Drawing --------------------------------------------------------------------- +(defn normalize-coord [v limit] + (cond + (< v 0) (normalize-coord (+ limit v) limit) + (>= v limit) (normalize-coord (- v limit) limit) + :else v)) + +(defn normalize-world-coords [[wx wy]] + [(normalize-coord wx world-width) + (normalize-coord wy world-height)]) + +(defn calc-screen-coords [[wx wy]] + (let [[ox oy] @window-loc] + (normalize-world-coords [(- wx ox) (- wy oy)]))) + +(defn draw-terrain! [screen] + (let [[swidth sheight] (s/get-size screen)] + (doseq [{:keys [loc glyph]} @terrain + :let [[sx sy] (calc-screen-coords loc)] + :when (and (< -1 sx swidth) + (< -1 sy sheight))] + (s/put-string screen sx sy glyph)))) + +(defn draw-landmarks! [screen] + (let [[swidth sheight] (s/get-size screen)] + (doseq [{:keys [loc glyph styles]} @landmarks + :let [[sx sy] (calc-screen-coords loc)] + :when (and (< -1 sx swidth) + (< -1 sy sheight))] + (s/put-string screen sx sy glyph styles)))) + +(defn draw-screen! [screen] + (s/clear screen) + (draw-terrain! screen) + (draw-landmarks! screen) + (s/put-string screen (- (nth (s/get-size screen) 0) 7) 0 " SILT ") + (s/move-cursor screen (- (nth (s/get-size screen) 0) 6) 0) + (s/redraw screen)) + + +; Input ----------------------------------------------------------------------- +(defn move-window! [key] + (dosync + (commute window-loc + #(let [[x y] %1] + (case %2 + :up [x (dec y)] + :down [x (inc y)] + :left [(dec x) y] + :right [(inc x) y])) + key))) + +(defn handle-input! [screen] + (while-let [key (s/get-key screen)] + (case key + :escape (reset! running false) + (:up :down :left :right) (move-window! key) + nil))) + + +; Game loop ------------------------------------------------------------------- +(defn throttle! [] + (let [current (System/currentTimeMillis) + sofar (- current @last-timestamp) + desired (/ 1000 fps) + wait (- desired sofar)] + (reset! last-timestamp current) + (if (> wait 0) + (Thread/sleep wait)))) + +(defn main-loop [] + (s/in-screen + screen + (while @running + (draw-screen! screen) + (handle-input! screen) + (throttle!))) + (reset! running true)) + + +; Scratch --------------------------------------------------------------------- +(defn -main + "I don't do a whole lot ... yet." + [& args] + (println "Hello, World!")) + +(comment + (reset! running false) + (reset! running true) + + (reset-terrain!) + + (future (main-loop)) + + )