uhh idk

src/cljs/buddho/core/describe.cljs

@@ -0,0 +1,38 @@
+(ns buddho.core.describe
+  (:require [buddho.core.state :as s]
+            [buddho.core.dhamma :as d]
+            [clojure.string :as string]))
+
+(defn description-of [property & [idea]]
+  (loop [prop property
+         ctx {}]
+    (let [desc (s/prop-desc prop idea)]
+      (if-not (seq prop)
+        ctx
+        (recur (vec (butlast prop)) (assoc ctx prop desc))))))
+
+(defn description [idea]
+  (->> (s/properties idea)
+       (map #(description-of % idea))
+       (apply merge)))
+
+(defn describe [idea]
+  (doseq [[prop desc] (description idea)]
+    (println prop "=>" desc)))
+
+(defn descr-dhamma-fn [idea]
+  ;;; TODO things this is an aspect of
+  (let [idea (s/value idea)
+        aspects (d/aspects-of idea)
+        format-dh (fn [dh] (str "<" (:name (s/value dh)) " " dh ">"))
+        asp-strs (map (fn [[prop dhs]]
+                        (str prop " -> " (string/join ", " (map format-dh dhs))))
+                      aspects)]
+    (str
+     "Name:\t\t" (:name idea) "\n"
+     "Aspects:\t" (string/join "\n\t\t\t" asp-strs) "\n"
+     "Data:\t\t" (:data idea)
+     )))
+
+(s/describe-property! [:dhamma] "Idea is a dhamma." descr-dhamma-fn)
+"foo"

src/cljs/buddho/core/dhamma.cljs

@@ -2,34 +2,48 @@
   (: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 usually want `register-dhamma!` instead."
+  "Helper function to make dhamma object. You may want `register-dhamma!` instead."
-  [name source data asp-props consequences is-aspect-of? modify-whole priority]
+  [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
-            :source source
             :data data
             :asp-props asp-props
-            :consequences consequences
             :is-aspect-of? is-aspect-of?
-            :modify-whole modify-whole
+            :cascade cascade
-            :priority priority))
+            :transient transient))
 
 (defn register-dhamma!
   "Register a dhamma."
-  [name source & {:keys [data consequences is-aspect-of? modify-whole asp-props priority]
+  [name & {:keys [data is-aspect-of? cascade asp-props transient]
-                  :or {data {} consequences [] is-aspect-of? (constantly true)
+           :as args}]
-                       modify-whole identity asp-props [] priority 0}}]
+  (let [idea (s/have-idea! "dhamma_")
-  (let [id (gensym "dhamma_")
         dhamma (make-dhamma
-                name source data (conj asp-props [name])
+                name
-                consequences is-aspect-of? modify-whole priority)]
+                args)]
-    (s/register-idea! id dhamma)))
+    (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 dhamma [:data key] value))
+(defn assoc-data [dhamma key value] (assoc-in (copy dhamma) [:data key] value))
 
