game.components.core

gistfile1.clj

(ns game.components.core
  (:use
    [clojure.contrib.def :only (defvar-)]
    (game.utils [core :only (safe-merge 
                              keywords-to-hash-map
                              get-unique-number
                              runmap 
                              if-do
                              distinct-seq?)])))

(defvar- id-entity-map (atom {})) 

(defprotocol Entity 
  (get-components [this]) 
  (get-component [this ctype]))

(extend-protocol Entity
  clojure.lang.IDeref
    (get-components [this] (vals @this)) 
    (get-component [this ctype] (ctype @this))
  clojure.lang.IPersistentMap
    (get-components [this] (vals this)) 
    (get-component [this ctype] (ctype this))) 

(defn get-entity [id] (get @id-entity-map id))

(defn get-entity-of [component] 
  (get-entity (:entity-id component)))

(defn get-id [entity]  ; memoizable if performance bottleneck
  (if entity
    (:entity-id (first (get-components entity)))))

(defn exists? [entity] (get-entity (get-id entity)))

;; Component

(defn create-comp 
  "All components should be created with this function.
  Special keys:
  :depends [:a :b :c] -> entity checks at creation if :a :b and :c components exist.
  :init, :destroy -> function with (fn [entity]) called at creation, removal of entity.
  Uses safe-merge - asserts that no keys in props is overridden." 
  [ctype & maps] 
  {:pre [(keyword? ctype) 
         (every? map? maps)]}  
  (apply safe-merge {:type ctype} maps))

(defmacro defcomponent
  "the first element of body may be {:pre :post}; the rest should be maps merged into the component-map.
  creates a factory function with name: ctype-component.
  Any number of arguments in arg-vector can be keywords, and for every keyword a map is conjoined to the body with those keywords as keys."  
  [ctype arg-vector & body]
  (let [keywords-map (keywords-to-hash-map (filter keyword? arg-vector))
        ; transform optional keywords to symbols for a standart arg-vector        
        arg-vector (vec (map #(symbol (name %)) arg-vector))  
        first-element (first body) 
        is-condition (and 
                       (map? first-element) 
                       (or (:pre first-element) (:post first-element)))
        body (if is-condition
               `(~first-element (create-comp ~ctype ~@(conj (rest body) keywords-map))) ; mach 'apply
               `((create-comp ~ctype ~@(conj body keywords-map))))] ; mach 'apply
    `(defn ~(symbol (str (name ctype) "-component")) ~arg-vector
       ~@body)))

;; Entity

(defn get-unique-entity-id [] (get-unique-number))

(defn assoc-uid [maps uid] ; rename assoc-entity-id
  (map #(assoc % :entity-id uid) maps))

(defn- dependencies-ok? [components]
  (let [types (map :type components)]  
    (every? 
      (fn [component]
        (if-let [dependencies (:depends component)]
          (every? #(some #{%} types) dependencies)
          true))
      components))) 

(defn create-entity-with-id
  "Must have one or more components."   
  [uid & components] 
  {:pre [(pos? (count components)) ; because get-id only works with >1 components. 
         (distinct-seq? (map :type components))
         (dependencies-ok? components)]} 
  (let [components (assoc-uid components uid)
        entity (atom (zipmap (map :type components) components))]
    (swap! id-entity-map assoc uid entity)
    (runmap #(if-do (:init %) entity) components) 
    entity))

(defn create-entity
  "Must have one or more components."  
  [& components]
  (apply create-entity-with-id (get-unique-entity-id) components)) 

;; Removelist

(defvar- removelist (atom #{})) 

(defn add-to-removelist [entity-or-id] ; arglist benutzen und hier kürzere version entity nur als arg?
  (let [id (if (number? entity-or-id) entity-or-id (get-id entity-or-id))]
    (swap! removelist conj id)))

(defn- remove-entity-from-game 
  "do not call this at mapping through components - use add-to-removelist instead.
  because calling this while update-components is running could lead to NullPointerE" 
  [entity]
  (when (and entity (exists? entity))
    (swap! id-entity-map dissoc (get-id entity))
    (runmap #(if-do (:destroy %) entity) (get-components entity))))
    
(defn update-removelist []
  (runmap #(remove-entity-from-game (get-entity %)) @removelist)
  (reset! removelist #{}))