     new-worlds))
 
 (om/root
- render-root
- world-state
- {:target (. js/document (getElementById "app"))
+  render-root
+  world-state
+  {:target (. js/document (getElementById "app"))
   :tx-listen (fn [tx-data world-state])})

(def redefinitions (chan))

(declare world-state)

(declare rectangle ellipse image text polygon ace-editor without)

(declare rerender redefine on-drag read-morph)

(defn merge-changes [cha chb]
  {:removed (concat (:removed cha) (:removed chb))
   :added (concat (:added cha) (:added chb))
   :set-props (merge (:set-props cha) (:set-props chb))})

(defn diff-morph [old-morph new-morph]
  "Returns a dictionary containing all the changes between ma and mb.
   This includes all changes in the props and also all changes within 
   the submorphs."
  ; determine changes in submorphs
  (let [submorph-changes (merge-changes (-> old-morph meta :changes) (-> new-morph meta :changes))
        [_ old-props _] old-morph
        [_ new-props _] new-morph
        [removed-props changed-props _] (diff old-props new-props)]
    (if changed-props
      (assoc-in submorph-changes  [:set-props (:id new-props)] changed-props)
      changed-props)))

(defn diff-submorphs [old-submorphs new-submorphs]
  (let [old-ids (map (fn [expr]
                       (if (expanded-expression? expr)
                         (-> expr meta :abstraction-id)
                         (-> expr second :id))) old-submorphs)
        new-ids (map (fn [expr]
                       (if (expanded-expression? expr)
                         (-> expr meta :abstraction-id)
                         (-> expr second :id))) new-submorphs)
        [removed-morphs added-morphs _] (diff old-ids new-ids)
        changed-props (:set-props (reduce merge-changes (map diff-morph old-submorphs new-submorphs)))]
    {:removed removed-morphs
     :added added-morphs
     :set-props changed-props}))

(defn ast-type [x]
  (cond
    (and (list? x) (morph? x)) :morph
    (expanded-expression? x) :expr
    (vector? x) :vector))

(defn apply-changes-to [expr changes]
  (list '-> expr
        '(set-prop :id :prop :value)
        '(without :id)
        '(add-morphs-to :id :morphs)))

(defmulti makenode ast-type)

(defmulti get-children ast-type)

(defmethod get-children :morph [morph]
  (let [[self props & submorphs] morph]
                    submorphs))

(defmethod get-children :expr [expr]
  (:expanded-expression (meta expr)))

(defmethod get-children :vector [morph-col]
  morph-col)

(defmethod makenode :morph [morph new-submorphs]
  (let [[self props & old-submorphs] morph
        old-changes (-> morph meta :changes)
        _ (prn old-changes)
        new-changes (when-not (empty? old-submorphs)
                      (merge-changes old-changes (diff-submorphs old-submorphs new-submorphs)))]
    (with-meta 
      (apply list self props (filter not-empty new-submorphs))
      (assoc (meta morph) :changes new-changes))))

(defmethod makenode :expr [expr new-expansion]
  (let [expansion (:expanded-expression (meta expr))]
    (if (morph? expansion)
      (let [changes (diff-morph expansion new-expansion)]
        (with-meta expr 
          (assoc (meta (apply-changes-to expr changes)) 
                 :expanded-expression new-expansion
                 :changes changes)))
      (let [new-morph-col (apply vector (filter not-empty new-expansion))
            changes (map diff-morph expansion new-morph-col)]
        (with-meta expr 
          (assoc (meta (apply-changes-to expr changes)) 
                 :expanded-expression new-morph-col
                 :changes changes))))))

(defmethod makenode :vector [morph-col new-morph-col]
  (apply vector (filter not-empty new-morph-col)))

(defn world-zipper [world]
  (zipper ast-type 
          get-children
          makenode
          world))

(defn find-morph-loc
  [ast id]
  (let [expr (node ast)
        node-id (if (morph? expr)
                  (-> expr second :id)
                  (-> expr meta :abstraction-id))]
    (if (= node-id id)
      ast
      (when-not (end? ast)
        (find-morph-loc (zip/next ast) id)))))

(defn find-morph [root-ast id]
  (let [ast (world-zipper root-ast)
        loc (find-morph-loc ast id)]
    (when loc 
      (let [m (node loc)
            [self props & submorphs] m]
        (with-meta (list (applicative m) props submorphs) (meta m))))))

(defn owner [root-ast id]
   (when-let [loc (find-morph-loc root-ast id)]
     (up loc)))

(defn position-in-world 
  ([world-state id]
   (position-in-world (find-morph-loc (world-zipper world-state) id)))
  ([ast-loc]
  "return the global position of the morph with id"
  (if ast-loc 
    (let [[_ {pos :position} _] (node ast-loc)] 
      (add-points (position-in-world (up ast-loc)) pos))
    {:x 0 :y 0})))

(defn global-bounds [world-state morph-id]
  (let [[_ {extent :extent} _] (find-morph world-state morph-id)]
    [(position-in-world world-state morph-id) extent]))

(defn contains-morph? [world-state morph other]
  (let [bounds-a (global-bounds world-state morph)
        bounds-b (global-bounds world-state other)
        contains (contains-rect? bounds-a bounds-b)]
    (when contains (prn bounds-a " contains " bounds-b))
    contains))

(defn move-morph [world-state id new-parent-id]

   with the new-parent-id. Additionally the relative position of
   the newly added morph is being adopted, so that it does not
   change position. This is a semantic expectation from a morphic move."
  (if (not= id new-parent-id)
    (let [moved-morph (fetch world-state ($morph id))
          {gpx :x gpy :y} (position-in-world world-state new-parent-id)
          global-pos (position-in-world world-state id)
          relative-pos (add-points global-pos {:x (- gpx) :y (- gpy)})]
      (-> world-state
        (without id)
        (add-morph new-parent-id moved-morph)
        (set-prop id :position relative-pos)))
    world-state))

(defn morph-under-me 
