From 1cf07090569a3c32c0de810feb48d7664c513473 Mon Sep 17 00:00:00 2001 From: Akko Date: Mon, 6 May 2024 18:18:47 +0200 Subject: [PATCH] uhh idk --- public/assets/Sprite-0002.aseprite | Bin 0 -> 1457 bytes src/cljs/buddho/core/describe.cljs | 38 ++++++++ src/cljs/buddho/core/dhamma.cljs | 93 ++++++++++---------- src/cljs/buddho/core/graphics.cljs | 12 +++ src/cljs/buddho/core/init.cljs | 8 +- src/cljs/buddho/core/meta.cljs | 21 +++++ src/cljs/buddho/core/pixi.cljs | 39 +++++++++ src/cljs/buddho/core/state.cljs | 110 +++++++++++++++++++----- src/cljs/buddho/dhamma/debug.cljs | 9 ++ src/cljs/buddho/dhamma/graphics.cljs | 16 ++++ src/cljs/buddho/dhamma/state.cljs | 38 ++++++++ src/cljs/buddho/dhamma/world/block.cljs | 19 ++++ 12 files changed, 337 insertions(+), 66 deletions(-) create mode 100644 public/assets/Sprite-0002.aseprite create mode 100644 src/cljs/buddho/core/describe.cljs create mode 100644 src/cljs/buddho/core/graphics.cljs create mode 100644 src/cljs/buddho/core/meta.cljs create mode 100644 src/cljs/buddho/core/pixi.cljs create mode 100644 src/cljs/buddho/dhamma/debug.cljs create mode 100644 src/cljs/buddho/dhamma/graphics.cljs create mode 100644 src/cljs/buddho/dhamma/state.cljs create mode 100644 src/cljs/buddho/dhamma/world/block.cljs diff --git a/public/assets/Sprite-0002.aseprite b/public/assets/Sprite-0002.aseprite new file mode 100644 index 0000000000000000000000000000000000000000..768dd40d42372b109bc80a0a25c10a9882fd17ae GIT binary patch literal 1457 zcmcJMjZ+e79LHBZd?^_%sI;8KQ#edL#U&N(OtXAN>LAa^UPK|Lt}d-6HL=Xh#LDs| zT@12Jfw9!Ow8YBNtW42fD2-n1x>PhrO_}i+ui}0-cXRy%Jv;l^XP;;1`}ywfWgLS1 zQDuS{kaWZnF+mW759j~G4l$WoL~P;s7J~-<=?UByD@>93a9WVQD8JHG!`z-^_wUMr zuXYf`Xf(n-9#4b|$;kzXq5;78xGg|MxdLby{{SR-*a0cA4#0K!C{WqD1GsPz189$K z0=oW+0R`nZfN@@@fVXnGfvEj_;4gMF3B|rtV9Rz6P<=iTn8>gPjyxb5+0f;?neS)^ zy`U5{f;!Lzia-mf0Dh2z8MNR8A=p3#9*}?m;vpM?Ar&GWXA((fU%fM^5DSFKOB3uO z(LTTqj)Wky;P)9#|9eV@Bq6EN(cT@2zmtfWyq@(cIXasB$#`JeP?*>L)`4+0_qF5I z7i?9l_2CcN!)14z{Tu>Q{f3@*tMi^OC&-PR$;|3t2Vy-&J8HH5Jty((X4`)#zIqOSV~i>}xO-T6tIYOU`01X}@suYSshKe`#@h~Fg0WI* z|Ja$?CI=zKr3e+iFBWM%^#t=eex29o9eHR`vkHjS~on}$?Vu2omTG=pQj_329D6% zagoZG9!1-D-oE1+SAA4nvBuSy`rw( zGy2lx#F{-(#nqaJ{3kNX;5!ntrm$U9+qqI2D(@RUBo44??UyxJ@Yaj`ZhC21=9~jo z6^z$)HtI(*FNsD>&7j@=ENSGdYDzZ0ORPwL%-&LH;Fn1=CviWgHuXN1MVz)`+$6-Q z>3-+5l{w5IA?I&>6+LL@H5Z|)elCBOLY?DmHc;4RIr=#dA`ugz#s>K`Ni3 zAZZ9~aH%^*tMsD{%uA`gy`d8IUmfB+>C!gu@O<0}?rmn2EMFVEI;b~xin-PbRdt97 zb6MD>dTrb^N7$7u6$ygZp2>52p6R}S6L*P;!i+3Q%aUXqVvGO0xOs5JA#@J;U>Xh! zF+VS)q0%xo&qFn8VDJQ#L*$`qEXN%qL2>gE%CdM!9+1G+D5XshH8-CcT zcHHO_ezdOZ#N`;w@rwINyuP8qWl@TD+2ciuu)W>c`IYaMB%M2YX?bKfmVZw(z&332 zPU> (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" diff --git a/src/cljs/buddho/core/dhamma.cljs b/src/cljs/buddho/core/dhamma.cljs index 0416ded..ab70518 100644 --- a/src/cljs/buddho/core/dhamma.cljs +++ b/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." - [name source data asp-props consequences is-aspect-of? modify-whole priority] + "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 - :source source :data data :asp-props asp-props - :consequences consequences :is-aspect-of? is-aspect-of? - :modify-whole modify-whole - :priority priority)) + :cascade cascade + :transient transient)) (defn register-dhamma! "Register a dhamma." - [name source & {:keys [data consequences is-aspect-of? modify-whole asp-props priority] - :or {data {} consequences [] is-aspect-of? (constantly true) - modify-whole identity asp-props [] priority 0}}] - (let [id (gensym "dhamma_") + [name & {:keys [data is-aspect-of? cascade asp-props transient] + :as args}] + (let [idea (s/have-idea! "dhamma_") dhamma (make-dhamma - name source data (conj asp-props [name]) - consequences is-aspect-of? modify-whole priority)] - (s/register-idea! id 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 dhamma [:data key] value)) +(defn assoc-data [dhamma key value] (assoc-in (copy dhamma) [:data key] value)) -(defn register-aspect! [did asp-prop] - (s/register-property! did [:_aspect_of asp-prop])) +(defn add-cascade [dhamma & cascades] + (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)) - -(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)) + (s/apply-fn (s/apply-fn :is-aspect-of? (value dhamma)) (value whole))) (defn aspects-of [dhamma] - (->> dhamma - value - :asp-props - (mapcat get-aspects) - (filter #(is-aspect-of? % dhamma)) - set - (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)))) + (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")) -(defmethod impl! :print [_dhamma & [whole]] - (println "printing test!") - (println (s/apply-fn :data whole))) +(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)) diff --git a/src/cljs/buddho/core/graphics.cljs b/src/cljs/buddho/core/graphics.cljs new file mode 100644 index 0000000..c4752d5 --- /dev/null +++ b/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)) diff --git a/src/cljs/buddho/core/init.cljs b/src/cljs/buddho/core/init.cljs index d21fca4..7161237 100644 --- a/src/cljs/buddho/core/init.cljs +++ b/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") diff --git a/src/cljs/buddho/core/meta.cljs b/src/cljs/buddho/core/meta.cljs new file mode 100644 index 0000000..d735803 --- /dev/null +++ b/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]))))))) diff --git a/src/cljs/buddho/core/pixi.cljs b/src/cljs/buddho/core/pixi.cljs new file mode 100644 index 0000000..ff70a2e --- /dev/null +++ b/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))) diff --git a/src/cljs/buddho/core/state.cljs b/src/cljs/buddho/core/state.cljs index 56a6f4e..0a6dbb6 100644 --- a/src/cljs/buddho/core/state.cljs +++ b/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] - (swap! state assoc iid idea) +(defn- register-idea! [iid] (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"))) diff --git a/src/cljs/buddho/dhamma/debug.cljs b/src/cljs/buddho/dhamma/debug.cljs new file mode 100644 index 0000000..8c49350 --- /dev/null +++ b/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 []) diff --git a/src/cljs/buddho/dhamma/graphics.cljs b/src/cljs/buddho/dhamma/graphics.cljs new file mode 100644 index 0000000..e278265 --- /dev/null +++ b/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!) diff --git a/src/cljs/buddho/dhamma/state.cljs b/src/cljs/buddho/dhamma/state.cljs new file mode 100644 index 0000000..ff817d7 --- /dev/null +++ b/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 []) + ) diff --git a/src/cljs/buddho/dhamma/world/block.cljs b/src/cljs/buddho/dhamma/world/block.cljs new file mode 100644 index 0000000..f70536d --- /dev/null +++ b/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 []))