This commit is contained in:
Akko
2024-04-19 14:50:26 +02:00
parent 199c286de0
commit 79fcadf89b
41 changed files with 942 additions and 176 deletions

View File

@@ -1 +1 @@
["^ ","~$map->ComponentRotation",["^ ","~:row",9,"~:col",1,"~:fixed-arities",["~#set",[1]],"~:name","^0","~:ns","~$sekai.core.init","~:top-ns","^7"],"~$ComponentRotation",["^ ","^1",9,"^2",1,"^5","^9","^6","^7","^8","^7"],"~$register-component",["^ ","^1",69,"^2",1,"^3",["^4",[3]],"^5","^:","^6","^7","^8","^7","~:type","~:fn"],"~$->Event",["^ ","^1",7,"^2",1,"^3",["^4",[5]],"^5","^=","^6","^7","^8","^7"],"~$map->Event",["^ ","^1",7,"^2",1,"^3",["^4",[1]],"^5","^>","^6","^7","^8","^7"],"~$->ComponentPosition",["^ ","^1",8,"^2",1,"^3",["^4",[2]],"^5","^?","^6","^7","^8","^7"],"~$init",["^ ","^1",90,"^2",1,"^3",["^4",[0]],"^5","^@","^6","^7","^8","^7","^;","^<"],"~$do-event!",["^ ","^1",32,"^2",1,"^5","^A","^6","^7","^8","^7"],"~:filename","/home/kahr/Projects/our_world/src/main/sekai/core/init.cljs","~$->ComponentRotation",["^ ","^1",9,"^2",1,"^3",["^4",[1]],"^5","^C","^6","^7","^8","^7"],"~$Event",["^ ","^1",7,"^2",1,"^5","^D","^6","^7","^8","^7"],"~$enqueue",["^ ","^1",22,"^2",1,"^3",["^4",[1]],"^5","^E","^6","^7","^8","^7","^;","^<"],"~$map->ComponentPosition",["^ ","^1",8,"^2",1,"^3",["^4",[1]],"^5","^F","^6","^7","^8","^7"],"~$game-state",["^ ","^1",5,"^2",1,"^5","^G","^6","^7","^8","^7"],"~$gameloop",["^ ","^1",73,"^2",1,"^3",["^4",[1]],"^5","^H","^6","^7","^8","^7","^;","^<"],"~$dequeue",["^ ","^1",25,"^2",1,"^3",["^4",[0]],"^5","^I","^6","^7","^8","^7","^;","^<"],"~$make-rotate-event",["^ ","^1",57,"^2",1,"^3",["^4",[3]],"^5","^J","^6","^7","^8","^7","^;","^<"],"~$render",["^ ","^1",12,"^2",1,"^3",["^4",[0]],"^5","^K","^6","^7","^8","^7","^;","^<"],"~$ComponentPosition",["^ ","^1",8,"^2",1,"^5","^L","^6","^7","^8","^7"],"~$make-move-event",["^ ","^1",49,"^2",1,"^3",["^4",[3]],"^5","^M","^6","^7","^8","^7","^;","^<"],"~$register-entity",["^ ","^1",66,"^2",1,"^3",["^4",[1]],"^5","^N","^6","^7","^8","^7","^;","^<"],"~$clear-game-view",["^ ","^1",85,"^2",1,"^3",["^4",[0]],"^5","^O","^6","^7","^8","^7","^;","^<"]] ["^ ","~$init",["^ ","~:row",11,"~:col",1,"~:fixed-arities",["~#set",[0]],"~:name","^0","~:ns","~$sekai.core.init","~:top-ns","^7","~:type","~:fn"],"~:filename","/home/kahr/Projects/our_world/src/cljs/sekai/core/init.cljs"]

View File

@@ -1 +1 @@
["^ ","~$make-pixi",["^ ","~:row",4,"~:col",1,"~:fixed-arities",["~#set",[0]],"~:name","^0","~:ns","~$sekai.core.pixi","~:top-ns","^7","~:type","~:fn"],"~:filename","/home/kahr/Projects/our_world/src/main/sekai/core/pixi.cljs"] ["^ ","~$make-canvas!",["^ ","~:row",4,"~:col",1,"~:fixed-arities",["~#set",[2]],"~:name","^0","~:ns","~$sekai.core.pixi","~:top-ns","^7","~:type","~:fn"],"~$clear-canvas!",["^ ","^1",8,"^2",1,"^3",["^4",[0]],"^5","^;","^6","^7","^8","^7","^9","^:"],"~$make-sprite!",["^ ","^1",13,"^2",1,"^3",["^4",[1]],"^5","^<","^6","^7","^8","^7","^9","^:"],"~:filename","/home/kahr/Projects/our_world/src/cljs/sekai/core/pixi.cljs"]

