(ns entitas-clj.collection
  (:require [entitas-clj.matcher :as m]))

(defn init-with-matcher [matcher mname mkey]
  (atom {:mkey mkey
         :name mname
         :matcher matcher
         :entities {}
         :add-observers #{}
         :remove-observers {}}))

(defn init-with-types [ctypes]
  (let [mname "entitas-clj.matcher/all-of-set"
        mkey (m/to-key mname ctypes)]
    (init-with-matcher #(entitas-clj.matcher/all-of-set ctypes %) mname mkey)))

(defn entities [collection]
  (vals (:entities @collection)))

(defn type-matcher [collection]
  (:matcher @collection))

(defn notify [observers event-type collection entity]
  (doseq [observer observers]
    (observer entity collection)))

(defn do-add [c path entity]
  (if (nil? (get-in c path))
    (assoc-in c path entity)
    c))

(defn add-entity [collection entity]
  (let [path [:entities (:creation-index @entity)]]
    (swap! collection do-add path entity)
    (notify (:add-observers @collection) :added collection entity)
    collection))

(defn exchange-entity [collection entity]
  (let [path [:entities (:creation-index @entity)]]
    (if (nil? (get-in @collection path))
      (add-entity collection entity)
      (do
        (swap! collection assoc-in path entity)
        (notify (:remove-observers @collection) :removed collection entity)
        (notify (:add-observers @collection) :added collection entity)
        collection))))

(defn remove-entity [collection entity]
  (let [creation-index (:creation-index @entity)
        path [:entities creation-index]]
    (if (nil? (get-in @collection path))
      collection
      (do
        (swap! collection update-in [:entities] dissoc creation-index)
        (notify (:remove-observers @collection) :removed collection entity)
        collection))))

(defn add-observer [collection observer event-type]
  (let [path (case event-type
               :added [:add-observers]
               :removed [:remove-observers])]
    (swap! collection update-in path conj observer)))

(defn remove-observer [collection observer event-type]
  (let [path (case event-type
               :added [:add-observers]
               :removed [:remove-observers])]
    (swap! collection update-in path remove observer)))

(ns entitas-clj.component)

(defn create
  ([type]
     (create type nil))
  ([type data]
     {:type type :data data}))

(ns entitas-clj.core
  (:require [entitas-clj.entity :as e]
            [entitas-clj.repository :as r]))

      (set! *warn-on-reflection* true)

(defn add-component [repository entity component]
  (let [new-entity (e/add-component entity component)]
    (r/add-component repository (:type component) new-entity)))

(defn exchange-component [repository entity component]
  (let [new-entity (e/exchange-component entity component)]
    (r/exchange-component repository (:type component) new-entity)))

(defn remove-component [repository entity ctype]
  (let [new-entity (e/remove-component-of-type entity ctype)]
    (r/remove-component repository ctype new-entity)))

(ns entitas-clj.entity
  (:require [clojure.set :refer [subset?]]))

(defn create [id & comps]
  (let [components (into {} (map (fn [{:keys [type] :as comp}] [type comp]) comps))
        ctypes (set (map :type comps))]
    (atom {:id id
           :creation-index nil
           :components components
           :ctypes ctypes})))

(defn has-component-of-type [entity ctype]
  (contains? (:ctypes @entity) ctype))

(defn has-components-of-types [entity ctypes]
  (subset? ctypes (:ctypes @entity)))

(defn component-of-type [entity ctype]
  (get-in @entity [:components ctype]))

(defn data-for-component [entity ctype]
  (:data (component-of-type entity ctype)))

(defn contains-component [entity component]
  (not (nil? (component-of-type entity (:type component)))))

(defn- do-add [entity component]
  (let [ctype (:type component)]
    (swap! entity #(-> %
                       (update-in ,, [:ctypes] conj ctype)
                       (assoc-in ,, [:components ctype] component))))
  entity)

(defn add-component [entity component]
  (if (not (has-component-of-type entity (:type component)))
    (do-add entity component)
    entity))

(defn exchange-component [entity component]
  (do-add entity component))

(defn remove-component-of-type [entity ctype]
  (when (has-component-of-type entity ctype)
    (swap! entity (fn [a]
                    (update-in a [:ctypes] #(set (remove #{ctype} %)))
                    (update-in a [:components] #(dissoc % ctype)))))
  entity)

(ns entitas-clj.example
  (:require [entitas-clj.core :as cr]
            [entitas-clj.component :as c]
            [entitas-clj.collection :as cl]
            [entitas-clj.entity :as e]
            [entitas-clj.repository :as r]
            [entitas-clj.system :as s]
            [lanterna.screen :as ls]
            [clojure.core.async :refer [chan go put! alts! <! >! timeout]]))

(def timeout-value 50)

(defn create-player [x y]
  (e/create :player
            (c/create :position {:x x :y y})
            (c/create :player)
            (c/create :render {:char "X"})))

(defn create-enemy [x y]
  (e/create :enemy
            (c/create :position {:x x :y y})
            (c/create :render {:char "E"})))

(defn handle-input [{:keys [x y] :as position} input]
  (let [[new-x new-y] (case input
                        :left [(- x 1) y]
                        :right [(inc x) y]
                        :up [x (- y 1)]
                        :down [x (inc y)]
                        [x y])]
    (assoc position :x new-x :y new-y)))

(defn update-position [entity input]
  (let [component (e/component-of-type entity :position)]
    (update-in component [:data] handle-input input)))

(defn input->entities [screen]
  (loop [input (ls/get-key screen)
         acc []]
    (if (not (nil? input))
      (let [comp (c/create :key-press {:input input})
            new-acc (conj acc (e/add-component (e/create nil) comp))]
        (recur (ls/get-key screen) new-acc))
      acc)))

(defn collect-input [repository screen]
  (let [input-entities (input->entities screen)]
    (reduce (fn [acc entity]
              (r/add-entity acc entity)) repository input-entities)))

(defn execute-enemy-move-system [repository]
  (let [[new-repository rc] (r/collection-for-types repository #{:enemy})]
    new-repository))

(defn get-player-entity [repository]
  (let [[r0 pc] (r/collection-for-types repository #{:player})
        player (first (cl/entities pc))]
    [r0 player]))

(defn execute-input-system [repository]
  (let [[r0 player] (get-player-entity repository)
        [new-repository rc] (r/collection-for-types r0 #{:key-press})]
    (reduce (fn [acc entity]
              (let [input (:data (e/component-of-type entity :key-press))
                    position-component (update-position player (:input input))
                    r1 (cr/exchange-component acc player position-component)
                    r2 (r/remove-entity r1 entity)]
                r2)) new-repository (cl/entities rc))))

(defn execute-render-system [screen repository]
  (let [[new-repository rc] (r/collection-for-types repository #{:render})]
    (ls/clear screen)
    (doseq [entity (cl/entities rc)]
      (let [{:keys [x y]} (e/data-for-component entity :position)
            {:keys [char]} (e/data-for-component entity :render)]
        (ls/put-string screen x y char)))
    (ls/redraw screen)
    new-repository))

(defn initial-state [width height]
  (let [player (create-player 0 0)
        enemy (create-enemy 22 22)
        repository (-> (r/create) (r/add-entity ,, player) (r/add-entity ,, enemy))
        input-system (s/create :input-system execute-input-system)
        enemy-system (s/create :enemy-system execute-enemy-move-system)
        screen (ls/get-screen :swing {:cols width :rows height})
        render-system (s/create :render-system #(execute-render-system screen %))
        systems [input-system enemy-system render-system]]
    (ls/start screen)
    {:systems systems :repository repository :screen screen}))

(defn start [width height]
  (let [command-chan (chan)]
    (go
     (loop [state (initial-state width height)
            timer (timeout timeout-value)]
       (let [[v c] (alts! [timer command-chan])]
         (condp = c
           command-chan (when v
                      (recur state timer))
           timer (let [repository0 (collect-input (:repository state) (:screen state))
                       repository1 (s/execute (:systems state) repository0)]
                   (recur (assoc state :repository repository1) (timeout timeout-value)))))))))

(start 40 40)

(ns entitas-clj.macros)

(defmacro with-time [& body]
  (let [fname (first (flatten body))]
    `(let [start-time# (.getTime (js/Date.))
           result# ~@body
           end-time# (.getTime (js/Date.))]
       (.log js/console ~fname "---" (- end-time# start-time#) "ms")
       result#)))

(ns entitas-clj.matcher
  (:require [clojure.set :refer [subset? intersection]]))

(defn all-matching? [a b]
  (subset? a b))

(defn any-matching? [a b]
  (not (= #{} (intersection a b))))

(defn equal? [a b]
  (= a b))

(defn all-of [ctypes-a & ctypes-b]
  (all-matching? ctypes-a (set ctypes-b)))

(defn all-of-set [ctypes-a ctypes-b]
  (all-matching? ctypes-a ctypes-b))

(defn any-of [ctypes-a & ctypes-b]
  (any-matching? ctypes-a (set ctypes-b)))

(defn any-of-set [ctypes-a ctypes-b]
  (any-matching? ctypes-a ctypes-b))

(defn just [type-a ctypes-b]
  (all-matching? #{type-a} ctypes-b))

(defn to-key [mtype ctypes]
  (let [safe-ctypes (if (coll? ctypes) ctypes [ctypes])]
    (apply str mtype safe-ctypes)))

(ns entitas-clj.performance
        (:gen-class)
  (:require [entitas-clj.core :as cr]
            [entitas-clj.repository :as r]
            [entitas-clj.entity :as e]
            [entitas-clj.component :as cm]
            [entitas-clj.collection :as c]
            [entitas-clj.matcher :as m]))

(def simple-component {:type :foo :a 1 :b 2})
(def another-simple-component {:type :bar :x 1 :y 2})

(defn entry-creation-bench [repository num-entities ctype1 ctype2]
  (reduce (fn [acc i]
            (let [entity (e/create :foo)
                  new-acc (r/add-entity acc entity)]
              (condp = (mod i 25)
                0 (cr/add-component new-acc entity (cm/create ctype1))
                1 (cr/add-component new-acc entity (cm/create ctype2))
                new-acc)))
          repository (range num-entities)))

(defn collection-creation-bench [repository ctype]
  (r/collection-for-types repository #{ctype}))

(defn getting-all-entities-initially [collection]
  (let [result (atom nil)]
    (doseq [n (range 100)]
      (reset! result (c/entities collection)))
    @result))

(defn getting-all-entities-from-repository [repository ctype]
  (let [result (atom nil)
        mtype entitas-clj.matcher/all-of-set
        mname "entitas-clj.matcher/all-of-set"
        matcher-config {:mtype mtype :mname mname :ctypes #{ctype}}]
    (doseq [n (range 100)]
      (let [[new-repository entities] (r/entities-for-matcher repository matcher-config)]
        (reset! result entities)))
    @result))

(defn exchange-component-in-all-entities [repository entities]
  (let [[i result] (reduce (fn [[idx acc] entity]
                             (let [r (cr/exchange-component acc entity (cm/create :foo))]
                               [(inc idx) r])) [0 repository] entities)]
    (println "exhanged" i "components")
    result))

(defn destroy-all-entities [repository]
  (reduce (fn [acc entity]
            (r/remove-entity acc entity)) repository (r/all-entities repository)))

(defmacro with-time [& body]
  (let [fname (first (flatten body))]
    `(let [start-time# (System/currentTimeMillis)
           result# ~@body]
       (println ~fname "---" (- (System/currentTimeMillis) start-time#) "ms")
       result#)))

(defn run-test [entity-count]
  (let [ctype1 :foo
        ctype2 :bar
        r1 (with-time (entry-creation-bench (r/create) entity-count ctype1 ctype2))
        [r2 c1] (with-time (collection-creation-bench r1 ctype1))
        c2 (with-time (getting-all-entities-initially c1))
        c3 (with-time (getting-all-entities-from-repository r2 ctype1))
        r3 (with-time (exchange-component-in-all-entities r2 (vals c3)))
        r4 (with-time (destroy-all-entities r3))]
    nil))

      (defn -main [& args]
        (dotimes [n 100] (run-test 1000000)))

(ns entitas-clj.repository
  (:require [entitas-clj.entity :as e]
            [entitas-clj.collection :as c]
            [entitas-clj.matcher :as m]))

(defn create []
  {:entities {}
   :collections {}
   :collections-for-type {}
   :current-index 0})

(defn all-entities [repository]
  (vals (:entities repository)))

(defn contains-entity [repository entity]
  (not (nil? (get-in repository [:entities (:creation-index @entity)]))))

(defn internal-collections-for-type [repository ctype]
  (or (get-in repository [:collections-for-type ctype]) #{}))

(defn memoize-matcher [repository {:keys [mtype mname ctypes] :as matcher-config}]
  (let [matcher #(mtype ctypes %)
        mkey (m/to-key mname ctypes)
        mcoll (reduce (fn [acc entity]
                        (if (matcher (:ctypes @entity))
                          (c/add-entity acc entity)
                          acc))
                      (c/init-with-matcher matcher mname mkey) (all-entities repository))
        r0 (update-in repository [:collections] assoc mkey mcoll)
        r1 (reduce (fn [acc ctype]
                     (let [f (fnil (fn [colls]
                                     (conj colls mcoll)) #{})]
                       (update-in acc [:collections-for-type ctype] f))) r0 ctypes)]
    [r1 mcoll]))

(defn collection-for-matcher [repository {:keys [mtype mname ctypes] :as matcher-config}]
  (let [mkey (m/to-key mname ctypes)
        collection (get-in repository [:collections mkey])]
    (if (nil? collection)
      (memoize-matcher repository matcher-config)
      [repository collection])))

(defn entities-for-matcher [repository matcher-config]
  (let [[new-repository collection] (collection-for-matcher repository matcher-config)]
    [new-repository (c/entities collection)]))

(defn collection-for-types [repository ctypes]
  (let [mtype entitas-clj.matcher/all-of-set
        mname "entitas-clj.matcher/all-of-set"]
    (collection-for-matcher repository {:mtype mtype :mname mname :ctypes ctypes})))

(defn add-component [repository ctype entity]
  (let [f (fn [collection]
            (if ((:matcher @collection) (:ctypes @entity))
              (c/add-entity collection entity)
              collection))
        cft (set (map f (internal-collections-for-type repository ctype)))]
    (if (empty? cft)
      repository
      (assoc-in repository [:collections-for-type ctype] cft))))

(defn exchange-component [repository ctype entity]
  (let [f (fn [collection]
            (if ((:matcher @collection) (:ctypes @entity))
              (c/exchange-entity collection entity)
              collection))
        cft (set (map f (internal-collections-for-type repository ctype)))]
    (if (empty? cft)
      repository
      (assoc-in repository [:collections-for-type ctype] cft))))

(defn remove-component [repository ctype entity]
  (let [ctypes (:ctypes @entity)
        f (fn [collection]
            (if ((:matcher @collection) ctypes)
              (c/remove-entity collection entity)
              collection))
        cft (set (map f (internal-collections-for-type repository ctype)))]
    (if (empty? cft)
      repository
      (assoc-in repository [:collections-for-type ctype] cft))))

(defn remove-entity [repository entity]
  (let [ctypes (:ctypes @entity)
        creation-index (:creation-index @entity)
        r1 (reduce (fn [acc ctype]
                     (remove-component acc ctype entity)) repository ctypes)]
    (update-in r1 [:entities] dissoc creation-index)))

(defn add-entity [{:keys [current-index] :as repository} entity]
  (swap! entity assoc :creation-index current-index)
  (let [components (vals (:components @entity))
        r0 (-> repository
               (assoc-in ,, [:entities current-index] entity)
               (update-in ,, [:current-index] inc))]
    (reduce (fn [acc component]
              (add-component acc (:type component) entity)) r0 components)))

(ns entitas-clj.system
  (:refer-clojure :exclude [remove])
  (:require       [clojure.core.async :refer [chan go sliding-buffer put! alts!]]))

(defn create [type execute-fn]
  {:type type
   :active true
   :execute-fn execute-fn
   :activate-fn nil
   :deactivate-fn nil})

(defn create-systems []
  [])

(defn add [systems system]
  (conj systems system))

(defn contains [systems system]
  (some #{system} systems))

(defn remove [systems system]
  (vec (clojure.core/remove #{system} systems)))

(defn execute [systems repository]
  (reduce (fn [acc system]
            ((:execute-fn system) acc)) repository systems))

(defn activate [systems]
  (vec (map (fn [system]
              ((:activate-fn system) system)
              (assoc system :active true)) systems)))

(defn deactivate [systems]
  (vec (map (fn [system]
              ((:deactivate-fn system) system)
              (assoc system :active false)) systems)))

(defn remove-all [systems]
  [])