dee99c486fc1

Initial commit
[view raw] [browse files]
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))
+
+  )