28
.clj-kondo/config.edn Normal file
View File

@@ -0,0 +1,28 @@
{: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
{:exclude [(sekai.macros.components/defcomponent)]}
:clojure-lsp/unused-public-var
{
:level :off
:exclude #{sekai.macros.components}
:exclude-when-defined-by [(sekai.macros.components/defcomponent)]
:exclude-when-defined-by-regex #{"sekai.macros.components/*"}
}
}
:hooks
{:analyze-call {sekai.macros.components/defcomponent
hooks.macros.components/defcomponent}}}

View File

@@ -0,0 +1,18 @@
(ns hooks.macros.components
(:require [clj-kondo.hooks-api :as api]
[clojure.string :refer [capitalize]]))
(defn defcomponent [{:keys [node]}]
(let [[name fields & [generator constructor destructor]] (rest (:children node))
constructor (symbol (str "->Component" (capitalize name)))
map-constructor (symbol (str "map->Component" (capitalize name)))
generator (symbol (str "" name))]
(println name)
(println "wutwut")
{:node (api/list-node
[(api/token-node 'declare)
(api/token-node constructor)
(api/token-node map-constructor)
(api/token-node generator)])}))

1
.gitignore vendored
View File

@@ -18,3 +18,4 @@ pom.xml.asc
.hgignore .hgignore
.hg/ .hg/
/.clj-kondo/.cache/

File diff suppressed because one or more lines are too long

11
.lsp/config.edn Normal file
View File

@@ -0,0 +1,11 @@
{: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}}}}

9
project.org Normal file
View File

@@ -0,0 +1,9 @@
#+title: Our World
* Subsystems
** ECS
** Event Loop
** Map system
** Utilities
*** Logging
** Selectors

Binary file not shown.

After

Width:  |  Height:  |  Size: 283 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 288 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 287 B

View File

@@ -1,8 +1,8 @@
;; shadow-cljs configuration ;; shadow-cljs configuration
{:source-paths {:source-paths
["src/dev" ["src/dev"
"src/main" "src/cljs"
"src/test"] "src/clj"]
:dependencies :dependencies
[] []

View File

@@ -0,0 +1,29 @@
(ns sekai.macros.components
(:require [clojure.string :refer [capitalize]]))
(defmacro defcomponent [name fields & [generator constructor destructor]]
(let [kwname (keyword name)
compname (str "Component" (capitalize name))
this (gensym)
eid (gensym)]
`(do
(defrecord ~(symbol compname) ~fields
~'IComponent
(~'attach! [~this ~eid]
(sekai.entity.entity/register-component! ~eid ~kwname ~this)
~(when constructor
`(~constructor ~eid ~this)))
(~'_detach! [~this ~eid]
(sekai.entity.entity/deregister-component! ~eid ~kwname)
~(when destructor
`(~destructor ~eid ~this))))
(defn ~name [~@fields]
(apply ~(symbol (str "->" compname))
~(if generator
`(let [result# (~generator ~@fields)]
(if (sequential? result#)
result#
[result#]))
fields))))))

View File

@@ -0,0 +1,78 @@
(ns buddho.core.dhamma
(:require [buddho.core.state :as s :refer [value reference state]]
[clojure.set :refer [union]]))
(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]
(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))
(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_")
dhamma (make-dhamma
name source data (conj asp-props [name])
consequences is-aspect-of? modify-whole priority)]
(s/register-idea! id dhamma)))
(defn get-data [dhamma key] (get-in dhamma [:data key]))
(defn assoc-data [dhamma key value] (assoc-in dhamma [:data key] value))
(defn register-aspect! [did asp-prop]
(s/register-property! did [:_aspect_of asp-prop]))
(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? 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))
(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))))
(defmethod impl! :default [_dhamma & [_whole]]
(println "default occur"))
(defmethod impl! :print [_dhamma & [whole]]
(println "printing test!")
(println (s/apply-fn :data whole)))

View File

@@ -0,0 +1,59 @@
(ns buddho.core.init
(:require [buddho.core.state :as s]
[buddho.core.dhamma :as d]))
(defn init []
;;; reset game state
(s/reset-state!)
(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)))

View File

