more-speech/spec/more_speech/ui/widget_spec.clj

(ns more-speech.ui.widget-spec
  (:require [speclj.core :refer :all]
            [more-speech.ui.application :refer [map->application]]
            [more-speech.ui.widget :refer :all]))

(defrecord child []
  widget
  (setup-widget [widget _state]
    (assoc widget :setup true)))

(defrecord child-with-child []
  widget
  (setup-widget [widget _state]
    (assoc widget :child (->child))))

(defn- f [widget state] (assoc-in state (concat (:path widget) [:did-f]) true))

(describe "Widgets"
  (context "get child widgets"
    (it "gets one child"
      (let [parent {:child (->child)
                    :not-child "not-child"}]
        (should= [:child] (get-child-widgets parent))))

    (it "gets no children"
      (let [parent {:not-child "not-child"}]
        (should= [] (get-child-widgets parent)))
      )

    (it "gets many children"
      (let [parent {:child-1 (->child)
                    :child-2 (->child)
                    :not-child "not-child"}]
        (should= #{:child-1 :child-2} (set (get-child-widgets parent))))))

  (context "do-children"
    (it "does child widgets"
      (let [child-1 (assoc (->child) :path [:parent :child-1])
            child-2 (assoc (->child) :path [:parent :child-2])
            parent {:path [:parent] :child-1 child-1 :child-2 child-2}
            state {:parent parent}
            state (update-children parent state f)]
        (should (get-in state [:parent :child-1 :did-f] false))
        (should (get-in state [:parent :child-2 :did-f] false))))

    (it "does the hierarchy."
      (let [grandchild (->child)
            child (assoc (->child) :child grandchild)
            parent {:path [:parent] :child child}
            state {:parent parent}
            state (setup-child-widgets parent state)
            state (update-children (:parent state) state f)]
        (should (get-in state [:parent :child :did-f] false))
        (should (get-in state [:parent :child :child :did-f] false)))))

  (context "can be setup"
    (it "constructs the path and calls setup for children."
      (let [parent {:path [:parent]
                    :child (->child)}
            state {:parent parent}
            state (setup-child-widgets parent state)]
        (should (get-in state [:parent :child :setup] false))
        (should= [:parent :child] (get-in state [:parent :child :path]))))

    (it "is harmless if the parent has no children."
      (let [parent {:path [:parent]}
            state {:parent parent}
            state (setup-child-widgets parent state)]
        (should= {:parent parent} state)))

    (it "handles multiple children."
      (let [parent {:path [:parent]
                    :child-1 (->child)
                    :child-2 (->child)}
            state {:parent parent}
            state (setup-child-widgets parent state)]
        (should (get-in state [:parent :child-1 :setup] false))
        (should (get-in state [:parent :child-2 :setup] false))
        (should= [:parent :child-1] (get-in state [:parent :child-1 :path]))
        (should= [:parent :child-2] (get-in state [:parent :child-2 :path]))))

    (it "handles a hierarchy"
      (let [grand-child (->child)
            child (assoc (->child) :grand-child grand-child)
            parent {:path [:parent] :child child}
            state {:parent parent}
            state (setup-child-widgets parent state)]
        (should (get-in state [:parent :child :setup]))
        (should (get-in state [:parent :child :grand-child :setup]))))

    (it "handles a hierarchy setup by children."
      (let [child (->child-with-child)
            parent {:path [:parent] :child child}
            state {:parent parent}
            state (setup-child-widgets parent state)]
        (should (get-in state [:parent :child :child :setup])))
      )
    )
  )

(defrecord mock-widget [x y w h]
  widget
  (setup-widget [widget _state]
    widget))

(describe "mouse operations"
  (context "find mouse target"
    (it "does not return a target if there are no application widgets."
      (let [application (map->application {:path [:application]})
            target (find-deepest-mouse-target application 0 0)]
        (should-be-nil target)))

    (it "does not return a target if the mouse is not in the top widgets."
      (let [widget1 (->mock-widget 10 10 10 10)
            widget2 (->mock-widget 30 10 10 10)
            application (map->application {:path [:application] :w1 widget1 :w2 widget2})
            state {:application application}
            state (setup-child-widgets application state)
            application (:application state)
            target (find-deepest-mouse-target application 0 0)]
        (should-be-nil target)))

    (it "finds first top widget with mouse inside when there are no children."
      (let [widget1 (->mock-widget 10 10 10 10)
            widget2 (->mock-widget 30 10 10 10)
            application (map->application {:path [:application] :w1 widget1 :w2 widget2})
            state {:application application}
            state (setup-child-widgets application state)
            application (:application state)
            target (find-deepest-mouse-target application 11 11)]
        (should= [:application :w1] (:path target))))

    (it "finds deepest child containing the mouse."
      (let [widget1 (->mock-widget 10 10 10 10)
            widget2 (->mock-widget 30 10 20 20)
            widget2-1 (->mock-widget  35 15 5 5)
            widget2 (assoc widget2 :w2-1 widget2-1);
            application (map->application {:path [:application] :w1 widget1 :w2 widget2})
            state {:application application}
            state (setup-child-widgets application state)
            application (:application state)
            target (find-deepest-mouse-target application 36 16)]
        (should= [:application :w2 :w2-1] (:path target)))
      )
    )
  )