-(defn register-aspect! [did asp-prop]
+(defn add-cascade [dhamma & cascades]
-  (s/register-property! did [:_aspect_of asp-prop]))
+  (update-in (copy (value dhamma)) [:cascade]
+             #(into [] (concat % cascades))))
 
 (defn get-aspects [asp-prop]
   (loop [as asp-prop
@@ -41,38 +55,27 @@
 
 (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? dhamma) whole))
+  (s/apply-fn (s/apply-fn :is-aspect-of? (value dhamma)) (value whole)))
-
-(defmulti modify-whole (fn [dhamma _whole] (s/apply-fn :name dhamma)))
-(defmethod modify-whole :default [dhamma whole]
-  (s/apply-fn (s/apply-fn :modify-whole dhamma) whole))
 
 (defn aspects-of [dhamma]
-  (->> dhamma
+  (let [asp-props (->> dhamma value :asp-props)
-       value
+        filter-fn #(is-aspect-of? % dhamma)
-       :asp-props
+        aspects (map
-       (mapcat get-aspects)
+                 #(->> % get-aspects (filter filter-fn))
-       (filter #(is-aspect-of? % dhamma))
+                 asp-props)]
-       set
+    (zipmap asp-props aspects)))
-       (sort-by :priority)))
-
-;; TODO better error handling
-(defn copy [dhamma] (assoc (value dhamma) :_reference nil))
-
-(defmulti impl! (fn [dhamma & [_whole]] (:name dhamma)))
-
-(defn occur! [dhamma & [whole]]
-  (let [processed (reduce #(occur! %2 %1) (copy dhamma) (aspects-of dhamma))]
-    (run! occur! (:consequences processed))
-
-    (impl! (value processed) (and whole (value whole)))
-
-    (when whole
-      (modify-whole processed whole))))
 
+(defmulti impl! (fn [dhamma & [_whole]] (:name (value dhamma))))
+;; TODO should be an error
 (defmethod impl! :default [_dhamma & [_whole]]
   (println "default occur"))
 
-(defmethod impl! :print [_dhamma & [whole]]
+(defn occur! [dhamma & [whole]]
-  (println "printing test!")
+  (let [processed (reduce #(occur! %2 %1)
-  (println (s/apply-fn :data whole)))
+                          (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))

src/cljs/buddho/core/graphics.cljs

@@ -0,0 +1,12 @@
+(ns buddho.core.graphics
+  (:require [buddho.core.pixi :as pixi]
+            [buddho.core.state :as s]))
+
+(defn make-canvas! [width height]
+  (pixi/make-canvas! width height))
+
+(defn clear-canvas! []
+  (pixi/clear-canvas!))
+
+(defn make-sprite! [url]
+  (pixi/make-sprite! url))

src/cljs/buddho/core/init.cljs

@@ -1,10 +1,16 @@
 (ns buddho.core.init
   (:require [buddho.core.state :as s]
-            [buddho.core.dhamma :as d]))
+            [buddho.core.dhamma :as d]
+            [buddho.core.graphics :as g]))
 
 (defn init []
   ;;; reset game state
   (s/reset-state!)
+  (g/clear-canvas!)
+  (g/make-canvas! 512 512)
+
+
+  ;;; old wip
 
   (let [canvas (pixi/make-canvas! 512 512)
         bunny (entity/register-entity! "bunny")

src/cljs/buddho/core/meta.cljs

@@ -0,0 +1,21 @@
+(ns buddho.core.meta
+  (:require [buddho.core.dhamma :as d]))
+
+(def registry (atom {}))
+
+(defn register-meta! [name & {:keys [aspects singleton-fn]}]
+  (swap! registry update-in [:meta] assoc name
+         {:aspects (or aspects {})
+          :singleton (boolean singleton-fn)})
+  (when singleton-fn
+    (swap! registry update-in [:singletons] assoc name singleton-fn)))
+
+(defn implement-meta! []
+  (doseq [[name fun] (:singletons @registry)]
+    (swap! registry update-in [:reified] assoc name (fun)))
+  (doseq [[name meta] (:meta @registry)]
+    (doseq [[stage asps] (:aspects meta)]
+      (doseq [aspect asps]
+        (d/register-aspect!
+         (get-in @registry [:reified aspect])
+         (vec (concat stage [name])))))))

src/cljs/buddho/core/pixi.cljs

@@ -0,0 +1,39 @@
+(ns buddho.core.pixi
+  (:require ["pixi.js" :as PIXI]
+            [buddho.core.state :as s]))
+
+(defn describe-properties! []
+  (s/describe-property! [:canvas] "PixiJS Canvas object.")
+  (s/describe-property! [:canvas :main] "Main PixiJS canvas")
+  (s/describe-property! [:pixi] "PixiJS object.")
+  (s/describe-property! [:pixi :container] "PixiJS container object.")
+  (s/describe-property! [:world] "PixiJS world container."))
+
+(defn make-canvas! [width height]
+  (let [canvas (PIXI/Application. #js {:width width :height height
+                          :backgroundColor 0x444444})
+        world (PIXI/Container.)
+        [cid wid] (s/have-idea! "pixi_cont_" 2)]
+    (s/update-idea! cid {:object canvas})
+    (s/register-property! cid [:canvas :main] [:pixi :container])
+
+    (s/update-idea! wid {:object world})
+    (s/register-property! wid [:world] [:pixi :container])
+
+    (.appendChild js/document.body (.-view canvas))
+    (.addChild (.-stage canvas) world)
+    (set! (.-className (.-view canvas)) "game-view")
+
+    (set! (.-SCALE_MODE (.-settings PIXI)) (.-NEAREST (.-SCALE_MODES PIXI)))
+    (.set (-> canvas .-stage .-scale) 2)))
+
+(defn clear-canvas! []
+  (let [cur-canvas (.querySelector js/document.body ".game-view")
+        canvas-idea (first (s/with-property [:canvas :main]))]
+    (when cur-canvas
+      (.removeChild js/document.body cur-canvas))
+    (when canvas-idea
+      (s/forget-idea! canvas-idea))))
+
+(defn make-sprite! [url]
+  (-> PIXI .-Sprite (.from url)))

src/cljs/buddho/core/state.cljs

@@ -1,14 +1,17 @@
-(ns buddho.core.state)
+(ns buddho.core.state
+  (:require [clojure.set :refer [intersection]]
+            [clojure.string :as str]))
 
 (def empty-state
-  {:_properties {}})
+  {:_properties {}
+   :_descriptions
+   {:_properties "Property-to-idea mapping."
+    :property {}
+    :property_fns {}}})
 
 (defonce state
   (atom empty-state))
 
-(defn reset-state! []
-  (reset! state empty-state))
-
 (defprotocol Idea
   (fn-liberal [idea fn]
     "Apply function `fn` to `idea`,
@@ -38,24 +41,11 @@ mind that keys are functions.")
 
 (defn apply-fn [fn idea] (fn-liberal idea fn))
 
-(defn register-idea! [iid idea]
+(defn- register-idea! [iid]
-  (swap! state assoc iid idea)
   (swap! state assoc-in [iid :_properties] #{})
   (swap! state assoc-in [iid :_reference] iid)
   iid)
 
-(defn have-idea! [& [prefix]]
-  (register-idea! (gensym (or prefix "idea_")) {}))
-
-(defn register-property! [idea property]
-  (when property
-    (let [iid (reference idea)]
-      (reduce (fn [acc property]
-                (swap! state update-in (conj acc property :_node) (fnil conj #{}) iid)
-                (swap! state update-in [iid :_properties] (fnil conj #{}) (conj (vec (rest acc)) property))
-                (conj acc property))
-              [:_properties] property))))
-
 (defn properties [idea]
   (:_properties (value idea)))
 
@@ -65,5 +55,85 @@ mind that keys are functions.")
 (defn has-property? [idea property]
   (contains? (properties idea) property))
 
-(defn get-element [idea element]
+(defn have-idea! [& [prefix count]]
+  (let [pf (or prefix "idea_")
+        fun #(register-idea! (gensym pf))]
+    (if-not count
+      (fun)
+      (take count (repeatedly fun)))))
+
+(defn update-idea! [idea data]
+  (swap! state update idea merge data)
+  idea)
+
+(defn register-property! [idea & properties]
+  (let [property (first properties)
+        tail (rest properties)
+        iid (reference idea)]
+    (when property
+      (reduce (fn [acc property]
+                (swap! state update-in (conj acc property :_node) (fnil conj #{}) iid)
+                (swap! state update-in [iid :_properties] (fnil conj #{}) (conj (vec (rest acc)) property))
+                (conj acc property))
+              [:_properties] property))
+    (when tail
+      (run! #(register-property! idea %) tail))
+    idea))
+
+(defn- remove-property-node! [idea property]
+  (swap! state update-in
+         (concat [:_properties] property [:_node])
+         disj (reference idea)))
+
+(defn child-properties [property]
+  (map #(conj property %)
+       (-> @state :_properties (get-in property)
+           keys set (disj :_node))))
+
+(defn- rm-prop! [idea property]
+  (let [;; XXX can also be done using prefix checking if slow
+        children (intersection
+                  (set (child-properties property))
+                  (properties idea))]
+    (swap! state update-in [idea :_properties] disj property)
+    (remove-property-node! idea property)
+    (run! #(rm-prop! idea %) children)))
+
+(defn remove-property! [idea & properties]
+  (let [property (first properties)
+        tail (rest properties)
+        iid (reference idea)]
+    (when property
+      (rm-prop! iid property))
+    (when tail
+      (run! #(rm-prop! iid %) tail))))
+
+(defn forget-idea! [idea]
+  (let [iid (reference idea)]
+    (apply remove-property! iid (properties idea))
+    (swap! state dissoc iid)))
+
+(defn elem [idea element]
   (get (value idea) element))
+
+(defn rm-elem! [idea & elements]
+  (run! #(swap! state update idea dissoc %) elements))
+
+(defn describe-property! [property description & [fun]]
+  (swap! state assoc-in [:_descriptions :property property] description)
+  (when fun
+    (swap! state assoc-in [:_descriptions :property-fn property] fun)))
+
+(defn prop-desc [prop & [idea]]
+  (let [desc (get-in @state [:_descriptions :property prop])]
+
+    (if-let [fun (get-in @state [:_descriptions :property-fn prop])]
+      (str desc "\n" (fun idea))
+      desc)))
+
+(defn reset-state! []
+  (reset! state empty-state)
+  (describe-property! [:_properties] "Property-to-idea mapping.")
+  (describe-property! [:_reference] "Lookup key for idea.")
+  (describe-property! [:_aspect_of] "Dhamma: Aspect properties this is an aspect of.")
+  (describe-property! [:dhamma] "Idea is a dhamma." #(str "teste")))

src/cljs/buddho/dhamma/debug.cljs

@@ -0,0 +1,9 @@
+(ns buddho.dhamma.debug
+  (:require [buddho.core.meta :as meta]
+            [buddho.core.dhamma :as d]))
+
+
+(defmethod d/impl! :print [dhamma & [_whole]]
+  (println (:data dhamma)))
+
+(defmethod d/impl! :no-op [])

src/cljs/buddho/dhamma/graphics.cljs

@@ -0,0 +1,16 @@
+(ns buddho.dhamma.graphics
+  (:require [buddho.core.meta :as meta]
+            [buddho.core.dhamma :as d]
+            [buddho.core.graphics :as g]))
+
+(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
+                     :singleton-fn create-sprite!)

src/cljs/buddho/dhamma/state.cljs

@@ -0,0 +1,38 @@
+(ns buddho.dhamma.state
+  (:require [buddho.core.dhamma :as d]
+            [buddho.core.meta :as meta]
+            [buddho.core.state :as s]))
+
+(defn dh-have-idea
+  [n-ideas
+   & {:keys [data is-aspect-of? cascade asp-props transient]
+      :as args}]
+  (d/make-dhamma
+   :have-idea
+   :data {:n-ideas n-ideas}
+   (update args :data #(merge {:n-ideas n-ideas} %))))
+
+(defn have-idea!
+  [n-ideas
+   & {:keys [data is-aspect-of? cascade asp-props transient]
+      :as args}]
+  (d/register-dhamma!
+   :have-idea
+   :transient nil
+   :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 [])
+  )

src/cljs/buddho/dhamma/world/block.cljs

@@ -0,0 +1,19 @@
+(ns buddho.dhamma.world.block
+  (:require [buddho.core.dhamma :as d]
+            [buddho.core.meta :as meta]
+            [buddho.dhamma.state :as s]))
+
+(meta/register-meta!
+ :create-block
+ :aspects {[:_construct] [:create-sprite :have-idea]})
+(defn create-block!
+  [x y sprite-url & asp-props]
+  (d/register-dhamma!
+   :create-block
+   :data {:x x :y y :sprite-url sprite-url
+          :n-ideas 1}
+   :asp-props (concat [[:_construct :create-block]
+                       [:create-block]]
+                      asp-props)
+   ;; TODO
+   :cascade []))