@@ -0,0 +1,69 @@
(ns buddho.core.state)
(def empty-state
{:_properties {}})
(defonce state
(atom empty-state))
(defn reset-state! []
(reset! state empty-state))
(defprotocol Idea
(fn-liberal [idea fn]
"Apply function `fn` to `idea`,
accepting both identifiers and values for the latter;
mind that keys are functions.")
(reference [idea] "Reference, i.e. symbol, for `idea`.")
(value [idea] "Value, i.e. map, of `idea`."))
(extend-protocol Idea
cljs.core/PersistentHashMap
(fn-liberal [dhamma fn]
(fn dhamma))
(reference [idea] (:_reference idea))
(value [idea] idea)
cljs.core/PersistentArrayMap
(fn-liberal [dhamma fn]
(fn dhamma))
(reference [idea] (:_reference idea))
(value [idea] idea)
Symbol
(fn-liberal [idea fn]
(fn-liberal (value idea) fn))
(reference [idea] idea)
(value [idea] (get @state idea)))
(defn apply-fn [fn idea] (fn-liberal idea fn))
(defn register-idea! [iid idea]
(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)))
(defn with-property [property]
(get-in @state (concat [:_properties] property [:_node])))
(defn has-property? [idea property]
(contains? (properties idea) property))
(defn get-element [idea element]
(get (value idea) element))

View File

@@ -0,0 +1,50 @@
(ns buddho.tests.dhamma
(:require [cljs.test :as t :include-macros true]
[buddho.core.dhamma :as d]
[buddho.core.state :as s]))
;;; XXX doesn't freeze yet
(t/use-fixtures :once
(fn [tests]
(let [orig-state (swap! s/state identity)]
(s/reset-state!)
(tests)
(reset! s/state orig-state))))
(t/use-fixtures :each
(fn [test]
(s/reset-state!)
(test)))
(t/deftest register-dhamma!
(t/testing "Dhamma Creation"
(let [dhamma (d/register-dhamma! :testname :test)]
(t/is (s/get-element dhamma :source) test))))
(t/deftest register-aspect!
(t/testing "Aspect Registration"
(let [dhamma (d/register-dhamma! :testname :test)
aspect (d/register-dhamma! :aspname :test)]
(d/register-aspect! aspect [:testname])
(t/is (contains? (d/get-aspects [:testname]) aspect))
(t/is (contains? (set (d/aspects-of dhamma)) aspect)))))
(defmethod d/impl! :verify-value [dhamma & [_whole]]
(let [key (d/get-data dhamma :key)
value (d/get-data dhamma key)
expected (d/get-data dhamma :expected)]
(t/is (= value expected))))
(defmethod d/modify-whole :modify-value [dhamma whole]
(let [key (d/get-data dhamma :key)
value (d/get-data dhamma :value)]
(d/assoc-data whole key value)))
(t/deftest aspects
(t/testing "Aspect Execution"
(let [dhamma (d/register-dhamma! :verify-value :test
:data {:test nil :key :test :expected true})
aspect (d/register-dhamma! :modify-value :test
:data {:key :test :value true})]
(d/register-aspect! aspect [:verify-value])
(d/occur! dhamma))))

View File

@@ -0,0 +1,23 @@
(ns sekai.core.gamestate)
(def empty-game-state
{:canvas {:size {:height 512 :width 512}
:canvas nil
:world nil}
:entities {}
:tags {}
:subscribers {}
:settings {:loglevel 1
:tile-size 16}
:camera { :x 0 :y 0 :z 0 }
:sprites {}
:active true
:tick 0
})
(defonce game-state
(atom empty-game-state))
(defn reset-game-state!
([] (reset! game-state empty-game-state))
([active] (reset-game-state!) (swap! game-state assoc :active active)))

View File

@@ -0,0 +1,65 @@
(ns sekai.core.init
(:require ["pixi.js" :as PIXI]
[sekai.core.gamestate :as gs :refer [game-state]]
[sekai.io.pixi :as pixi]
[sekai.core.logging :refer [log]]
[sekai.entity.component :as comp]
[sekai.entity.entity :as entity]
[sekai.io.display :as render]
[sekai.core.space :as space]))
(defn init []
;;; reset game state
(gs/reset-game-state!)
(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)))

View File

@@ -0,0 +1,29 @@
(ns sekai.core.logging
(:require [sekai.core.gamestate :as gs :refer [game-state]]
[sekai.util.util :as util]))
(def levels
{:critical 0
:error 1
:warning 2
:debug 3
:info 4
:verbose 5})
(def r-levels (util/reverse-map levels))
(defn set-level [level]
(swap! game-state update-in [:settings] assoc :loglevel (levels level)))
(defn get-level-n []
(-> @game-state :settings :loglevel))
(defn get-level []
(r-levels (get-level-n)))
(defn should-log [level] (<= (levels level) (get-level-n)))
(defn log
([message] (log :debug message))
([level message]
(when (should-log level) (println level "->" message))))

