Have to start being more leGit about this hehe :3
This commit is contained in:
69
.clj-kondo/buddho/macros/dhamma.clj
Normal file
69
.clj-kondo/buddho/macros/dhamma.clj
Normal file
@@ -0,0 +1,69 @@
|
|||||||
|
(ns buddho.macros.dhamma
|
||||||
|
(:require [clojure.set :as set]))
|
||||||
|
|
||||||
|
(defmacro defconstructor
|
||||||
|
[dh-name & {:keys [meta data defaults dh-defaults]
|
||||||
|
:or {meta {} data {} dh-defaults {}}}]
|
||||||
|
`(defn ~(symbol (str dh-name "!"))
|
||||||
|
[& {:keys [~@(concat (keys meta) (keys data)) ~'dh-args]
|
||||||
|
:or ~defaults}]
|
||||||
|
(#'buddho.core.dhamma/register-dhamma!
|
||||||
|
~(keyword dh-name)
|
||||||
|
(merge
|
||||||
|
~(merge {:name (keyword dh-name)}
|
||||||
|
dh-defaults
|
||||||
|
{:data (set/map-invert data)}
|
||||||
|
{:meta {(keyword dh-name) (set/map-invert meta)}})
|
||||||
|
~'dh-args))))
|
||||||
|
|
||||||
|
(defn extraction-bindings [datasym bindings extractor defaults]
|
||||||
|
`(~datasym
|
||||||
|
(~extractor
|
||||||
|
[~'dhamma ~'parent]
|
||||||
|
~defaults)
|
||||||
|
|
||||||
|
~@(mapcat (fn [[k v]] `(~k (~v ~datasym))) bindings)))
|
||||||
|
|
||||||
|
(defmacro defdhamma [name docstring
|
||||||
|
{:keys [data meta
|
||||||
|
defaults
|
||||||
|
dh-defaults
|
||||||
|
meta-as data-as]
|
||||||
|
:or {defaults {}}}
|
||||||
|
& body]
|
||||||
|
(let [kw (keyword name)
|
||||||
|
default-data
|
||||||
|
(->> data
|
||||||
|
(map (fn [[k v]] [v (defaults k)]))
|
||||||
|
(into {}))
|
||||||
|
default-meta
|
||||||
|
(->> meta
|
||||||
|
(map (fn [[k v]] [v (defaults k)]))
|
||||||
|
(into {}))]
|
||||||
|
`(do
|
||||||
|
(defconstructor ~name
|
||||||
|
:data ~data
|
||||||
|
:meta ~meta
|
||||||
|
:dh-defaults ~dh-defaults
|
||||||
|
:defaults ~defaults)
|
||||||
|
|
||||||
|
(#'buddho.core.state/describe-dhamma!
|
||||||
|
~kw
|
||||||
|
~docstring)
|
||||||
|
|
||||||
|
(defmethod buddho.core.dhamma/impl! ~kw ~(symbol (str "impl-" name))
|
||||||
|
[~'dhamma & [~'parent]]
|
||||||
|
(let [~@(when (or data data-as)
|
||||||
|
(extraction-bindings
|
||||||
|
(or data-as `data#)
|
||||||
|
data
|
||||||
|
'#'buddho.core.dhamma/extract-data
|
||||||
|
default-data))
|
||||||
|
|
||||||
|
~@(when (or meta meta-as)
|
||||||
|
(extraction-bindings
|
||||||
|
(or meta-as `meta#)
|
||||||
|
meta
|
||||||
|
'#'buddho.core.dhamma/extract-meta
|
||||||
|
default-meta))]
|
||||||
|
~@body)))))
|
@@ -1,16 +1,4 @@
|
|||||||
{:linters
|
{:linters
|
||||||
|
|
||||||
;; {:clojure-lsp/unused-public-var
|
|
||||||
;; {:level :warning
|
|
||||||
;; :exclude #{sekai.macros.components/defcomponent
|
|
||||||
;; my-ns/bar
|
|
||||||
;; other-ns
|
|
||||||
;; my-func}
|
|
||||||
;; :exclude-regex #{"sekai.macros.components/*"}
|
|
||||||
;; :exclude-when-defined-by #{my-ns/defflow}
|
|
||||||
;; :exclude-when-defined-by-regex #{"sekai.macros.components/*"}
|
|
||||||
;; :exclude-when-contains-meta #{:my-cool-meta}}}
|
|
||||||
|
|
||||||
{
|
{
|
||||||
:unresolved-symbol
|
:unresolved-symbol
|
||||||
{:exclude [(sekai.macros.components/defcomponent)]}
|
{:exclude [(sekai.macros.components/defcomponent)]}
|
||||||
@@ -23,6 +11,14 @@
|
|||||||
:exclude-when-defined-by-regex #{"sekai.macros.components/*"}
|
:exclude-when-defined-by-regex #{"sekai.macros.components/*"}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
:hooks
|
:hooks
|
||||||
{:analyze-call {sekai.macros.components/defcomponent
|
{:macroexpand {buddho.macros.dhamma/defconstructor
|
||||||
|
buddho.macros.dhamma/defconstructor
|
||||||
|
|
||||||
|
buddho.macros.dhamma/defdhamma
|
||||||
|
buddho.macros.dhamma/defdhamma
|
||||||
|
}
|
||||||
|
|
||||||
|
:analyze-call {sekai.macros.components/defcomponent
|
||||||
hooks.macros.components/defcomponent}}}
|
hooks.macros.components/defcomponent}}}
|
||||||
|
File diff suppressed because one or more lines are too long
7
docs/README.org
Normal file
7
docs/README.org
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
#+title: Buddho Game Engine
|
||||||
|
|
||||||
|
* Index
|
||||||
|
** [[./concepts.org][Concepts]]
|
||||||
|
Overview of concepts used in the engine, with links to more detailed descriptions.
|
||||||
|
** [[./systems.org][Subsystems]]
|
||||||
|
An index of different components that together form the engine.
|
18
docs/concepts.org
Normal file
18
docs/concepts.org
Normal file
@@ -0,0 +1,18 @@
|
|||||||
|
#+title: Concepts
|
||||||
|
|
||||||
|
* [[./dhamma.org][Dhamma]]
|
||||||
|
A dhamma is anything that can "occur"; think of them as encompassing "functions", "events", "systems" and the like.
|
||||||
|
** Fields
|
||||||
|
A dhamma has the following fields:
|
||||||
|
- =name=: This is the /type/ of the dhamma; it encodes the /meaning/ of the dhamma, meaning /what actually happens/ when this dhamma occurs.
|
||||||
|
- =data=: Data held by the dhamma; a generic field.
|
||||||
|
- =meta=: Metadata for the dhamma; this is used when we need to encode data about /how a dhamma is executed/, whereas the
|
||||||
|
- =data=: field encodes what a dhamma is executed /on/.
|
||||||
|
- =asp-props=: /Aspect properties/; these are used to encode which dhamma are /aspects of/ this dhamma. Think of them as categories; one dhamma keeps a list of its aspect properties, and other dhammas track which aspect properties they "subscribe" to. See also [[file:./dhamma.org::*Aspects][Aspects]].
|
||||||
|
- =is-aspect-of?=: A function which takes as arguments this very =dhamma= and a =parent= and returns whether this =dhamma= should be considered an aspect of =parent=. This is used to apply more fine-grained filtering of aspects /after/ checking aspect properties.
|
||||||
|
- =transient=: A boolean that is true when a dhamma should occur as an aspect only once, and false when it should keep reoccurring until it is explicitly removed.
|
||||||
|
** Implementation
|
||||||
|
A dhamma's /implementation/ is a function which takes itself and optionally a =parent= and actually executes whichever action the dhamma stands for.
|
||||||
|
** Aspects
|
||||||
|
Aspects are dhamma; when we say a dhamma is an aspect of another, we mean that the /aspect/ dhamma occurs in the context of a /parent/ dhamma, occurring after the implementation of the parent and with access to the data of its parent.
|
||||||
|
Aspects serve the role of allowing /composition/ of dhamma. Allowing this composition to happen dynamically is a core feature of the engine.
|
4
docs/dhamma.org
Normal file
4
docs/dhamma.org
Normal file
@@ -0,0 +1,4 @@
|
|||||||
|
#+title: Dhamma
|
||||||
|
* Dhamma
|
||||||
|
Dhamma are what "occurs". They encapsulate "things happening" in the engine. Thus within Buddho, we always think of execution, flow control, state change and so forth as happening /in the context of dhamma/. We do not use raw
|
||||||
|
* Aspects
|
5
docs/systems.org
Normal file
5
docs/systems.org
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
#+title: Systems
|
||||||
|
* State
|
||||||
|
* Dhamma
|
||||||
|
* Describe
|
||||||
|
* Graphics
|
BIN
public/assets/test.png
Normal file
BIN
public/assets/test.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 287 B |
@@ -12,5 +12,5 @@
|
|||||||
:builds
|
:builds
|
||||||
{:frontend
|
{:frontend
|
||||||
{:target :browser
|
{:target :browser
|
||||||
:modules {:main {:init-fn sekai.core.init/init}}
|
:modules {:main {:init-fn buddho.core.init/init}}
|
||||||
}}}
|
}}}
|
||||||
|
83
src/clj/buddho/macros/dhamma.clj
Normal file
83
src/clj/buddho/macros/dhamma.clj
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
(ns buddho.macros.dhamma
|
||||||
|
(:require [clojure.set :as set]))
|
||||||
|
|
||||||
|
(defmacro defconstructor
|
||||||
|
[dh-name & {:keys [meta data defaults dh-defaults]
|
||||||
|
:or {meta {} data {} dh-defaults {}}}]
|
||||||
|
`(defn ~(symbol (str dh-name "!"))
|
||||||
|
[& {:keys [~@(concat (keys meta) (keys data)) ~'dh-args]
|
||||||
|
:or ~defaults}]
|
||||||
|
(#'buddho.core.dhamma/register-dhamma!
|
||||||
|
~(keyword dh-name)
|
||||||
|
(merge
|
||||||
|
~(merge {:name (keyword dh-name)}
|
||||||
|
dh-defaults
|
||||||
|
{:data (set/map-invert data)}
|
||||||
|
{:meta {(keyword dh-name) (set/map-invert meta)}})
|
||||||
|
~'dh-args))))
|
||||||
|
|
||||||
|
(defn extraction-bindings [datasym bindings extractor defaults]
|
||||||
|
`(~datasym
|
||||||
|
(~extractor
|
||||||
|
[~'dhamma ~'parent]
|
||||||
|
~defaults)
|
||||||
|
|
||||||
|
~@(mapcat (fn [[k v]] `(~k (~v ~datasym))) bindings)))
|
||||||
|
|
||||||
|
(defmacro defdhamma [name docstring
|
||||||
|
{:keys [data meta
|
||||||
|
defaults
|
||||||
|
dh-defaults
|
||||||
|
meta-as data-as]
|
||||||
|
:or {defaults {}}}
|
||||||
|
& body]
|
||||||
|
(let [kw (keyword name)
|
||||||
|
default-data
|
||||||
|
(->> data
|
||||||
|
(map (fn [[k v]] [v (defaults k)]))
|
||||||
|
(into {}))
|
||||||
|
default-meta
|
||||||
|
(->> meta
|
||||||
|
(map (fn [[k v]] [v (defaults k)]))
|
||||||
|
(into {}))]
|
||||||
|
`(do
|
||||||
|
(defconstructor ~name
|
||||||
|
:data ~data
|
||||||
|
:meta ~meta
|
||||||
|
:dh-defaults ~dh-defaults
|
||||||
|
:defaults ~defaults)
|
||||||
|
|
||||||
|
(#'buddho.core.state/describe-dhamma!
|
||||||
|
~kw
|
||||||
|
~docstring)
|
||||||
|
|
||||||
|
(defmethod buddho.core.dhamma/impl! ~kw ~(symbol (str "impl-" name))
|
||||||
|
[~'dhamma & [~'parent]]
|
||||||
|
(let [~@(when (or data data-as)
|
||||||
|
(extraction-bindings
|
||||||
|
(or data-as `data#)
|
||||||
|
data
|
||||||
|
'#'buddho.core.dhamma/extract-data
|
||||||
|
default-data))
|
||||||
|
|
||||||
|
~@(when (or meta meta-as)
|
||||||
|
(extraction-bindings
|
||||||
|
(or meta-as `meta#)
|
||||||
|
meta
|
||||||
|
'#'buddho.core.dhamma/extract-meta
|
||||||
|
default-meta))]
|
||||||
|
~@body)))))
|
||||||
|
|
||||||
|
;; Example:
|
||||||
|
|
||||||
|
'(defdhamma
|
||||||
|
make-sprite
|
||||||
|
"Make a cool sprite!"
|
||||||
|
{:data {url :sprite-url}
|
||||||
|
:meta {thing :some-field}
|
||||||
|
:defaults {thing "value"}}
|
||||||
|
|
||||||
|
(make-the-sprite-with url)
|
||||||
|
(become-epic thing)
|
||||||
|
(println "bf is cute!")
|
||||||
|
(with-return parent :bf-cuteness 6969))
|
@@ -24,14 +24,26 @@
|
|||||||
;;; TODO things this is an aspect of
|
;;; TODO things this is an aspect of
|
||||||
(let [idea (s/value idea)
|
(let [idea (s/value idea)
|
||||||
aspects (d/aspects-of idea)
|
aspects (d/aspects-of idea)
|
||||||
format-dh (fn [dh] (str "<" (:name (s/value dh)) " " dh ">"))
|
format-singleton #(if (s/has-property? % [:dhamma :singleton]) "{S} " "{T} ")
|
||||||
|
format-dh
|
||||||
|
(fn [dh] (str "<" (format-singleton dh)
|
||||||
|
(:name (s/value dh)) " "
|
||||||
|
dh ">"))
|
||||||
asp-strs (map (fn [[prop dhs]]
|
asp-strs (map (fn [[prop dhs]]
|
||||||
(str prop " -> " (string/join ", " (map format-dh dhs))))
|
(str prop
|
||||||
|
" -> "
|
||||||
|
(#(if (empty? %1) %2 %1)
|
||||||
|
(string/join ", " (map format-dh dhs))
|
||||||
|
"(none)")))
|
||||||
aspects)]
|
aspects)]
|
||||||
(str
|
(str
|
||||||
"Name:\t\t" (:name idea) "\n"
|
"Name:\t\t" (:name idea) "\n"
|
||||||
|
(s/dh-desc (:name idea)) "\n"
|
||||||
"Aspects:\t" (string/join "\n\t\t\t" asp-strs) "\n"
|
"Aspects:\t" (string/join "\n\t\t\t" asp-strs) "\n"
|
||||||
"Data:\t\t" (:data idea)
|
"Data:\t\t" (:data idea) "\n"
|
||||||
|
"Meta:\t\t" (:meta idea) "\n"
|
||||||
|
"Transient?:\t" (:transient idea)
|
||||||
|
|
||||||
)))
|
)))
|
||||||
|
|
||||||
(s/describe-property! [:dhamma] "Idea is a dhamma." descr-dhamma-fn)
|
(s/describe-property! [:dhamma] "Idea is a dhamma." descr-dhamma-fn)
|
||||||
|
@@ -1,81 +0,0 @@
|
|||||||
(ns buddho.core.dhamma
|
|
||||||
(:require [buddho.core.state :as s :refer [value reference state]]
|
|
||||||
[clojure.set :refer [union]]))
|
|
||||||
|
|
||||||
(defn register-aspect! [dhamma asp-prop]
|
|
||||||
(s/register-property! (reference dhamma) [:_aspect_of asp-prop]))
|
|
||||||
|
|
||||||
(defn remove-aspect! [dhamma asp-prop]
|
|
||||||
(s/remove-property! (reference dhamma) [:_aspect_of asp-prop]))
|
|
||||||
|
|
||||||
(defn make-dhamma
|
|
||||||
"Helper function to make dhamma object. You may want `register-dhamma!` instead."
|
|
||||||
[name & {:keys [data is-aspect-of? cascade asp-props transient]
|
|
||||||
:or {data {} is-aspect-of? (constantly true)
|
|
||||||
cascade [] asp-props [[name] [:dhamma]]
|
|
||||||
transient true}}]
|
|
||||||
(hash-map :name name
|
|
||||||
:data data
|
|
||||||
:asp-props asp-props
|
|
||||||
:is-aspect-of? is-aspect-of?
|
|
||||||
:cascade cascade
|
|
||||||
:transient transient))
|
|
||||||
|
|
||||||
(defn register-dhamma!
|
|
||||||
"Register a dhamma."
|
|
||||||
[name & {:keys [data is-aspect-of? cascade asp-props transient]
|
|
||||||
:as args}]
|
|
||||||
(let [idea (s/have-idea! "dhamma_")
|
|
||||||
dhamma (make-dhamma
|
|
||||||
name
|
|
||||||
args)]
|
|
||||||
(s/update-idea! idea dhamma)
|
|
||||||
(s/register-property! idea [:dhamma])))
|
|
||||||
|
|
||||||
(defn remove-dhamma! [dhamma]
|
|
||||||
(s/forget-idea! dhamma))
|
|
||||||
|
|
||||||
;; TODO better error handling
|
|
||||||
(defn copy [dhamma] (assoc (value dhamma) :_reference nil))
|
|
||||||
|
|
||||||
(defn get-data [dhamma key] (get-in dhamma [:data key]))
|
|
||||||
(defn assoc-data [dhamma key value] (assoc-in (copy dhamma) [:data key] value))
|
|
||||||
|
|
||||||
(defn add-cascade [dhamma & cascades]
|
|
||||||
(update-in (copy (value dhamma)) [:cascade]
|
|
||||||
#(into [] (concat % cascades))))
|
|
||||||
|
|
||||||
(defn get-aspects [asp-prop]
|
|
||||||
(loop [as asp-prop
|
|
||||||
acc []]
|
|
||||||
(if (empty? as)
|
|
||||||
acc
|
|
||||||
(recur (butlast as)
|
|
||||||
(union acc (s/with-property [:_aspect_of as]))))))
|
|
||||||
|
|
||||||
(defmulti is-aspect-of? (fn [dhamma _whole] (s/apply-fn :name dhamma)))
|
|
||||||
(defmethod is-aspect-of? :default [dhamma whole]
|
|
||||||
(s/apply-fn (s/apply-fn :is-aspect-of? (value dhamma)) (value whole)))
|
|
||||||
|
|
||||||
(defn aspects-of [dhamma]
|
|
||||||
(let [asp-props (->> dhamma value :asp-props)
|
|
||||||
filter-fn #(is-aspect-of? % dhamma)
|
|
||||||
aspects (map
|
|
||||||
#(->> % get-aspects (filter filter-fn))
|
|
||||||
asp-props)]
|
|
||||||
(zipmap asp-props aspects)))
|
|
||||||
|
|
||||||
(defmulti impl! (fn [dhamma & [_whole]] (:name (value dhamma))))
|
|
||||||
;; TODO should be an error
|
|
||||||
(defmethod impl! :default [_dhamma & [_whole]]
|
|
||||||
(println "default occur"))
|
|
||||||
|
|
||||||
(defn occur! [dhamma & [whole]]
|
|
||||||
(let [processed (reduce #(occur! %2 %1)
|
|
||||||
(copy dhamma)
|
|
||||||
(flatten (vals (aspects-of dhamma))))
|
|
||||||
processed (impl! (value processed) (when whole (value whole)))]
|
|
||||||
(run! #(occur! %1 processed) (:cascade processed))
|
|
||||||
(when-not (:transient processed)
|
|
||||||
(remove-dhamma! dhamma))
|
|
||||||
processed))
|
|
49
src/cljs/buddho/core/dhamma/aspects.cljs
Normal file
49
src/cljs/buddho/core/dhamma/aspects.cljs
Normal file
@@ -0,0 +1,49 @@
|
|||||||
|
(ns buddho.core.dhamma.aspects
|
||||||
|
"Facilities for querying and manipulating dhamma aspects."
|
||||||
|
(:require [buddho.core.state :as s :refer [value reference]]
|
||||||
|
[buddho.core.dhamma.data :refer [mutate]]
|
||||||
|
[clojure.set :refer [union]]))
|
||||||
|
|
||||||
|
(defn register-aspect! [dhamma & asp-props]
|
||||||
|
(doseq [prop asp-props]
|
||||||
|
(s/register-property! (reference dhamma) [:_aspect_of prop])))
|
||||||
|
|
||||||
|
(defn remove-aspect! [dhamma & asp-props]
|
||||||
|
(doseq [prop asp-props]
|
||||||
|
(s/remove-property! (reference dhamma) [:_aspect_of prop])))
|
||||||
|
|
||||||
|
(defmulti is-aspect-of? (fn [dhamma _parent] (s/apply-fn :name dhamma)))
|
||||||
|
(defmethod is-aspect-of? :default [dhamma parent]
|
||||||
|
(s/apply-fn (s/apply-fn :is-aspect-of? (value dhamma)) (value parent)))
|
||||||
|
|
||||||
|
(defn get-aspects [asp-prop]
|
||||||
|
(loop [as asp-prop
|
||||||
|
acc []]
|
||||||
|
(if (empty? as)
|
||||||
|
acc
|
||||||
|
(recur (butlast as)
|
||||||
|
(union acc (s/with-property [:_aspect_of as]))))))
|
||||||
|
(defn aspects-of
|
||||||
|
"Get aspects of `dhamma`.
|
||||||
|
Returns a map of {asp-prop => #{dhamma}}."
|
||||||
|
[dhamma]
|
||||||
|
(let [asp-props (->> dhamma value :asp-props)
|
||||||
|
filter-fn #(is-aspect-of? % dhamma)
|
||||||
|
aspects (map
|
||||||
|
#(->> % get-aspects (filter filter-fn))
|
||||||
|
asp-props)]
|
||||||
|
(zipmap asp-props aspects)))
|
||||||
|
|
||||||
|
(defn pop-asp-stage
|
||||||
|
"Get aspects of next stage of dhamma evaluation.
|
||||||
|
Returns a tuple of #{asp-dhammas} and a copy of `dhamma` with its first asp-prop removed."
|
||||||
|
[dhamma]
|
||||||
|
(let [asp-props (->> dhamma value :asp-props)
|
||||||
|
aspects (filter #(is-aspect-of? % dhamma)
|
||||||
|
(get-aspects (first asp-props)))
|
||||||
|
modified (mutate dhamma
|
||||||
|
#(assoc % :asp-props (rest asp-props)))]
|
||||||
|
(list aspects modified)))
|
||||||
|
|
||||||
|
(defn has-aspect? [dhamma asp]
|
||||||
|
(some #(= asp (take (count asp) %)) (-> dhamma value :asp-props)))
|
77
src/cljs/buddho/core/dhamma/data.cljs
Normal file
77
src/cljs/buddho/core/dhamma/data.cljs
Normal file
@@ -0,0 +1,77 @@
|
|||||||
|
(ns buddho.core.dhamma.data
|
||||||
|
"Facilities for creating and manipulating dhamma objects."
|
||||||
|
(:require [buddho.core.state :refer [value copy]]))
|
||||||
|
|
||||||
|
(defn make-dhamma
|
||||||
|
"Helper function to make dhamma object. You may want `register-dhamma!` instead."
|
||||||
|
[name & {:keys [data meta is-aspect-of? asp-props transient]
|
||||||
|
:or {data {} meta {} is-aspect-of? (constantly true)
|
||||||
|
asp-props [[:dhamma name]]
|
||||||
|
transient true}}]
|
||||||
|
(hash-map :name name
|
||||||
|
:data data
|
||||||
|
:meta meta
|
||||||
|
:asp-props asp-props
|
||||||
|
:is-aspect-of? is-aspect-of?
|
||||||
|
;; XXX idk if necessary but just to be sure
|
||||||
|
:transient (not (false? transient))))
|
||||||
|
|
||||||
|
(defn get-field
|
||||||
|
[field]
|
||||||
|
(fn [dhamma & keys]
|
||||||
|
(get-in (and dhamma (value dhamma))
|
||||||
|
(vec (concat [field] keys)))))
|
||||||
|
|
||||||
|
(defn- vecify [ks] (vec (flatten [ks])))
|
||||||
|
|
||||||
|
(defn assoc-field [field]
|
||||||
|
(fn [dhamma keys value]
|
||||||
|
(let [k (concat [field] (vecify keys))]
|
||||||
|
(assoc-in (copy dhamma) k value))))
|
||||||
|
|
||||||
|
(def ^{:arglists '([dhamma & keys])}
|
||||||
|
get-data
|
||||||
|
"Get value given by `keys` in :data field of `dhamma`."
|
||||||
|
(get-field :data))
|
||||||
|
|
||||||
|
(def ^{:arglists '([dhamma & keys])}
|
||||||
|
get-meta
|
||||||
|
"Get value given by `keys` in :data field of `dhamma`."
|
||||||
|
(get-field :meta))
|
||||||
|
|
||||||
|
(def ^{:arglists '([dhamma keys value])}
|
||||||
|
assoc-data
|
||||||
|
"Associate one or more fields given by `keys` in :data field to `value` in copy of `dhamma`."
|
||||||
|
(assoc-field :data))
|
||||||
|
|
||||||
|
(def ^{:arglists '([dhamma keys value])}
|
||||||
|
assoc-meta
|
||||||
|
"Associate one or more fields given by `keys` in :meta field to `value` in copy of `dhamma`."
|
||||||
|
(assoc-field :meta))
|
||||||
|
|
||||||
|
(defn extract-field
|
||||||
|
"Extract metadata given in `defaults` from dhamma in `options` within `namespace`.
|
||||||
|
Returns first non-nil value for each."
|
||||||
|
[field]
|
||||||
|
(fn [options namespace defaults]
|
||||||
|
(let [fun (or namespace identity)]
|
||||||
|
(->> (reverse options)
|
||||||
|
(map #(-> % value field fun))
|
||||||
|
(apply merge-with #(or %2 %1) (or defaults {}))))))
|
||||||
|
|
||||||
|
(defn extract-meta
|
||||||
|
"Extract _metadata_ given in `defaults` from dhamma in `options` within `namespace`.
|
||||||
|
Returns first non-nil value for each."
|
||||||
|
[options & [defaults namespace]]
|
||||||
|
((extract-field :meta) options namespace defaults))
|
||||||
|
|
||||||
|
(defn extract-data
|
||||||
|
"Extract _data_ given in `defaults` from dhamma in `options` within `namespace`.
|
||||||
|
Returns first non-nil value for each."
|
||||||
|
[options & [defaults namespace]]
|
||||||
|
((extract-field :data) options namespace defaults))
|
||||||
|
|
||||||
|
(defn mutate
|
||||||
|
"Mutate a copy of `dhamma` using `fun`."
|
||||||
|
[dhamma fun]
|
||||||
|
(fun (copy dhamma)))
|
39
src/cljs/buddho/core/dhamma/occur.cljs
Normal file
39
src/cljs/buddho/core/dhamma/occur.cljs
Normal file
@@ -0,0 +1,39 @@
|
|||||||
|
(ns buddho.core.dhamma.occur
|
||||||
|
"Implementation of dhamma occurence mechanism."
|
||||||
|
(:require [buddho.core.state :as s :refer [value]]
|
||||||
|
[buddho.core.dhamma.aspects :refer [pop-asp-stage]]
|
||||||
|
[buddho.core.dhamma.data :refer [make-dhamma]]))
|
||||||
|
|
||||||
|
(defmulti impl!
|
||||||
|
"Execute `dhamma`'s action in the context of `_parent`.
|
||||||
|
Returns (potentially modified) `_parent`.
|
||||||
|
Exists only as a component of [[occur!]]; implement but do not call this!"
|
||||||
|
(fn [dhamma & [_parent]] (:name (value dhamma))))
|
||||||
|
|
||||||
|
;; XXX should this be an error?
|
||||||
|
(defmethod impl! :default [_dhamma & [parent]]
|
||||||
|
(println "default occur")
|
||||||
|
parent)
|
||||||
|
|
||||||
|
(def root-dhamma (make-dhamma :root))
|
||||||
|
|
||||||
|
(defn occur!
|
||||||
|
"Execute `dhamma` in the context of `parent`, applying aspects to `dhamma` according to its :asp-props.
|
||||||
|
Returns (potentially modified) `parent`."
|
||||||
|
[dhamma & [parent]]
|
||||||
|
(loop [dh (value dhamma)
|
||||||
|
parent (or parent root-dhamma)]
|
||||||
|
(let [cur (first (:asp-props dh))
|
||||||
|
[aspects dh] (pop-asp-stage dh)
|
||||||
|
;; Execute aspects, potentially modifying dh
|
||||||
|
dh (reduce #(occur! %2 %1) dh aspects)
|
||||||
|
;; If it's time for `dhamma`'s implementation to run, do so,
|
||||||
|
;; potentially modifying `parent`.
|
||||||
|
parent (if (= cur [:dhamma (:name dh)])
|
||||||
|
(impl! dh parent)
|
||||||
|
parent)]
|
||||||
|
|
||||||
|
;; Recur if there's remaining aspects, otherwise return `parent`.
|
||||||
|
(if (not-empty (:asp-props dh))
|
||||||
|
(recur dh parent)
|
||||||
|
parent))))
|
25
src/cljs/buddho/core/dhamma/return.cljs
Normal file
25
src/cljs/buddho/core/dhamma/return.cljs
Normal file
@@ -0,0 +1,25 @@
|
|||||||
|
(ns buddho.core.dhamma.return
|
||||||
|
"Facilities for returning values to parent dhamma."
|
||||||
|
(:require [buddho.core.dhamma.data :as data]))
|
||||||
|
|
||||||
|
;; TODO rewrite this module because it's weird shit
|
||||||
|
|
||||||
|
(defn return-value
|
||||||
|
"Get return value for `field` and key sequence `keys` on `dhamma`.
|
||||||
|
Defaults to last modified value whenever possible."
|
||||||
|
[dhamma & [field & keys]]
|
||||||
|
(apply data/get-meta
|
||||||
|
(or dhamma {})
|
||||||
|
(concat [(or field
|
||||||
|
(data/get-meta dhamma :_latest_return))]
|
||||||
|
[:_return] (or keys [:_latest]))))
|
||||||
|
|
||||||
|
;; TODO always set latest
|
||||||
|
(defn with-return
|
||||||
|
"Set the return `value` for `field` on `dhamma`."
|
||||||
|
[dhamma field value]
|
||||||
|
(let [dh (data/assoc-meta (or dhamma {}) :_latest_return field)]
|
||||||
|
(data/assoc-meta
|
||||||
|
dh
|
||||||
|
(conj [field] :_return)
|
||||||
|
(merge (return-value dhamma field) value))))
|
19
src/cljs/buddho/core/dhamma/state.cljs
Normal file
19
src/cljs/buddho/core/dhamma/state.cljs
Normal file
@@ -0,0 +1,19 @@
|
|||||||
|
(ns buddho.core.dhamma.state
|
||||||
|
"Facilities for managing dhamma registration in state memory."
|
||||||
|
(:require [buddho.core.state :as s :refer [value reference]]
|
||||||
|
[buddho.core.dhamma.data :refer [make-dhamma]]))
|
||||||
|
|
||||||
|
(defn register-dhamma!
|
||||||
|
"Register a dhamma."
|
||||||
|
[name & {:keys [data meta is-aspect-of? asp-props transient]
|
||||||
|
:as args}]
|
||||||
|
(let [idea (s/have-idea! "dhamma_")
|
||||||
|
dhamma (make-dhamma name args)]
|
||||||
|
(s/update-idea! idea dhamma)
|
||||||
|
(s/register-property! idea [:dhamma])))
|
||||||
|
|
||||||
|
(defn remove-dhamma! [dhamma]
|
||||||
|
(s/forget-idea! dhamma))
|
||||||
|
|
||||||
|
(defn update-dhamma! [dhamma fun]
|
||||||
|
(s/update-idea! (reference dhamma) (fun (value dhamma))))
|
@@ -2,11 +2,50 @@
|
|||||||
(:require [buddho.core.pixi :as pixi]
|
(:require [buddho.core.pixi :as pixi]
|
||||||
[buddho.core.state :as s]))
|
[buddho.core.state :as s]))
|
||||||
|
|
||||||
(defn make-canvas! [width height]
|
|
||||||
(pixi/make-canvas! width height))
|
|
||||||
|
|
||||||
(defn clear-canvas! []
|
(defn clear-canvas! []
|
||||||
(pixi/clear-canvas!))
|
(pixi/clear-canvas!))
|
||||||
|
|
||||||
(defn make-sprite! [url]
|
(defn make-sprite! [url]
|
||||||
(pixi/make-sprite! url))
|
(pixi/make-sprite! url))
|
||||||
|
|
||||||
|
(defn world [] (pixi/world))
|
||||||
|
|
||||||
|
(defn add-sprite! [sprite] (pixi/add-sprite! sprite))
|
||||||
|
|
||||||
|
(defn screen-meta [] (s/singleton-value [:meta :screen]))
|
||||||
|
(defn set-screen-meta! [width height]
|
||||||
|
(s/set-singleton! [:meta :screen] {:width width :height height}))
|
||||||
|
|
||||||
|
(defn render-meta [] (s/singleton-value [:meta :render]))
|
||||||
|
(defn set-render-meta! [tile-size]
|
||||||
|
(s/set-singleton! [:meta :render] {:tile-size tile-size}))
|
||||||
|
|
||||||
|
|
||||||
|
(defn make-canvas! [& [width height]]
|
||||||
|
(let [screen (screen-meta)
|
||||||
|
width (or width (:width screen))
|
||||||
|
height (or height (:height screen))]
|
||||||
|
(pixi/make-canvas! width height)))
|
||||||
|
|
||||||
|
(defn screen-center []
|
||||||
|
(let [screen (screen-meta)]
|
||||||
|
{:x (-> screen :width (/ 2))
|
||||||
|
:y (-> screen :height (/ 2))}))
|
||||||
|
|
||||||
|
(defn camera [] (s/singleton-value [:meta :camera]))
|
||||||
|
(defn set-camera! [x y]
|
||||||
|
(s/set-singleton! [:meta :camera] {:x x :y y}))
|
||||||
|
|
||||||
|
(defn translate-screen [{sx :x sy :y} {bx :x by :y bz :z}]
|
||||||
|
(let [tile (:tile-size (s/singleton-value [:meta :render]))
|
||||||
|
halftile (/ tile 2)
|
||||||
|
trans-x (map #(* bx %) [tile (- halftile)])
|
||||||
|
trans-y (map #(* by %) [(- tile) (- halftile)])
|
||||||
|
trans-z (map #(* bz %) [0 tile])
|
||||||
|
trans [[sx sy] trans-x trans-y trans-z]]
|
||||||
|
{:x (apply + (map first trans))
|
||||||
|
:y (apply + (map second trans))}))
|
||||||
|
|
||||||
|
(defn world->screen [{:keys [x y z]}]
|
||||||
|
(translate-screen (camera) {:x (- x) :y (- y) :z (- z)}))
|
||||||
|
@@ -1,65 +1,21 @@
|
|||||||
(ns buddho.core.init
|
(ns buddho.core.init
|
||||||
(:require [buddho.core.state :as s]
|
(:require [buddho.core.state :as s]
|
||||||
[buddho.core.dhamma :as d]
|
[buddho.core.dhamma :as d]
|
||||||
[buddho.core.graphics :as g]))
|
[buddho.core.graphics :as g]
|
||||||
|
[buddho.core.space :as sp]))
|
||||||
|
|
||||||
(defn init []
|
(defn init []
|
||||||
;;; reset game state
|
;; reset game state
|
||||||
(s/reset-state!)
|
(s/reset-state!)
|
||||||
(g/clear-canvas!)
|
(g/clear-canvas!)
|
||||||
(g/make-canvas! 512 512)
|
|
||||||
|
|
||||||
|
;; Game metadata
|
||||||
|
(g/set-screen-meta! 512 512)
|
||||||
|
(g/set-render-meta! 32)
|
||||||
|
(g/set-camera! 0 0)
|
||||||
|
|
||||||
;;; old wip
|
;; Initialize the screen
|
||||||
|
(g/make-canvas!)
|
||||||
|
|
||||||
(let [canvas (pixi/make-canvas! 512 512)
|
;;;
|
||||||
bunny (entity/register-entity! "bunny")
|
)
|
||||||
world (PIXI/Container.)]
|
|
||||||
|
|
||||||
;;; remove old view
|
|
||||||
(when-let [old-view
|
|
||||||
(-> "game-view"
|
|
||||||
js/document.getElementsByClassName
|
|
||||||
(.item 0))]
|
|
||||||
(.remove old-view))
|
|
||||||
|
|
||||||
;;; Add canvas and world container
|
|
||||||
(swap! game-state update-in [:canvas] assoc :canvas canvas)
|
|
||||||
(swap! game-state update-in [:canvas] assoc :world world)
|
|
||||||
|
|
||||||
(.appendChild js/document.body (.-view canvas))
|
|
||||||
(.addChild (.-stage canvas) world)
|
|
||||||
(set! (.-className (.-view canvas)) "game-view")
|
|
||||||
|
|
||||||
;;; Scaling
|
|
||||||
(set! (.-SCALE_MODE (.-settings PIXI)) (.-NEAREST (.-SCALE_MODES PIXI)))
|
|
||||||
(.set (-> canvas .-stage .-scale) 2)
|
|
||||||
|
|
||||||
(doseq [x (range -12 12)
|
|
||||||
y (range -12 12)
|
|
||||||
z (range -3 0)]
|
|
||||||
(let [eid (entity/register-entity! (str "block[" x "," y "].e"))
|
|
||||||
color (nth '("" "_red" "_green")
|
|
||||||
(mod y 3))]
|
|
||||||
|
|
||||||
(comp/attach!
|
|
||||||
(comp/position x y z)
|
|
||||||
eid)
|
|
||||||
|
|
||||||
(comp/attach!
|
|
||||||
(comp/sprite (str "/assets/prart_tile_square_32x32" color ".png"))
|
|
||||||
eid)))
|
|
||||||
|
|
||||||
(comp/attach!
|
|
||||||
(comp/position 0 0 -4)
|
|
||||||
bunny)
|
|
||||||
|
|
||||||
(comp/attach!
|
|
||||||
(comp/sprite "https://pixijs.com/assets/bunny.png")
|
|
||||||
bunny)
|
|
||||||
|
|
||||||
(let [ticker (.-ticker canvas)]
|
|
||||||
(.remove ticker render/render!)
|
|
||||||
(.add ticker render/render!))
|
|
||||||
|
|
||||||
(println canvas)))
|
|
||||||
|
@@ -1,21 +1,47 @@
|
|||||||
(ns buddho.core.meta
|
(ns buddho.core.meta
|
||||||
(:require [buddho.core.dhamma :as d]))
|
(:require [buddho.core.dhamma :as d]
|
||||||
|
[buddho.core.state :as s]))
|
||||||
|
|
||||||
(def registry (atom {}))
|
(s/describe-property! [:dhamma :singleton] "Dhamma is a singleton.")
|
||||||
|
|
||||||
|
(def empty-registry {:meta {}
|
||||||
|
:singletons {}
|
||||||
|
:singleton-fns {}})
|
||||||
|
|
||||||
|
(defonce registry (atom empty-registry))
|
||||||
|
|
||||||
(defn register-meta! [name & {:keys [aspects singleton-fn]}]
|
(defn register-meta! [name & {:keys [aspects singleton-fn]}]
|
||||||
(swap! registry update-in [:meta] assoc name
|
(swap! registry update-in [:meta] assoc name
|
||||||
{:aspects (or aspects {})
|
{:aspects (or aspects {})
|
||||||
:singleton (boolean singleton-fn)})
|
:singleton (boolean singleton-fn)})
|
||||||
(when singleton-fn
|
(when singleton-fn
|
||||||
(swap! registry update-in [:singletons] assoc name singleton-fn)))
|
(swap! registry update-in [:singleton-fns] assoc name singleton-fn)))
|
||||||
|
|
||||||
(defn implement-meta! []
|
(defn instantiate-singletons! []
|
||||||
(doseq [[name fun] (:singletons @registry)]
|
(doseq [[name fun] (:singleton-fns @registry)]
|
||||||
(swap! registry update-in [:reified] assoc name (fun)))
|
(when-not (-> @registry :singletons name)
|
||||||
|
(let [dhamma (s/reference (fun))]
|
||||||
|
(swap! registry update-in [:singletons] assoc name dhamma)
|
||||||
|
(s/register-property! dhamma [:dhamma :singleton])))))
|
||||||
|
|
||||||
|
(defn free-singletons! []
|
||||||
|
(doseq [[_name dhamma] (:singletons @registry)]
|
||||||
|
(d/remove-dhamma! dhamma)))
|
||||||
|
|
||||||
|
(defn reset-registry! []
|
||||||
|
(free-singletons!)
|
||||||
|
(reset! registry empty-registry))
|
||||||
|
|
||||||
|
;; TODO proper error handling when registry not complete
|
||||||
|
(defn implement-aspects! []
|
||||||
(doseq [[name meta] (:meta @registry)]
|
(doseq [[name meta] (:meta @registry)]
|
||||||
(doseq [[stage asps] (:aspects meta)]
|
(doseq [[stage asps] (:aspects meta)]
|
||||||
(doseq [aspect asps]
|
(doseq [aspect asps]
|
||||||
(d/register-aspect!
|
(let [singleton (get-in @registry [:singletons aspect])
|
||||||
(get-in @registry [:reified aspect])
|
property (vec (concat stage [name]))]
|
||||||
(vec (concat stage [name])))))))
|
(d/register-aspect! singleton property))))))
|
||||||
|
|
||||||
|
(defn implement-meta! []
|
||||||
|
(free-singletons!)
|
||||||
|
(instantiate-singletons!)
|
||||||
|
(implement-aspects!))
|
||||||
|
@@ -37,3 +37,12 @@
|
|||||||
|
|
||||||
(defn make-sprite! [url]
|
(defn make-sprite! [url]
|
||||||
(-> PIXI .-Sprite (.from url)))
|
(-> PIXI .-Sprite (.from url)))
|
||||||
|
|
||||||
|
(defn world []
|
||||||
|
(-> (s/with-property [:world])
|
||||||
|
first
|
||||||
|
s/value
|
||||||
|
:object))
|
||||||
|
|
||||||
|
(defn add-sprite! [sprite]
|
||||||
|
(.addChild ^js/PIXI.Container (world) sprite))
|
||||||
|
2
src/cljs/buddho/core/space.cljs
Normal file
2
src/cljs/buddho/core/space.cljs
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
(ns buddho.core.space
|
||||||
|
(:require [buddho.core.state :as s]))
|
@@ -41,6 +41,9 @@ mind that keys are functions.")
|
|||||||
|
|
||||||
(defn apply-fn [fn idea] (fn-liberal idea fn))
|
(defn apply-fn [fn idea] (fn-liberal idea fn))
|
||||||
|
|
||||||
|
;; TODO better error handling
|
||||||
|
(defn copy [idea] (assoc (value idea) :_reference nil))
|
||||||
|
|
||||||
(defn- register-idea! [iid]
|
(defn- register-idea! [iid]
|
||||||
(swap! state assoc-in [iid :_properties] #{})
|
(swap! state assoc-in [iid :_properties] #{})
|
||||||
(swap! state assoc-in [iid :_reference] iid)
|
(swap! state assoc-in [iid :_reference] iid)
|
||||||
@@ -124,6 +127,9 @@ mind that keys are functions.")
|
|||||||
(when fun
|
(when fun
|
||||||
(swap! state assoc-in [:_descriptions :property-fn property] fun)))
|
(swap! state assoc-in [:_descriptions :property-fn property] fun)))
|
||||||
|
|
||||||
|
(defn describe-dhamma! [dh-kw description]
|
||||||
|
(swap! state assoc-in [:_descriptions :dhamma dh-kw] description))
|
||||||
|
|
||||||
(defn prop-desc [prop & [idea]]
|
(defn prop-desc [prop & [idea]]
|
||||||
(let [desc (get-in @state [:_descriptions :property prop])]
|
(let [desc (get-in @state [:_descriptions :property prop])]
|
||||||
|
|
||||||
@@ -131,6 +137,19 @@ mind that keys are functions.")
|
|||||||
(str desc "\n" (fun idea))
|
(str desc "\n" (fun idea))
|
||||||
desc)))
|
desc)))
|
||||||
|
|
||||||
|
(defn dh-desc [dh-kw]
|
||||||
|
(get-in @state [:_descriptions :dhamma dh-kw]))
|
||||||
|
|
||||||
|
(defn singleton-value [property]
|
||||||
|
(when-let [idea (first (with-property property))]
|
||||||
|
(value idea)))
|
||||||
|
|
||||||
|
;; TODO error handling in case multiple singletons/exact match
|
||||||
|
(defn set-singleton! [property data]
|
||||||
|
(let [idea (or (singleton-value property) (have-idea!))]
|
||||||
|
(update-idea! idea data)
|
||||||
|
(register-property! idea property)))
|
||||||
|
|
||||||
(defn reset-state! []
|
(defn reset-state! []
|
||||||
(reset! state empty-state)
|
(reset! state empty-state)
|
||||||
(describe-property! [:_properties] "Property-to-idea mapping.")
|
(describe-property! [:_properties] "Property-to-idea mapping.")
|
||||||
|
@@ -2,8 +2,4 @@
|
|||||||
(:require [buddho.core.meta :as meta]
|
(:require [buddho.core.meta :as meta]
|
||||||
[buddho.core.dhamma :as d]))
|
[buddho.core.dhamma :as d]))
|
||||||
|
|
||||||
|
|
||||||
(defmethod d/impl! :print [dhamma & [_whole]]
|
|
||||||
(println (:data dhamma)))
|
|
||||||
|
|
||||||
(defmethod d/impl! :no-op [])
|
(defmethod d/impl! :no-op [])
|
||||||
|
@@ -1,16 +1,23 @@
|
|||||||
(ns buddho.dhamma.graphics
|
(ns buddho.dhamma.graphics
|
||||||
(:require [buddho.core.meta :as meta]
|
(:require [buddho.core.meta :as meta]
|
||||||
[buddho.core.dhamma :as d]
|
[buddho.core.dhamma :as d]
|
||||||
[buddho.core.graphics :as g]))
|
[buddho.core.state :as s]
|
||||||
|
[buddho.core.graphics :as g])
|
||||||
|
(:require-macros [buddho.macros.dhamma :refer [defdhamma defconstructor]]))
|
||||||
|
|
||||||
(defn create-sprite! []
|
|
||||||
(d/register-dhamma! :create-sprite :transient nil))
|
|
||||||
|
|
||||||
;;; TODO render to actual screen
|
|
||||||
(defmethod d/impl! :create-sprite [_dhamma & [whole]]
|
|
||||||
(let [url (-> whole :data :sprite-url)
|
|
||||||
sprite (g/make-sprite! url)]
|
|
||||||
(d/assoc-data whole :sprite sprite)))
|
|
||||||
|
|
||||||
(meta/register-meta! :create-sprite
|
;; TODO placeholder url goes nowhere
|
||||||
:singleton-fn create-sprite!)
|
;; (defdhamma create-sprite
|
||||||
|
;; "Create a sprite from a URL.
|
||||||
|
;; The [:create-sprite :url] metadata determines what URL is used."
|
||||||
|
;; {:meta [return-field]
|
||||||
|
;; :data [sprite-url]
|
||||||
|
;; :defaults {:sprite-url "assets/error.png"
|
||||||
|
;; :return-field :_latest}
|
||||||
|
;; :default-data {:sprite-url "assets/error.png"}
|
||||||
|
;; :default-meta {:return-field :_latest}}
|
||||||
|
;; (let [sprite (g/make-sprite! sprite-url)]
|
||||||
|
;; (g/add-sprite! sprite)
|
||||||
|
;; (d/with-return parent :create-sprite
|
||||||
|
;; {return-field sprite})))
|
||||||
|
@@ -1,38 +1,23 @@
|
|||||||
(ns buddho.dhamma.state
|
(ns buddho.dhamma.state
|
||||||
(:require [buddho.core.dhamma :as d]
|
(:require [buddho.core.dhamma :as d]
|
||||||
[buddho.core.meta :as meta]
|
[buddho.core.meta :as meta]
|
||||||
[buddho.core.state :as s]))
|
[buddho.core.state :as s]
|
||||||
|
[sekai.math.vectors :as vect])
|
||||||
|
(:require-macros [buddho.macros.dhamma :refer [defdhamma]]))
|
||||||
|
|
||||||
(defn dh-have-idea
|
(defdhamma have-idea
|
||||||
[n-ideas
|
"Create an idea out of data in a dhamma.
|
||||||
& {:keys [data is-aspect-of? cascade asp-props transient]
|
The [:have-idea :fields] metadata determines which fields are used.
|
||||||
:as args}]
|
Mind: pulls _fields_ from only *one* dhamma, but will pull _data_ from *both* dhamma!"
|
||||||
(d/make-dhamma
|
{:meta {return-field :return-field
|
||||||
:have-idea
|
fields :fields}
|
||||||
:data {:n-ideas n-ideas}
|
:defaults {return-field :_latest}
|
||||||
(update args :data #(merge {:n-ideas n-ideas} %))))
|
:data-as all-data}
|
||||||
|
|
||||||
(defn have-idea!
|
;; TODO error if no fields specified
|
||||||
[n-ideas
|
(let [idea (s/have-idea!)
|
||||||
& {:keys [data is-aspect-of? cascade asp-props transient]
|
; fields (or fields (keys all-data))
|
||||||
:as args}]
|
data (zipmap fields (map all-data fields))]
|
||||||
(d/register-dhamma!
|
(s/update-idea! idea data)
|
||||||
:have-idea
|
(d/with-return parent :have-idea
|
||||||
:transient nil
|
{return-field idea})))
|
||||||
:data {:n-ideas n-ideas}
|
|
||||||
(update args :data #(merge {:n-ideas n-ideas} %))))
|
|
||||||
|
|
||||||
(defmethod d/impl! :have-idea [dhamma & [whole]]
|
|
||||||
(let [n-ideas (or (d/get-data dhamma :n-ideas)
|
|
||||||
(d/get-data whole :n-ideas)
|
|
||||||
1)]
|
|
||||||
(d/assoc-data whole :ideas (repeatedly n-ideas s/have-idea!))))
|
|
||||||
|
|
||||||
(meta/register-meta!
|
|
||||||
:have-idea
|
|
||||||
:singleton-fn #(have-idea! nil))
|
|
||||||
|
|
||||||
|
|
||||||
(defmethod d/impl! :store-idea [dhamma & [whole]]
|
|
||||||
(let [])
|
|
||||||
)
|
|
||||||
|
@@ -1,19 +1,19 @@
|
|||||||
(ns buddho.dhamma.world.block
|
(ns buddho.dhamma.world.block
|
||||||
(:require [buddho.core.dhamma :as d]
|
(:require [buddho.core.dhamma :as d]
|
||||||
[buddho.core.meta :as meta]
|
[buddho.core.meta :as meta]
|
||||||
[buddho.dhamma.state :as s]))
|
[buddho.dhamma.graphics :as gr]
|
||||||
|
[buddho.dhamma.state :as st]
|
||||||
|
[buddho.core.state :refer [value]])
|
||||||
|
(:require-macros [buddho.macros.dhamma :refer [defdhamma defconstructor]]))
|
||||||
|
|
||||||
(meta/register-meta!
|
(defdhamma create-block
|
||||||
:create-block
|
"tmp"
|
||||||
:aspects {[:_construct] [:create-sprite :have-idea]})
|
{:data [x y sprite-url]}
|
||||||
(defn create-block!
|
(let [sprite (-> (gr/create-sprite!)
|
||||||
[x y sprite-url & asp-props]
|
(d/occur! dhamma)
|
||||||
(d/register-dhamma!
|
d/return-value)
|
||||||
:create-block
|
idea (-> (st/have-idea! :fields [:sprite]
|
||||||
:data {:x x :y y :sprite-url sprite-url
|
:data {:sprite sprite})
|
||||||
:n-ideas 1}
|
d/occur!)]
|
||||||
:asp-props (concat [[:_construct :create-block]
|
idea
|
||||||
[:create-block]]
|
))
|
||||||
asp-props)
|
|
||||||
;; TODO
|
|
||||||
:cascade []))
|
|
||||||
|
Reference in New Issue
Block a user