                                       :borderRadius    (str (* scale w) "px")
                                       :backgroundColor "brown"
                                       :position        "absolute"
-                                      :color           "white"
+                                      :color           "lightgray"
                                       :left            (str (* scale x) "px")
                                       :bottom          (str (* scale y) "px")}}
                         (str (:id ha) " " (:state ha))]])

        ha (assoc-in ha [:upcoming-transitions index] transition)]
    #_(println "recalc" (:id ha) index)
    #_(println "REQS" (:id ha) (:entry-time ha) #_transition
             (sort compare-transition-start
                   (filter #(and
                             (contains? (get-in % [:transition :label]) :required)
                             (not (iv/empty-interval? (:interval %))))
                           (:upcoming-transitions ha))))
    (if (contains? (get-in transition [:transition :label]) :required)
      (assoc ha :required-transitions (sort compare-transition-start
                                            (filter #(and

               (bumping-transitions id :right :falling-right nil walls others)
               (bumping-transitions id :top :left nil walls others)))))

(defn mario [id x y others walls]
  (let [others (disj others id)
        fall-speed 16
        move-speed 24]
    (make-ha id
             {:x     x :y y
              :w     16 :h 16
              :state :idle-right}
             (make-state
               :idle-right
               {}
               (make-edge
                 :moving-right
                 (non-bumping-guard :left walls others)
                 #{[:on #{:right}]})
               (make-edge
                 :moving-left
                 (non-bumping-guard :right walls others)
                 #{[:on #{:left}]}))
             (make-state
               :idle-left
               {}
               (make-edge
                 :moving-right
                 (non-bumping-guard :left walls others)
                 #{[:on #{:right}]})
               (make-edge
                 :moving-left
                 (non-bumping-guard :right walls others)
                 #{[:on #{:left}]}))
             (make-state
               :moving-right
               {:x move-speed}
               (make-edge
                 :idle-right
                 nil
                 #{[:off #{:right}]}))
             (make-state
               :moving-left
               {:x (- move-speed)}
               (make-edge
                 :idle-left
                 nil
                 #{[:off #{:left}]})))))

(defn make-scene-a [] (let [ids #{:ga :gb :gc :gd :ge :m}
                            walls #{[0 0 256 8]
                                    [0 8 8 16]
                                    [96 8 8 16]
                                    [160 8 8 16]}
                            objects [(goomba :ga 8 8 16 :right ids walls)
                                     (goomba :gb 32 8 16 :left ids walls)
                                     (goomba :gc 11 25 16 :falling-left ids walls)
                                     (goomba :gd 64 8 16 :left ids walls)
                                     (goomba :ge 96 32 16 :right ids walls)
                                     (mario :m 200 8 ids walls)]
                            obj-ids (map :id objects)
                            obj-dict (zipmap obj-ids objects)
                            ; got to let every HA enter its current (initial) state to set up state invariants like
                            ; pending required and optional transitions
                            obj-dict (zipmap obj-ids (map #(enter-state obj-dict % (:state %) 0) objects))]
                        {:now             0
                         :then            0
                         :playing         false
                         :pause-on-change false
                         :objects         obj-dict
                         :walls           walls}))

(defn ha-states [scene]
  (let [has (sort-by :id (vals (:objects scene)))]
    (map (fn [ha] [(:id ha) (:state ha)]) has)))

(def key-history (atom [{:time     0
                         :on       #{}
                         :pressed  #{}
                         :released #{}}]))

(def key-intervals (atom {}))

(defn reset-scene-a! []
  (swap! key-history (fn [_] [{:time 0 :on #{} :pressed #{} :released #{}}]))
  (swap! key-intervals (fn [_] {}))
  (swap! scene-a (fn [_]
                   (make-scene-a))))

(def keycode->keyname
  {37 :left
   39 :right
   38 :up
   40 :down
   90 :run
   88 :jump})

#_(defn binary-search-posn-by [coll key val l r depth]
    (assert (<= depth 1000))
    (let [len (- r l)]
      (if (= len 0)
        l
        (let [mid (+ l (.floor js/Math (/ len 2)))
              mid-val (key (get coll mid))]
          (cond
            (= val mid-val) mid
            (< val mid-val) (binary-search-posn-by coll key val l mid (inc depth))
            (> val mid-val) (binary-search-posn-by coll key val (inc mid) r (inc depth))
            :else (assert false))))))

#_(defn key-status-at [history t]
    (let [found-index (binary-search-posn-by history :time t 0 (dec (count history)) 0)
          found (nth history found-index nil)]
      (cond
        (nil? found) (last history)
        (> (:time found) t) nil
        :else found)))

(defn key-handler [evt]
  (.preventDefault evt)
  (.-stopPropagation evt)
  (let [now (floor-time (:now @scene-a) time-unit)
        key (keycode->keyname (.-keyCode evt))
        down? (= (.-type evt) "keydown")]
    #_(println "KH" (.-keyCode evt) key down?)
    (swap! key-history (fn [ks]
                         ; todo: clear the history sometimes?
                         (let [prev-on (:on (last ks))
                               prev-time (:time (last ks))
                               ; add a new entry if necessary
                               ks (if (> now prev-time)
                                    (conj ks {:time now :on prev-on :pressed #{} :released #{}})
                                    ks)]
                           (assert (>= now prev-time))
                           (update ks (dec (count ks))
                                   (fn [{prev-on :on pressed :pressed released :released :as k}]
                                     ; need the extra contains? check so key-repeat doesn't confuse things.
                                     (let [just-pressed? (and down?
                                                              (not (contains? prev-on key)))]
                                       (when (or just-pressed?
                                                 (not down?))
                                         (swap! key-intervals update key
                                                (if down?
                                                  (fn [old-kis]
                                                    (conj old-kis [now Infinity]))
                                                  (fn [old-kis]
                                                    (update-in old-kis [(dec (count old-kis)) 1]
                                                               (fn [_] now))))))
                                       (assoc k :on (if down? (conj prev-on key)
                                                              (disj prev-on key))
                                                :pressed (if just-pressed?
                                                           (conj pressed key)
                                                           pressed)
                                                :released (if down? released (conj released key)))))))))))

(set! (.-onkeydown js/window) key-handler)
(set! (.-onkeyup js/window) key-handler)

(defn tick-frame [t]
  (when-not last-time (set! last-time t))