View File

@@ -0,0 +1,64 @@
(ns sekai.core.space
(:require [sekai.core.gamestate :refer [game-state]]
[sekai.math.vectors :as vect]
[sekai.entity.entity :as entity]))
(defn coords->vec [point]
[(or (:x point) 0) (or (:y point) 0) (or (:z point) 0)])
(defn vec->coords [vec]
(let [vec (vect/vecn->m 3 vec)]
{:x (nth vec 0) :y (nth vec 1) :z (nth vec 2)}))
(defn camera->world
"Position of camera in world-coordinates."
[] (:camera @game-state))
(defn canvas-size [] (-> @game-state :canvas :size))
(defn camera->screen
"Camera position in screen-coordinates <-> center of screen."
[] (let [cs (canvas-size)]
(->> [(:width cs) (:height cs) 0] (vect/div-s 2)
first vec->coords)))
(defn translate-screen
"Translate screenspace coords by (x y) in blockspace."
[s-orig b-trans]
(let [tile (-> @game-state :settings :tile-size)
halftile (/ tile 2)
[trans-x] (vect/mult-s (:x b-trans) [tile (- halftile) 0])
[trans-y] (vect/mult-s (:y b-trans) [(- tile) (- halftile) 0])
[trans-z] (vect/mult-s (:z b-trans) [0 tile 0])]
(->> s-orig coords->vec
(vect/add trans-x) (vect/add trans-y) (vect/add trans-z)
vec->coords)))
(defn world->screen
"World-coordinates to screen-coordinates."
[w-coords]
(let [pos (coords->vec w-coords)
rel (vect/sub pos [0 0 0])]
(translate-screen (camera->screen) (vec->coords rel))))
(defn entity->world
"Entity position in world-coordinates."
[eid]
(entity/get-component eid :position))
(defn entity->screen
"Entity position in screen-coordinates."
[eid]
(world->screen (entity->world eid)))
(defn dist2screen
"Distance between entity and screen in world-coordinates."
[eid]
(reduce + (coords->vec (entity->world eid))))
(defn move-entity!
[eid position]
(entity/update-component!
eid :position
(fn [old] (merge old position))))

View File

@@ -0,0 +1,63 @@
(ns sekai.core.testing
(:require [sekai.core.entity :as e]
[sekai.core.gamestate :as gs :refer [game-state]]
[sekai.entity.selector :as s]
[sekai.core.event :as event]
[sekai.core.component :as comp]
[sekai.core.logging :as logging :refer [log]]
[clojure.test :as t
:refer [use-fixtures
deftest
testing
run-tests
is]]
[sekai.entity.selector :as selector]))
(use-fixtures :once
(fn [tests]
(let [orig-state (swap! game-state identity)]
(log :info "Test Setup")
(gs/reset-game-state! nil)
(tests)
(log :info "Test Teardown")
(reset! game-state orig-state))))
(use-fixtures :each
(fn [test]
(gs/reset-game-state! nil)
(test)))
(deftest register-entity!
(testing "Entity Registration"
(is (e/register-entity!))))
(deftest component-position
(testing "Position Component"
(let [eid (e/register-entity!)]
(comp/attach! (comp/position 0 2 0) eid)
(let [c (e/get-component eid :position)]
(is (:x c) 0)
(is (:y c) 2))
(is (contains? (s/gather (s/with-tag :spatial)) eid))
(comp/detach! :position eid)
(is (not (contains? (s/gather (s/with-tag :spatial)) eid))))))
(deftest selector
(testing "Selectors"
(let [eid1 (e/register-entity!)
eid2 (e/register-entity!)
eid3 (e/register-entity!)]
(e/register-tag! eid1 :one)
(e/register-tag! eid1 :two)
(e/register-tag! eid2 :one)
(e/register-tag! eid2 :two)
(e/register-tag! eid3 :threee)
(let [all (s/gather (s/with-tags :one :two))
some (s/gather (s/some-tags :one :three))]
(is (contains? all eid1))
(is (contains? all eid2))
(is (not (contains? all eid3)))
(is (every? #(contains? some %) [eid1 eid2 eid3]))))))

View File

@@ -0,0 +1,31 @@
(ns sekai.entity.component
#_:clj-kondo/ignore
(:require [sekai.io.pixi :as pixi]
[sekai.entity.entity :as entity]
[sekai.util.util :as util :refer [and-f]]
[sekai.io.display :as render]
[sekai.entity.tags :as tags])
(:require-macros [sekai.macros.components :refer [defcomponent]]))
(defn manip-tag-f [fun tag] (fn [eid] (fun eid tag)))
(defn add-tag-f [tag] (manip-tag-f tags/register-tag! tag))
(defn remove-tag-f [tag] (manip-tag-f tags/deregister-tag! tag))
(defprotocol IComponent
(attach! [component entity])
(_detach! [component entity]))
(defn detach! [component entity]
(_detach! (entity/get-component entity component) entity))
(defcomponent position [x y z] nil
(add-tag-f :spatial) (remove-tag-f :spatial))
(defcomponent sprite [sprite]
pixi/make-sprite!
(and-f (add-tag-f :visual) render/enable!)
(and-f (remove-tag-f :visual) render/disable!))
(defcomponent screen-position [x y] nil
(add-tag-f :ui) (remove-tag-f :ui))

View File

@@ -0,0 +1,41 @@
(ns sekai.entity.entity
(:require [sekai.core.gamestate
:as gs
:refer [game-state]]
[sekai.core.logging :as logging :refer [log]]))
(defn set-component! [entity name data]
(swap! game-state update-in [:entities entity]
assoc name data))
(defn get-component [entity component-name]
(get-in @game-state [:entities entity component-name]))
(defn register-component! [entity name data]
(if-not (get-component entity name)
(set-component! entity name data)
(throw (ex-info "Component Doubly Registered"
{:entity entity :name name :data data}))))
(defn deregister-component! [entity component]
(swap! game-state update-in [:entities entity] dissoc component))
(defn update-component! [entity component update-fn]
(swap!
game-state
(fn [gs]
(if-let [data (get-in @game-state [:entities entity component])]
(do
(log :info (str "update-component: " entity component (update-fn data)))
(assoc-in gs [:entities entity component] (update-fn data)))
(do (log :critical
(str "Unknown Component " component
" for entity " entity))
gs)))))
(defn register-entity! [& [name]]
(let [eid (gensym (or name "entity_"))]
(swap! game-state update-in [:entities] assoc eid {})
(register-component! eid :tags #{})
eid))

View File

@@ -0,0 +1,36 @@
(ns sekai.entity.selector
(:require [sekai.core.gamestate :refer [game-state]]
[clojure.set :refer [union intersection]]))
(defmulti gather :type)
(defn just [entity] {:type :just :data entity})
(defmethod gather :just [{:keys [data]}]
#{data})
(defn with-tag [tag] {:type :with-tag :data tag})
(defmethod gather :with-tag [{:keys [data]}]
(-> @game-state :tags data))
(defn all [] {:type :all :data nil})
(defmethod gather :all [_]
(-> @game-state :entities keys set))
(defn s-or [& selectors] {:type :or :data selectors})
(defmethod gather :or [{:keys [data]}]
(->> data (map gather) (reduce union)))
(defn s-and [& selectors] {:type :and :data selectors})
(defmethod gather :and [{:keys [data]}]
(->> data (map gather) (reduce intersection)))
(defn with-tags [& tags] {:type :all-tags :data tags})
(defmethod gather :all-tags [{:keys [data]}]
(gather (apply s-and (map with-tag data))))
(defn some-tags [& tags] {:type :some-tags :data tags})
(defmethod gather :some-tags [{:keys [data]}]
(gather (apply s-or (map with-tag data))))
(defn do-selector [selector fn]
(run! fn (gather selector)))

View File

@@ -0,0 +1,12 @@
(ns sekai.entity.tags
(:require [sekai.core.gamestate :refer [game-state]]
[sekai.entity.entity :as entity]))
(defn register-tag! [eid tag]
(swap! game-state update-in [:tags tag] (fnil conj #{}) eid)
(entity/update-component! eid :tags #((fnil conj #{}) % tag))
)
(defn deregister-tag! [eid tag]
(swap! game-state update-in [:tags tag] disj eid)
(entity/update-component! eid :tags #(disj % tag)))

View File

@@ -0,0 +1,32 @@
(ns sekai.event.event
(:require [sekai.entity.selector :as selector]
[sekai.util.util :as util]
[sekai.event.subscriber :as subscriber]
[sekai.event.queue :as queue]
[sekai.core.gamestate :refer [game-state]]))
(defn make-event [type source targets data cascades]
{ :id (gensym "event_")
:type type
:source source
:targets targets
:data data
:cascades cascades })
(defmulti dispatch! :type)
(defn do-event!
"Execute `event`, applying listeners and handling cascades."
[event]
(let [[queue cascade]
(-> event
(update :targets (partial util/map-values selector/gather))
subscriber/process-subscribers
dispatch!)]
(run! queue/enqueue! queue)
(run! do-event! cascade)))
(defn process-tick! [tick]
(let [queue (get-in @game-state [:queue tick])]
(run! do-event! queue)
(swap! game-state assoc-in [:queue tick] nil)))

View File

@@ -0,0 +1,8 @@
(ns sekai.event.queue
(:require [sekai.core.gamestate :refer [game-state]]))
(defn next-tick []
(-> @game-state :tick inc))
(defn enqueue! [event tick]
(swap! game-state update-in [:queue (max tick (next-tick))] (fnil conj []) event))

View File

@@ -0,0 +1,27 @@
(ns sekai.event.subscriber
(:require [sekai.core.gamestate :refer [game-state]]))
(defn make-subscriber [type predicate & [target-m data-m cascades-m]]
{ :id (gensym "subscriber_")
:type type
:predicate predicate
:target-m (or target-m identity)
:data-m (or data-m identity)
:cascades-m (or cascades-m identity) })
(defn register-subscriber! [sub]
(swap! game-state update-in [:subscribers (:type sub)] (fnil conj []) sub))
(defn get-subscribers [event]
(let [subs (get-in @game-state [:subscribers (:type event)])]
(filter #((:predicate %) event) subs)))
(defn apply-subscriber [event sub]
(-> event
(update-in [:targets] (:target-m sub))
(update-in [:data] (:data-m sub))
(update-in [:cascades] (:cascades-m sub))))
(defn process-subscribers [event]
(let [subs (get-subscribers event)]
(reduce #(apply-subscriber %1 %2) event subs)))

View File

@@ -0,0 +1 @@
(ns sekai.io.audio)

View File

@@ -0,0 +1,106 @@
(ns sekai.io.display
(:require [sekai.core.gamestate :refer [game-state]]
[sekai.entity.selector :as s]
[sekai.entity.entity :as entity]
[sekai.core.space :as space]
[sekai.math.vectors :as vect]
[sekai.core.logging :refer [log]]
[sekai.entity.tags :as tags]))
(defn sprite [entity]
(get-in @game-state [:entities entity :sprite :sprite]))
(defn center->orig
"Center of sprite to sprite origin in screenspace."
[entity s-center]
(let [sprite (sprite entity)
width (.-width sprite)
height (.-height sprite)]
(-> s-center space/coords->vec
(vect/sub [width height 0])
space/vec->coords)))
(defn binary-search-insertion-index [sorted-children dist-fn new-sprite-dist]
(loop [low 0
high (count sorted-children)]
(if (< low high)
(let [mid (bit-shift-right (+ low high) 1)
mid-sprite (nth sorted-children mid)
mid-dist (dist-fn mid-sprite)]
(if (>= mid-dist new-sprite-dist)
(recur low mid)
(recur (inc mid) high)))
low)))
(defn linear-search-insertion-index [sprites-array dist-fn distance]
(loop [idx 0]
(if (or (= idx (count sprites-array))
(>= distance (dist-fn (nth sprites-array idx))))
idx
(recur (inc idx)))))
(defn sprite2screen [sprite]
(space/dist2screen (get-in @game-state [:sprites sprite])))
(defn enable! [eid]
(let [sprite (sprite eid)
world ^js/PIXI.Container (-> @game-state :canvas :world)
new-sprite-dist (space/dist2screen eid)
sorted-children (-> world .-children js->clj)]
(tags/register-tag! eid :visible)
(swap! game-state update-in [:sprites] assoc sprite eid)
;;; FIXME unfuck
(-> sprite .-anchor (.set 0.0))
(let [insertion-index
(linear-search-insertion-index
sorted-children sprite2screen new-sprite-dist)]
(.addChildAt ^js/PIXI.Container world sprite insertion-index))))
(defn disable! [eid]
(let [sprite (sprite eid)
world (-> @game-state :canvas :world)]
(tags/deregister-tag! eid :visible)
(.removeChild world sprite)))
(defn render-screen! [eid s-coords]
(let [sprite (sprite eid)
orig (center->orig eid s-coords)]
(set! (.-x sprite) (:x orig))
(set! (.-y sprite) (:y orig)) ))
(defn render-world! [eid]
(render-screen!
eid (-> eid (entity/get-component :position)
space/world->screen)))
(defn sort-sprites! []
(let [stage (-> @game-state :canvas :canvas .-stage)]
(set!
(.-children stage)
(.sort
(.-children stage)
(fn [a b]
(let [eid1 (get-in @game-state [:sprites a])
eid2 (get-in @game-state [:sprites b])]
(- (space/dist2screen eid2) (space/dist2screen eid1))))))))
(defn render! [& [delta]]
(let [uis (s/gather (s/with-tags :ui :visible))
spatials (s/gather (s/with-tags :spatial :visible))]
(run! render-world! spatials)
(run! render-screen! uis)))
(defn move-camera!
"Set position of camera; nil leaves coord unchanged."
[x & [y z]]
(let [camera (space/camera->world)
coords {:x (or x (:x camera)) :y (or y (:y camera)) :z (or z (:z camera))}
world (-> @game-state :canvas :world)
tile-size (-> @game-state :settings :tile-size)]
(swap! game-state assoc :camera coords)
(set! (.-x world.position) (* (:x coords) tile-size))
(set! (.-y world.position) (* (:y coords) tile-size))))

View File

@@ -0,0 +1,2 @@
(ns sekai.io.input)

View File

@@ -1,9 +1,9 @@
(ns sekai.core.pixi (ns sekai.io.pixi
(:require ["pixi.js" :as PIXI])) (:require ["pixi.js" :as PIXI]))
(defn make-canvas! [width height] (defn make-canvas! [width height]
(PIXI/Application. #js {:width width :height height (PIXI/Application. #js {:width width :height height
:backgroundColor 0x1099bb})) :backgroundColor 0x444444}))
(defn clear-canvas! [] (defn clear-canvas! []
(let [cur-canvas (.querySelector js/document.body ".game-view")] (let [cur-canvas (.querySelector js/document.body ".game-view")]

View File

@@ -0,0 +1,33 @@
(ns sekai.math.vectors)
(defn vecn->m "Convert a vector to an m-element vector." [m v]
(vec (take m (into v (repeat (- m (count v)) 0)))))
(defn components [vecs]
(vec (map (fn [idx] (map #(nth % idx) vecs))
(range (count (first vecs))))))
(defn comp-reduce [op vecs]
(vec (map #(reduce op %) (components vecs))))
(defn manip-scalar
"Manipulate Vectors by Scalar and Operation."
[op s vecs]
(map #(op % (repeat (count %) s)) vecs))
(defn dist "Distance between two Vectors."
[v1 v2]
(reduce + (map #(abs (- %1 %2)) v1 v2)))
(defn add "Add Vectors." [& vecs] (comp-reduce + vecs))
(defn sub "Subtract Vectors." [& vecs] (comp-reduce - vecs))
(defn mult "Multiply Vectors." [& vecs] (comp-reduce * vecs))
(defn div "Divide Vectors." [& vecs] (comp-reduce / vecs))
(defn mult-s "Multiply Vectors by Scalar"
[s & vecs] (manip-scalar mult s vecs))
(defn div-s "Divide Vectors by Scalar"
[s & vecs] (manip-scalar div s vecs))
(defn dot "Dot Product" [& vecs] (reduce + (apply mult vecs)))

View File

@@ -0,0 +1,10 @@
(ns sekai.util.util)
(defn reverse-map [m]
(reduce (fn [acc [k v]] (assoc acc v k)) {} m))
(defn and-f [& funcs]
(fn [arg] (doseq [f funcs] (f arg))))
(defn map-values [f m]
(zipmap (keys m) (map f (vals m))))

View File

@@ -1,27 +0,0 @@
(ns sekai.core.components
(:require [sekai.core.pixi :as pixi]
[sekai.core.entity :as entity]))
(defn- manip-tag [fun tag] (fn [eid] (fun eid tag)))
(defn- add-tag [tag] (manip-tag entity/register-tag! tag))
(defn- remove-tag [tag] (manip-tag entity/deregister-tag! tag))
(defmulti attach (fn [component _] (:name component)))
(defmulti detach (fn [component _] (:name component)))
(defn position [x y]
{:name :position
:data [x y]
:hook (add-tag :spatial)})
(defmethod attach :position [{:keys [data]} eid]
(print data eid))
(defn tags [& tags]
{:name :tags
:data (set tags)
:hook nil})
(defn sprite [url]
{:name :sprite
:data (pixi/make-sprite! url)
:hook (add-tag :renderable)})

View File

@@ -1,43 +0,0 @@
(ns sekai.core.entity
(:require [sekai.core.gamestate
:as gs
:refer [game-state]]
[sekai.core.components :as components]))
(defn set-component! [entity component]
(swap! game-state update-in [:entities entity]
assoc (:name component) (:data component)))
(defn get-component [entity component-name]
(get-in @game-state [:entities entity component-name]))
(defn register-component! [entity comp-spec]
(if-not (get-component entity (:name comp-spec))
(set-component! entity comp-spec)
(throw (ex-info "Component Doubly Registered"
{:entity entity :component comp-spec}))))
(defn deregister-component! [entity component]
(swap! game-state update-in [:entities entity] dissoc component))
(defn update-component! [entity component update-fn]
(swap! game-state
(fn [gs]
(if-let [data (get-in @game-state [:entities entity component])]
(assoc-in gs [:entities entity component] (update-fn data))
(throw (ex-info "Unknown Component"
{:entity entity :component component}))))))
(defn register-entity! []
(let [eid (gensym "entity_")]
(swap! game-state update-in [:entities] assoc eid {})
(register-component! eid (components/tags))
eid))
(defn register-tag! [entity tag]
(swap! game-state update-in [:tags tag] (fnil conj #{}) entity)
(update-component! entity :tags #((fnil conj #{}) % tag)))
(defn deregister-tag! [entity tag]
(swap! game-state update-in [:tags tag] disj entity)
(update-component! entity :tags #(disj % tag)))

View File

@@ -1,38 +0,0 @@
(ns sekai.core.event
(:require [main.sekai.core.gamestate
:as gs
:refer [game-state]]
[main.sekai.core.entity :as entity]
[main.sekai.core.selector :as selector]))
(defn enqueue! [event]
(swap! (:queue @game-state) conj event))
(defn dequeue! []
(let [queue (:queue @game-state)
item (first @queue)]
(swap! queue rest)
item))
(defn make-event [id type source selector data]
{:id id
:type type
:source source
:selector selector
:data data})
(defn dispatch-helper! [event changes]
(selector/do-selector
(:selector event)
(fn [entity]
(doseq [[component fun] changes]
(entity/update-component! entity component fun)))))
(defmulti do-event! :type)
(defmethod do-event! :move [event]
(dispatch-helper! event {:position (fn [_] (:data event))}))
(defmethod do-event! :register-entity [event]
(let [eid (entity/register-entity!)]
(doseq [tag (-> event :data :tags)] (entity/register-tag! eid tag))
(doseq [component (-> event :data :components)] (entity/register-component! eid component))))

View File

@@ -1,13 +0,0 @@
(ns sekai.core.gamestate)
(def empty-game-state
{:canvas nil
:entities {}
:tags {}
})
(defonce game-state
(atom empty-game-state))
(defn reset-game-state! []
(reset! game-state empty-game-state))

View File

@@ -1,29 +0,0 @@
(ns sekai.core.init
(:require ["pixi.js" :as PIXI]
[sekai.core.gamestate :refer [game-state]]
[sekai.core.pixi :as pixi]))
(defn render []
(let [state @game-state
bnuuy (get-in state [:entities :bnuuy])
sprite (:sprite bnuuy)
position (:position bnuuy)]
(set! (.-x sprite) (:x position))
(set! (.-y sprite) (:y position))
(set! (.-rotation sprite) (:angle bnuuy))
))
(defn init []
(println "Hello World")
(let [game (pixi/make-canvas! 256 256)
bnuuy (-> PIXI .-Sprite (.from "https://pixijs.com/assets/bunny.png"))]
(.appendChild js/document.body (.-view game))
(set! (.-className (.-view game)) "game-view")
(-> game .-stage (.addChild bnuuy))
(-> bnuuy .-anchor (.set 0.5))
; (-> game .-ticker (.add (fn [delta] (gameloop delta))))
(println game)))

View File

@@ -1,19 +0,0 @@
(ns sekai.core.selector
(:require [sekai.core.gamestate :refer [game-state]]))
(defmulti gather :type)
(defn just [entity] {:type :just :data entity})
(defmethod gather :just [{:keys [data]}]
#{data})
(defn with-tag [tag] {:type :with-tag :data tag})
(defmethod gather :with-tag [{:keys [data]}]
(-> @game-state :tags data))
(defn all [] {:type :all :data nil})
(defmethod gather :all [_]
(-> @game-state :entities keys set))
(defn do-selector [selector fn]
(map fn (gather selector)))