 (def time-unit (/ frame-length time-units-per-frame))
 (def precision 0.001)
 
-(defn empty-interval? [[start end]]
-  (> start end))
+(defn simple? [i]
+  (if-let [[imin imax] i]
+    (and (number? imin) (number? imax))
+    false))
+
+(defn empty-interval? [i]
+  (if (simple? i)
+    (> (first i) (second i))
+    (every? empty-interval? i)))
+
+(declare merge-overlapping)
+
+(defn intersection [a b]
+  (cond
+    (or (empty-interval? a) (empty-interval? b)) [Infinity Infinity]
+    (and (simple? a) (simple? b)) (let [[amin amax] a
+                                        [bmin bmax] b]
+                                    (cond
+                                      (< bmin amin) (intersection b a)
+                                      (< amax bmin) nil
+                                      :else [(.max js/Math amin bmin) (.min js/Math amax bmax)]))
+    ; b (resp. a) is a disjunction of simple intervals; intersect each with a (resp. b)
+    (simple? a) (merge-overlapping (mapv #(intersection a %) b))
+    (simple? b) (merge-overlapping (mapv #(intersection b %) a))
+    ; both are disjunctions of simple intervals. union of intersections
+    ; (a1 u a2 u a3) ^ (b1 u b2 u b3) == (a1 ^ b1 u a1 ^ b2 u a1 ^ b3) u ...
+    :else (merge-overlapping (vec
+                               ; union of unions of pairwise intersections
+                               (mapcat (fn [ai]
+                                         ; union of pairwise intersections
+                                         (mapv (fn [bi]
+                                                 (intersection ai bi))
+                                               b))
+                                       a)))))
+
+(defn sort-intervals [intervals]
+  (sort (fn [a b]
+          (cond
+            (and (simple? a) (simple? b)) (compare (first a) (first b))
+            (simple? a) (compare (first a) (ffirst b))
+            (simple? b) (compare (ffirst a) (first b))
+            :else (compare (ffirst a) (ffirst b))))
+        intervals))
+
+(defn flatten-intervals [intervals]
+  (reduce (fn [sofar interval]
+            (if (simple? interval)
+              (conj sofar interval)
+              (into sofar (flatten-intervals interval))))
+          []
+          intervals))
+
+(defn merge-overlapping [intervals]
+  (let [intervals (flatten-intervals intervals)
+        intervals (sort-intervals intervals)
+        [last-i merged] (reduce (fn [[[amin amax :as a] merged] [bmin bmax :as b]]
+                                  (if (intersection a b)
+                                    [[amin (.max js/Math amax bmax)] merged]
+                                    [[bmin bmax] (conj merged a)]))
+                                [(first intervals) []]
+                                (rest intervals))]
+    (if (empty? intervals)
+      []
+      (conj merged last-i))))
+
+(defn constrain-times [interval]
+  (if (simple? interval)
+    [(ceil-time (first interval) time-unit) (floor-time (second interval) time-unit)]
+    (mapv constrain-times interval)))
 
 (defn intersect-all [intervals]
-  (let [[start end] (reduce
-                      (fn [[amin amax] [bmin bmax]]
-                        [(.max js/Math amin bmin) (.min js/Math amax bmax)])
-                      [time-unit Infinity]
-                      intervals)
-        narrow-start (ceil-time start time-unit)
-        narrow-end (floor-time end time-unit)]
-    (when (and (< start end) (< narrow-end narrow-start))
-      (.warn js/console "This interval is narrower than D!" (str [start end]) (str [narrow-start narrow-end])))
-    [(ceil-time start time-unit) (floor-time end time-unit)]))
+  (constrain-times
+    (reduce (fn [a b]
+              (if-let [intr (intersection a b)]
+                intr
+                [Infinity Infinity]))
+            [time-unit Infinity]
+            intervals)))
+
+(defn union-all [intervals]
+  (merge-overlapping intervals))
 
 (defn third [v] (nth v 2))
 

    (nil? k) [0 0]
    (keyword? k) [(quantize (get ha k) precision) (get-in ha [(:state ha) :flows k] 0)]
    (vector? k) (let [other-ha (get has (first k))
                      other-state (:state other-ha)
                      et (:entry-time ha)
                      other-et (:entry-time other-ha)
                      ex-other-ha (extrapolate other-ha et)
                      [v _f] (get-var-and-flow has other-ha (second k))
                      [exv f] (get-var-and-flow has ex-other-ha (second k))
                      ]
                  #_(println "remote var and flow" k "from" (keys has) "in state" other-state "=" [v f]
                             "extrapolated from" other-et "to" et "=" [exv f])
                  [exv f])
    :else (assert (or (nil? k) (keyword? k) (vector? k)) "Unrecognized variable lookup type")))


                       (assoc scene :now now
                                    :objects (follow-transitions has transitions)))
      :else (do #_(println "messy border overflow" (- now min-t))
              (update-scene (assoc scene :now min-t
                                         :objects (follow-transitions has transitions))
                            now
                            inputs
                            (inc bailout)))
      )))

(defonce scene-a (atom {}))
