Last active
September 30, 2015 20:51
-
-
Save nasser/fe68ba72bbad8c9689e5 to your computer and use it in GitHub Desktop.
LIES core
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns lies.core | |
(:use arcadia.core | |
lies.messages) | |
(:require arcadia.messages | |
[clojure.edn :as edn])) | |
(defn- type? [t] | |
(isa? (type t) Type)) | |
(defn- type-map [m] | |
"{:foo 34 :bar :baz :qux \"quux\"} -> {:foo Int32 :bar clojure.lang.Keyword :qux String}" | |
(->> m | |
(mapcat (fn [[k v]] [k (if (type? v) v (type v))])) | |
(apply hash-map))) | |
(defn- holds? [hm assertion] | |
(= (type-map (select-keys hm (keys assertion))) | |
(type-map assertion))) | |
(defn- entity-merge [a b] | |
(if (and (vector? a) | |
(vector? b)) | |
(into a b) | |
b)) | |
(defn- arity? [f n] | |
(.HasArity f n)) | |
(defn- assumptions [f] | |
(if (arity? f 0) | |
(f) | |
{})) | |
(defn realize-token [t] | |
(cond | |
(fn? t) t | |
;; (t x y) -> realize t, apply to x y | |
(list? t) | |
(apply (realize-token (first t)) | |
(rest t)) | |
;; t -> resolve t, require namespace if needed | |
(symbol? t) | |
(deref | |
(or (resolve t) | |
(and | |
(namespace t) | |
(do | |
(-> t namespace symbol require) | |
(resolve t))) | |
(throw (ArgumentException. | |
(str "Symbol " t " does not resolve"))))) | |
:else (throw (ArgumentException. (str "Can only realize fns, lists, or symbols. Got " t))))) | |
(defn realize [v] | |
(mapv realize-token v)) | |
;; TODO use arcadia.messages for full set? | |
(def unity-message-keywords | |
#{:start :update}) | |
(defn entity | |
"Make a new entity. Takes any number of maps or entities and merges them, | |
concating vectors with into" | |
[& specs] | |
(let [merged-entity (apply | |
(partial merge-with entity-merge {}) | |
specs)] | |
(reduce-kv | |
(fn [m k v] | |
(if (unity-message-keywords k) | |
(let [realized-fns (realize v)] | |
(-> (apply merge m (map assumptions realized-fns)) | |
(assoc k realized-fns))) | |
(assoc m k v))) | |
merged-entity | |
merged-entity))) | |
(defn read-entity [f] | |
(entity | |
(edn/read-string | |
(slurp f :encoding "utf8")))) | |
(defn run-logic [e kw go] | |
(let [logics (e kw)] | |
(reduce | |
(fn [e* logic] | |
(logic e* go)) | |
e | |
logics))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{:update [(fake-take-damage 20) | |
(regenerate-health 100) | |
(max-health 100)]} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defmacro ∆ [x] | |
`(* Time/deltaTime ~x)) | |
(def initial-health {:health 100}) | |
(defn fake-take-damage [d] | |
(fn [self go] | |
(update self :health - d))) | |
(defn take-damage | |
([] initial-health) | |
([{:keys [id] :as self} go] | |
(let [total-damage (transduce | |
(keep :damage) + | |
(inbox id))] | |
(update self :health - total-damage)))) | |
(defn regenerate-health [rate] | |
(fn | |
([] initial-health) | |
([self go] | |
(update self :health + (∆ rate))))) | |
(defn max-health [m] | |
(fn | |
([] initial-health) | |
([{:keys [health] :as self} go] | |
(if (> health m) | |
(assoc self :health m) | |
self)))) | |
(let [e (entity | |
{:name "ramsey"} | |
(read-entity "Assets/lies/data.edn"))] | |
(-> e | |
(run-logic :update nil) | |
(run-logic :update nil) | |
:health)) | |
;; 60.0019999999495 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment