akko/nothoughts
1
0
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
akko
2024-10-08 11:47:30 +02:00
commit 85b6b7360f
31 changed files with 2889 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
.gitignore vendored Normal file
View File

@@ -0,0 +1,20 @@
node_modules/
public/js
/target
/checkouts
/src/gen
pom.xml
pom.xml.asc
*.iml
*.jar
*.log
.shadow-cljs
.idea
.lein-*
.nrepl-*
.DS_Store
.hgignore
.hg/

37
org/todo.org Normal file
View File

@@ -0,0 +1,37 @@
#+title: Catbox To-Do
#+todo: WAITING(w) TODO(t) IN_PROGRESS(i) | DONE(d)
* Emptyhead
#+BEGIN: kanban :mirrored t :layout ("..." . 50) :scope tree :depth 2
| DONE | IN_PROGRESS | TODO | WAITING |
|-----------------------------------+-----------------------------------+-----------------------------+-----------------------------------|
| [[file:todo.org::*Move idea metadata into own field][Move idea metadata into own field]] | | | |
| | | [[file:todo.org::*Implement contracts][Implement contracts]] | |
| | | | [[file:todo.org::*Test thought execution][Test thought execution]] |
| | | [[file:todo.org::*Write documentation][Write documentation]] | |
| | [[file:todo.org::*Write thought stdlib][Write thought stdlib]] | | |
| | [[file:todo.org::*Thought definition infrastructure][Thought definition infrastructure]] | | |
| | | | [[file:todo.org::*Contract type checking everywhere][Contract type checking everywhere]] |
| [[file:todo.org::*Return system][Return system]] | | | |
| | [[file:todo.org::*Improve have-idea!][Improve have-idea!]] | | |
| | | [[file:todo.org::*Implement 'describe' system][Implement 'describe' system]] | |
#+END:
** DONE Move idea metadata into own field
** TODO Implement contracts
** WAITING Test thought execution
** TODO Write documentation
** IN_PROGRESS Write thought stdlib
*** TODO Expose emptyhead functionality
**** TODO Property add/remove
**** TODO Idea create/update/delete
**** TODO Thought extend/remove extension
*** TODO Create new thoughts through composition
*** TODO Message passing between thoughts
** IN_PROGRESS Thought definition infrastructure
** WAITING Contract type checking everywhere
Waits on implementing contracts
** DONE Return system
** IN_PROGRESS Improve have-idea!
** TODO Implement 'describe' system
* Nothoughts
* Catbox

2237
package-lock.json generated Normal file
View File

File diff suppressed because it is too large Load Diff

11
package.json Normal file
View File

@@ -0,0 +1,11 @@
{
"name": "game",
"version": "0.0.1",
"private": true,
"devDependencies": {
"shadow-cljs": "2.28.15"
},
"dependencies": {
"pixi.js": "^8.4.1"
}
}

BIN
public/assets/Sprite-0002.aseprite Normal file
View File

Binary file not shown.

BIN
public/assets/prart_tile_square_32x32.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 283 B

BIN
public/assets/prart_tile_square_32x32_green.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 288 B

BIN
public/assets/prart_tile_square_32x32_red.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 287 B

BIN
public/assets/test.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 287 B

11
public/index.html Normal file
View File

@@ -0,0 +1,11 @@
<!doctype html>
<html>
<head>
<meta charset="utf-8" />
<title>acme frontend</title>
</head>
<body>
<div id="root"></div>
<script src="/js/main.js"></script>
</body>
</html>

17
shadow-cljs.edn Normal file
View File

@@ -0,0 +1,17 @@
;; shadow-cljs configuration
{:source-paths
["src/dev"
"src/cljs"
"src/clj"]
:dependencies
[]
:dev-http {8008 "public"}
:builds
{:game
{:target :browser
:modules
{:main
{:init-fn nothoughts.core.init/init}}}}}

7
src/cljs/emptyhead/contract/eval.cljs Normal file
View File

@@ -0,0 +1,7 @@
(ns emptyhead.contract.eval
"Implements contract evaluation on ideas."
(:require [emptyhead.idea.protocol :as prtc]))
;; TODO stub
(defn evaluate [contract idea]
true)

59
src/cljs/emptyhead/idea/crud.cljs Normal file
View File

@@ -0,0 +1,59 @@
(ns emptyhead.idea.crud
"Functions for Creating, Updating and Deleting ideas.
The 'R' in 'CRUD' is implemented by [[emptyhead.idea.protocol/value]]."
(:require [emptyhead.idea.state :refer [state]]
[emptyhead.idea.property :as prop]
[emptyhead.idea.protocol :as prtc]))
(defn- register-idea!
"Helper function to scaffold an 'empty' idea."
[ref]
(swap! state assoc-in [ref :_meta :_properties] #{})
(swap! state assoc-in [ref :_meta :_reference] ref)
ref)
(defn swap-idea!
"Swap data inside `idea` with given `data`.
Returns a reference to `idea`."
[idea data]
(swap! state assoc
(prtc/reference idea)
(merge data {:_meta (prtc/val-fn :_meta idea)}))
(prtc/reference idea))
(defn extend-idea!
"Merge `data` into state of `idea`.
Returns a reference to `idea`."
[idea data]
(swap! state assoc (prtc/reference idea) (prtc/val-fn merge idea data))
(prtc/reference idea))
(defn mutate-idea!
"Evaluate `fun` on `idea` with optional extra `args`, then replace `idea` by the result.
Returns a reference to `idea`."
[fun idea & args]
(swap-idea! idea (prtc/val-fn fun idea args))
(prtc/reference idea))
(defn forget-idea!
"Delete `idea` from the state.
Returns a copy of the `idea`."
[idea]
(let [val (prtc/value idea)]
(apply prop/remove-property! idea (prop/properties idea))
(prtc/ref-fn #(swap! state dissoc %) idea)
(prtc/copy val)))
(defn have-idea!
"Instantiate up to `count` new ideas, optionally prefixing reference symbol with `prefix`.
Additionally allows you to immediately attach `properties` and `data`.
Returns a single idea or a list of ideas depending on whether `count` was given."
[& {:keys [prefix count properties data]
:or {count 1 prefix "idea_" properties []}}]
(let [fun #(register-idea! (gensym prefix))
ideas (take count (repeatedly fun))]
(run! #(apply prop/register-property! % properties) ideas)
(when data (run! #(extend-idea! % data) ideas))
(if (= count 1)
(first ideas)
ideas)))

68
src/cljs/emptyhead/idea/property.cljs Normal file
View File

@@ -0,0 +1,68 @@
(ns emptyhead.idea.property
"Implements 'properties' - hierarchical tags for ideas."
(:require [clojure.set :as stdset]
[emptyhead.idea.protocol :as prtc]
[emptyhead.idea.state :as state]))
(defn properties
"Returns a set of all properties associated with `idea`."
[idea]
(prtc/val-fn #(get-in % [:_meta :_properties]) idea))
(defn with-property
"Returns a set of all ideas with `property`."
[property]
(get-in @state/state (concat [:_properties] property [:_node])))
;; XXX should error if multiple are found
(defn just-property
"Returns the single idea with `property`."
[property]
(first (with-property property)))
(defn has-property?
"Returns true if and only if `property` is associated with `idea`."
[idea property]
(contains? (properties idea) property))
(defn register-property!
"Associate one or more `properties` to an `idea`."
[idea & properties]
(let [property (first properties)
tail (rest properties)
iref (prtc/reference idea)]
(when property
(reduce
(fn [acc property]
(swap! state/state update-in (conj acc property :_node) (fnil conj #{}) iref)
(swap! state/state update-in [iref :_meta :_properties] (fnil conj #{}) (conj (vec (rest acc)) property))
(conj acc property))
[:_properties] property))
(when tail
(run! #(register-property! idea %) tail))
iref))
(defn- remove-property-node! [idea property]
(swap! state/state update-in
(concat [:_properties] property [:_node])
disj (prtc/reference idea))
(prtc/reference idea))
(defn- child-properties [property]
(map #(conj property %)
(-> @state/state :_properties (get-in property)
keys set (disj :_node))))
(defn- rm-prop! [idea property]
(swap! state/state update-in [idea :_meta :_properties] disj property)
(remove-property-node! idea property)
(let [children (stdset/intersection
(set (child-properties property))
(properties idea))]
(run! #(rm-prop! idea %) children)))
(defn remove-property!
"Dissociate one or more `properties` from `idea`."
[idea & properties]
(run! #(prtc/ref-fn rm-prop! idea %) properties)
(prtc/reference idea))

78
src/cljs/emptyhead/idea/protocol.cljs Normal file
View File

@@ -0,0 +1,78 @@
(ns emptyhead.idea.protocol
"Implements transparent conversions between the _value_ of an idea, i.e. a map containing its data,
and the _reference_ of an idea, i.e. a symbol that identifies it in the state;
i.e., state looks like {reference_1 value_1 ...}"
(:require [emptyhead.util.logging :as log]
[emptyhead.idea.state :refer [state]]))
(defn- to-reference [val]
(let [ref (get-in val [:_meta :_reference])]
(cond
(get-in val [:_meta :_stale-reference])
(log/error (str "Attempt to find stale reference `" ref "` -- this is a copy.")
{:value val :type :stale-reference})
(not (symbol? ref))
(log/error (str "Attempt to find invalid reference `" ref "` -- invalid idea?")
{:value val :type :invalid-reference})
:else ref)))
(defprotocol Idea
(reference [idea] "Reference, i.e. symbol, for `idea`.")
(value [idea] "Value, i.e. map, of `idea`."))
(extend-protocol Idea
cljs.core/PersistentHashMap
(reference [idea] (to-reference idea))
(value [idea] idea)
cljs.core/PersistentArrayMap
(reference [idea] (to-reference idea))
(value [idea] idea)
Symbol
(reference [idea] idea)
(value [idea] (get @state idea)))
(defn copy
"Make a copy of `idea`.
Returns an object that is identical to the value of `idea`,
but marked as not containing a reference to anything in the state."
[idea]
(assoc-in (value idea) [:_meta :_stale-reference] true))
(defn- non-copy [idea] (assoc-in (value idea) [:_meta :_stale-reference] false))
(defn uncopy!
"Takes a copied idea and 'uncopies' it, making its reference active again
and updating what is in the game state."
[copy-obj]
(let [idea (non-copy copy-obj)]
(swap! state assoc (to-reference idea) idea)))
(defn force-reference
"Get the (now stale!) reference of a copied idea."
[copy-obj]
(to-reference (non-copy copy-obj)))
(defn copy-fn
"Execute `fun` on a copy of `idea` with optional additional `args`."
[fun idea & args]
(apply fun (copy idea) args))
(defn val-fn
"Execute `fun` on the value of `idea` with optional additional `args`."
[fun idea & args]
(apply fun (value idea) args))
(defn ref-fn
"Execute `fun` on a reference to `idea` with optional additional `args`."
[fun idea & args]
(apply fun (reference idea) args))
(defn force-reference-fn
"Execute `fun` on a reference to `idea` with optional additional `args`.
Unlike [[reference-fn]], this will work on a copy."
[fun idea & args]
(apply fun (force-reference idea) args))

16
src/cljs/emptyhead/idea/state.cljs Normal file
View File

@@ -0,0 +1,16 @@
(ns emptyhead.idea.state
"Implements the state object.")
(def empty-state
{:_properties {}
:_descriptions
{:_properties "Property-to-idea mapping."
:property {}
:property_fns {}}})
(defonce state
(atom empty-state))
(defn reset-state! []
(reset! state empty-state))

6
src/cljs/emptyhead/lib/core.cljs Normal file
View File

@@ -0,0 +1,6 @@
(ns emptyhead.lib.core
"Core components of the stdlib."
(:require [emptyhead.thought.crud :as thought]))
(defn data [data]
(thought/make-thought :emptyhead.core.data :data data))

1
src/cljs/emptyhead/lib/idea.cljs Normal file
View File

@@ -0,0 +1 @@
(ns emptyhead.lib.idea)

13
src/cljs/emptyhead/test/fixtures.cljs Normal file
View File

@@ -0,0 +1,13 @@
(ns emptyhead.test.fixtures
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.state :as s]))
(defn temporary-state [tests]
(let [orig-state (swap! s/state identity)]
(s/reset-state!)
(tests)
(reset! s/state orig-state)))
(defn pre-reset [tests]
(s/reset-state!)
(tests))

30
src/cljs/emptyhead/test/idea/crud.cljs Normal file
View File

@@ -0,0 +1,30 @@
(ns emptyhead.test.idea.crud
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.crud :as crud]
[emptyhead.idea.state :as s :refer [state]]
[emptyhead.idea.protocol :as prtc]
[emptyhead.test.fixtures :as fx]))
(t/use-fixtures :once fx/temporary-state)
(t/use-fixtures :each fx/pre-reset)
(t/deftest have-idea!
(t/testing "Idea creation"
(let [idea (crud/have-idea!)]
(t/is (get @state idea)))))
(t/deftest idea-updating
(t/testing "Idea updating"
(let [idea (crud/have-idea!)]
(crud/extend-idea! idea {:foo :bar})
(t/is (= :bar (prtc/val-fn :foo idea)))
(crud/swap-idea! idea {:baz :quux})
(t/is (not (prtc/val-fn :foo idea)))
(t/is (= :quux (prtc/val-fn :baz idea)))
)))
(t/deftest forget!
(t/testing "Idea deletion"
(let [idea (crud/have-idea!)]
(crud/forget-idea! idea)
(t/is (= nil (get @state idea))))))

25
src/cljs/emptyhead/test/idea/property.cljs Normal file
View File

@@ -0,0 +1,25 @@
(ns emptyhead.test.idea.property
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.crud :as crud]
[emptyhead.idea.property :as prop]
[emptyhead.test.fixtures :as fx]))
(t/use-fixtures :once fx/temporary-state)
(t/use-fixtures :each fx/pre-reset)
(t/deftest properties
(t/testing "Property addition and removal"
(let [idea (crud/have-idea!)]
(prop/register-property! idea [:a :b :c] [:a :d :e])
(t/is (= #{[:a :b :c] [:a :d :e] [:a] [:a :b] [:a :d]}
(prop/properties idea)))
(t/is (prop/has-property? idea [:a :b]))
(t/is (not (prop/has-property? idea [:invalid])))
(t/is (contains? (prop/with-property [:a :d]) idea))
(t/is (not (contains? (prop/with-property [:invalid]) idea)))
(prop/remove-property! idea [:a :b])
(t/is (not (prop/has-property? idea [:a :b :c]))))))

22
src/cljs/emptyhead/test/idea/protocol.cljs Normal file
View File

@@ -0,0 +1,22 @@
(ns emptyhead.test.idea.protocol
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.crud :as crud]
[emptyhead.idea.protocol :as prtc]
[emptyhead.test.utils :refer [expect-error]]
[emptyhead.test.fixtures :as fx]))
(t/use-fixtures :once fx/temporary-state)
(t/use-fixtures :each fx/pre-reset)
(t/deftest protocol
(t/testing "Value/reference semantics"
(let [idea (crud/have-idea!)]
;; Repeatedly going between value and reference shouldn't mangle idea
(t/is (= idea (-> idea prtc/value prtc/reference)))
(t/is (= (prtc/value idea) (-> idea prtc/reference prtc/value)))
;; Attempting to get a reference to a copy should be an error
(expect-error :stale-reference #(prtc/reference (prtc/copy idea)))
;; Attempting to get a reference to an invalid idea should be an error
(expect-error :invalid-reference #(prtc/reference {})))))

8
src/cljs/emptyhead/test/main.cljs Normal file
View File

@@ -0,0 +1,8 @@
(ns emptyhead.test.main
(:require [cljs.test :as t :include-macros true]
[emptyhead.test.idea.crud]
[emptyhead.test.idea.property]
[emptyhead.test.idea.protocol]))
(defn run []
(t/run-all-tests #"emptyhead\.test\..*"))

10
src/cljs/emptyhead/test/utils.cljs Normal file
View File

@@ -0,0 +1,10 @@
(ns emptyhead.test.utils
(:require [cljs.test :as t :include-macros true]))
(defn expect-error [type fun]
(t/is
(= type
(try (fun)
nil
(catch :default e
(-> e ex-data :data first :type))))))

49
src/cljs/emptyhead/thought/crud.cljs Normal file
View File

@@ -0,0 +1,49 @@
(ns emptyhead.thought.crud
"Implements CRUD operations on thoughts.
Since thoughts are ideas, 'missing' operations here are implemented in [[emptyhead.idea.crud]]."
(:require [emptyhead.idea.protocol :as prtc]
[emptyhead.idea.crud :as idea]
[emptyhead.idea.property :as prop]
[emptyhead.contract.eval :as contract]))
(defn make-thought
"Helper function to make thought object.
You may want `register-thought!` instead."
[operator & {:keys [data ext-contract ext-stages transient]
:or {data {} ext-contract {}
ext-stages [[:thought operator]]
transient true}}]
(hash-map :operator operator
:data data
:ext-contract ext-contract
:ext-stages ext-stages
:return {}
:transient (not (false? transient))))
(defn register-thought!
"Create a thought and register it in the state.
Returns a reference to the created thought."
[operator & {:keys [data ext-contract ext-stages transient]
:as args}]
(idea/have-idea!
:prefix (str "thought_" (name operator) "_")
:properties [[:thought]]
:data (make-thought operator args)))
(defn contract
"Get the extension contract of a `thought`.
Returns the contract."
[thought]
(prtc/val-fn :ext-contract thought))
(defn stages
"Get the extension stages of a `thought`.
Returns the list of stages."
[thought]
(prtc/val-fn :ext-stages thought))
(defn operator
"Get the operator id of a `thought`.
Returns the operator keyword."
[thought]
(prtc/val-fn :operator thought))

31
src/cljs/emptyhead/thought/define.cljs Normal file
View File

@@ -0,0 +1,31 @@
(ns emptyhead.thought.define
"Utilities for defining new thoughts."
(:require [emptyhead.thought.crud :as thought]
[emptyhead.thought.eval :as eval]
[emptyhead.idea.crud :as idea]))
(defn register-implementation!
[operator impl]
(idea/have-idea! :prefix (str "impl_thought_" (name operator))
:properties [[:thought-impl operator]]
:data {:implementation impl}))
(defn register-constructor!
[operator & {:keys [constr-fn defaults]
:or {constr-fn identity
defaults {}}}]
(let [constr-op (keyword (str (name operator) ".construct"))]
(register-implementation!
constr-op
(fn [thought & [parent]]
[parent
(thought/register-thought!
operator
(merge defaults {:operator operator}
(constr-fn (merge parent thought))))]))))
(defn define!
[operator impl & {:keys [constr-fn defaults]
:as constr-args}]
(register-implementation! operator impl)
(register-constructor! operator constr-args))

45
src/cljs/emptyhead/thought/eval.cljs Normal file
View File

@@ -0,0 +1,45 @@
(ns emptyhead.thought.eval
"Implements evaluation of thoughts."
(:require [emptyhead.idea.protocol :as prtc]
[emptyhead.thought.extend :as extend]
[emptyhead.thought.crud :as thought]
[emptyhead.util.logging :as logging]
[emptyhead.thought.return :as return]
[emptyhead.idea.property :as prop]
[emptyhead.idea.crud :as idea]))
(defn- impl! [thought & [parent]]
(let [impl-idea (prop/just-property [:thought-impl (thought/operator thought)])]
(if-not impl-idea
(logging/error (str "No implementation for thought `" (thought/operator thought) "`.")
{:thought thought :parent parent :type :unimplemented-thought})
((prtc/copy-fn :implementation impl-idea) thought parent))))
(def root-thought (thought/make-thought :root))
;; at what point do returns get cleared?
(defn execute!
"Execute `thought` with `parent`, applying aspects to `thought` according to its :extension-stages.
Returns (potentially modified) `parent`."
[thought & [parent]]
(loop [th (prtc/copy thought)
parent (or parent root-thought)]
(let [cur (first (thought/stages thought))
[extensions th] (extend/pop-stage th)
;; Execute extensions, potentially modifying th
th (reduce #(execute! %2 %1) th extensions)
;; If it's time for `thought`'s implementation to run, do so,
;; potentially modifying `parent`.
[parent return]
(if (= cur [:thought (thought/operator th)])
(impl! th parent)
parent)
;; Fold return value into `parent`.
parent (return/with-return parent (thought/operator th) return)]
;; Recur if there's remaining aspects, otherwise return `parent`.
(if (not-empty (thought/stages th))
(recur th parent)
parent))))

60
src/cljs/emptyhead/thought/extend.cljs Normal file
View File

@@ -0,0 +1,60 @@
(ns emptyhead.thought.extend
(:require [emptyhead.contract.eval :as contract]
[emptyhead.idea.property :as prop]
[emptyhead.idea.protocol :as prtc]
[emptyhead.thought.crud :as thought]
[clojure.set :refer [union]]))
(defn register-extension
"Register `thought` as extension for one or more `stages`."
[thought & stages]
(doseq [stage stages]
(prop/register-property! thought [:_extends stage]))
thought)
(defn remove-extension!
"Remove `thought` as extension for one or more `stages`."
[thought & stages]
(doseq [stage stages]
(prop/remove-property! thought [:_extends stage]))
thought)
(defn- get-extensions
"Get extensions for `stage`;
e.g. for `stage` of [:foo :bar :baz], get extensions for [:foo :bar :baz], [:foo :bar], [:foo]"
[stage]
(loop [property-segment stage
acc []]
(if (empty? property-segment)
acc
(recur (butlast property-segment)
(union acc (prop/with-property [:_extends property-segment]))))))
(defn extensions
"Get extensions of `thought`.
Returns a map of {stage => #{thought}}."
[thought]
(let [stages (thought/stages thought)
filter-fn #(contract/evaluate (thought/contract thought) %)
aspects (map
#(->> % get-extensions (filter filter-fn))
stages)]
(zipmap stages aspects)))
(defn pop-stage
"Get aspects of next stage of thought execution.
Returns a tuple of (#{extension-dhammas},
a copy of `thought` with its first extension-stage removed)."
[thought]
(let [stages (thought/stages thought)
aspects (filter #(contract/evaluate (thought/contract thought) %)
(get-extensions (first stages)))
modified (prtc/copy-fn #(assoc % :ext-stages (rest stages))
thought)]
(list aspects modified)))
(defn has-stage?
"Return true if `thought` has extension stage `stage`.
Also works if e.g. `stage` is [:foo] and `thought` has [:foo :bar]."
[thought stage]
(some #(= stage (take (count stage) %)) (thought/stages thought)))

16
src/cljs/emptyhead/thought/return.cljs Normal file
View File

@@ -0,0 +1,16 @@
(ns emptyhead.thought.return
"Utilities for handling thoughts' return values to their parents."
(:require [emptyhead.thought.crud :as thought]
[emptyhead.idea.protocol :as prtc]))
(defn with-return [thought namespace data]
(if data
(prtc/copy-fn
#(update-in % [:return namespace] (fnil conj []) data) thought)
thought))
(defn return-vals [thought namespace]
(prtc/copy-fn #(get-in % [:return namespace]) thought))
(defn clear-returns [thought]
(prtc/copy-fn #(assoc % :return {}) thought))

10
src/cljs/emptyhead/util/logging.cljs Normal file
View File

@@ -0,0 +1,10 @@
(ns emptyhead.util.logging)
(defn error [message & data]
(throw (ex-info message {:data data})))
(defn warn [message & data]
(error message data))
(defn message [message & data]
(println message {:data data}))

2
src/cljs/nothoughts/core/init.cljs Normal file
View File

@@ -0,0 +1,2 @@
(ns nothoughts.core.init)
(defn init [] (print "hello"))