mirror of
https://github.com/unclebob/more-speech.git
synced 2024-09-30 02:21:02 +00:00
Generalize the update scheme in preparation for generalizing text-windows.
This commit is contained in:
parent
d749a72550
commit
97a89886fe
76
spec/more_speech/ui/app_util_spec.clj
Normal file
76
spec/more_speech/ui/app_util_spec.clj
Normal file
@ -0,0 +1,76 @@
|
|||||||
|
(ns more-speech.ui.app-util-spec
|
||||||
|
(:require [speclj.core :refer :all]
|
||||||
|
[more-speech.ui.app-util :refer :all]
|
||||||
|
[more-speech.ui.widget :as w]))
|
||||||
|
|
||||||
|
|
||||||
|
(declare application
|
||||||
|
state
|
||||||
|
child-widget
|
||||||
|
grandchild-widget)
|
||||||
|
|
||||||
|
(defrecord mock-widget []
|
||||||
|
w/widget)
|
||||||
|
|
||||||
|
(describe "update widgets"
|
||||||
|
(with grandchild-widget (map->mock-widget {:path [:application :child :grandchild]}))
|
||||||
|
(with child-widget (map->mock-widget {:path [:application :child]
|
||||||
|
:grandchild @grandchild-widget}))
|
||||||
|
|
||||||
|
(with state {:application {:path [:application]
|
||||||
|
:next-update #{}
|
||||||
|
:this-update #{}
|
||||||
|
:child @child-widget
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
(it "adds a widget path"
|
||||||
|
(let [widget-path (:path @child-widget)
|
||||||
|
state (update-widget @state widget-path)
|
||||||
|
update-widgets (get-in state [:application :next-update])]
|
||||||
|
(should (contains? update-widgets widget-path))))
|
||||||
|
|
||||||
|
(it "adds a widget"
|
||||||
|
(let [widget-path (:path @child-widget)
|
||||||
|
state (update-widget @state @child-widget)
|
||||||
|
update-widgets (get-in state [:application :next-update])]
|
||||||
|
(should (contains? update-widgets widget-path))))
|
||||||
|
|
||||||
|
(it "detects widget not updated"
|
||||||
|
(should-not (update-widget? @state @child-widget)))
|
||||||
|
|
||||||
|
(it "detects an updated widget"
|
||||||
|
(let [state (update-widget @state @child-widget)
|
||||||
|
state (assoc-in state
|
||||||
|
[:application :this-update]
|
||||||
|
(get-in state [:application :next-update]))]
|
||||||
|
(should (update-widget? state @child-widget))))
|
||||||
|
|
||||||
|
(it "updates children"
|
||||||
|
(let [state (update-widget @state @child-widget)
|
||||||
|
state (assoc-in state
|
||||||
|
[:application :this-update]
|
||||||
|
(get-in state [:application :next-update]))]
|
||||||
|
(should (update-widget? state @grandchild-widget)))
|
||||||
|
)
|
||||||
|
|
||||||
|
(it "does not update parents"
|
||||||
|
(let [state (update-widget @state @grandchild-widget)]
|
||||||
|
(should-not (update-widget? state @child-widget)))
|
||||||
|
)
|
||||||
|
|
||||||
|
(it "checks for ancestors"
|
||||||
|
(should (is-ancestor? [:x] [:x]))
|
||||||
|
(should (is-ancestor? [:x] [:x :y]))
|
||||||
|
(should (is-ancestor? [:x :y] [:x :y]))
|
||||||
|
(should (is-ancestor? [:x :y] [:x :y :z]))
|
||||||
|
(should (is-ancestor? [:x :y] [:x :y :z :a :b]))
|
||||||
|
|
||||||
|
(should-not (is-ancestor? [] [:x]))
|
||||||
|
(should-not (is-ancestor? [:x] [:y]))
|
||||||
|
(should-not (is-ancestor? [:x :y] [:x :z]))
|
||||||
|
(should-not (is-ancestor? [:x :y :z] [:x :y]))
|
||||||
|
|
||||||
|
)
|
||||||
|
)
|
@ -30,7 +30,10 @@
|
|||||||
|
|
||||||
(defn update-state [{:keys [application] :as state}]
|
(defn update-state [{:keys [application] :as state}]
|
||||||
(let [state (update-widget application state)
|
(let [state (update-widget application state)
|
||||||
state (update-child-widgets (:application state) state)]
|
state (update-child-widgets (:application state) state)
|
||||||
|
next-update (get-in state [:application :next-update])
|
||||||
|
state (assoc-in state [:application :this-update] next-update)
|
||||||
|
state (assoc-in state [:application :next-update] #{})]
|
||||||
(if (empty? @events)
|
(if (empty? @events)
|
||||||
state
|
state
|
||||||
(let [n-events (count @events)
|
(let [n-events (count @events)
|
||||||
|
@ -79,7 +79,6 @@
|
|||||||
id (:id event)
|
id (:id event)
|
||||||
state (assoc-in state [:application :text-event-map id] event)
|
state (assoc-in state [:application :text-event-map id] event)
|
||||||
state (update-in state [:application :chronological-text-events] conj id)
|
state (update-in state [:application :chronological-text-events] conj id)
|
||||||
state (app/update-articles state)
|
state (app/update-widget state [:application :article-window])
|
||||||
]
|
]
|
||||||
|
|
||||||
(process-references state event)))
|
(process-references state event)))
|
@ -1,16 +1,48 @@
|
|||||||
(ns more-speech.ui.app-util)
|
(ns more-speech.ui.app-util
|
||||||
|
(:require [more-speech.ui.widget :as w]))
|
||||||
|
|
||||||
(def update-articles-path [:application :update-articles])
|
(def next-update-path [:application :next-update])
|
||||||
|
(def this-update-path [:application :this-update])
|
||||||
(def mouse-lock-path [:application :mouse-locked-to])
|
(def mouse-lock-path [:application :mouse-locked-to])
|
||||||
|
|
||||||
(defn update-articles [state]
|
(defn update-widget [state widget]
|
||||||
(assoc-in state update-articles-path true))
|
(cond
|
||||||
|
(satisfies? w/widget widget)
|
||||||
|
(update-in state next-update-path conj (:path widget))
|
||||||
|
|
||||||
(defn articles-updated [state]
|
(coll? widget)
|
||||||
(assoc-in state update-articles-path false))
|
(update-in state next-update-path conj widget)
|
||||||
|
|
||||||
(defn update-articles? [state]
|
:else
|
||||||
(get-in state update-articles-path true))
|
(assert false "Bad widget in update-widget")
|
||||||
|
))
|
||||||
|
|
||||||
|
(defn is-ancestor? [ancestor child]
|
||||||
|
(let [ancestor-count (count ancestor)]
|
||||||
|
(cond
|
||||||
|
(zero? ancestor-count)
|
||||||
|
false
|
||||||
|
|
||||||
|
(= ancestor child)
|
||||||
|
true
|
||||||
|
|
||||||
|
(> ancestor-count (count child))
|
||||||
|
false
|
||||||
|
|
||||||
|
(= (take ancestor-count child) ancestor)
|
||||||
|
true
|
||||||
|
|
||||||
|
:else false
|
||||||
|
)))
|
||||||
|
|
||||||
|
(defn update-widget? [state widget]
|
||||||
|
(let [path (:path widget)]
|
||||||
|
(loop [update-set (get-in state this-update-path [])]
|
||||||
|
(if (empty? update-set)
|
||||||
|
false
|
||||||
|
(if (is-ancestor? (first update-set) path)
|
||||||
|
true
|
||||||
|
(recur (rest update-set)))))))
|
||||||
|
|
||||||
(defn lock-mouse [state widget]
|
(defn lock-mouse [state widget]
|
||||||
(assoc-in state mouse-lock-path (:path widget)))
|
(assoc-in state mouse-lock-path (:path widget)))
|
||||||
|
@ -4,7 +4,9 @@
|
|||||||
;;
|
;;
|
||||||
;; Members
|
;; Members
|
||||||
;; :graphics -- The instance of the graphics protocol.
|
;; :graphics -- The instance of the graphics protocol.
|
||||||
;; :update-articles -- Set to true if the article window content needs updating.
|
;; :this-update -- Set of widgets to update on this pass. Cleared at end of pass.
|
||||||
|
;; :next-update -- Set of widgets to update on next pass. Moved to :this-update
|
||||||
|
;; at end of pass.
|
||||||
;; :mouse-locked-to -- nil if no lock. Otherwise the path of the widget to which
|
;; :mouse-locked-to -- nil if no lock. Otherwise the path of the widget to which
|
||||||
;; the mouse is locked.
|
;; the mouse is locked.
|
||||||
;;
|
;;
|
||||||
@ -15,8 +17,7 @@
|
|||||||
draw-widget
|
draw-widget
|
||||||
draw-child-widgets
|
draw-child-widgets
|
||||||
setup-child-widgets]]
|
setup-child-widgets]]
|
||||||
[more-speech.ui.article-window :refer [map->article-window
|
[more-speech.ui.article-window :refer [map->article-window]]
|
||||||
draw-article-window]]
|
|
||||||
[more-speech.ui.author-window :refer [map->author-window
|
[more-speech.ui.author-window :refer [map->author-window
|
||||||
draw-author-window]]
|
draw-author-window]]
|
||||||
[more-speech.ui.graphics :as g]
|
[more-speech.ui.graphics :as g]
|
||||||
@ -30,10 +31,12 @@
|
|||||||
(s/def ::chronological-text-events (s/coll-of number?))
|
(s/def ::chronological-text-events (s/coll-of number?))
|
||||||
(s/def ::text-event-map (s/map-of number? ::events/event))
|
(s/def ::text-event-map (s/map-of number? ::events/event))
|
||||||
(s/def ::open-thread (s/coll-of number? :kind set?))
|
(s/def ::open-thread (s/coll-of number? :kind set?))
|
||||||
(s/def ::update-articles boolean?)
|
(s/def ::this-update (s/coll-of ::path :kind set?))
|
||||||
|
(s/def ::next-update (s/coll-of ::path :kind set?))
|
||||||
(s/def ::application (s/keys :req-un [::path
|
(s/def ::application (s/keys :req-un [::path
|
||||||
::graphics
|
::graphics
|
||||||
::update-articles
|
::this-update
|
||||||
|
::next-update
|
||||||
::mouse-locked-to
|
::mouse-locked-to
|
||||||
::nicknames
|
::nicknames
|
||||||
::chronological-text-events
|
::chronological-text-events
|
||||||
@ -58,6 +61,8 @@
|
|||||||
bold (get-in graphics [:fonts :bold])]
|
bold (get-in graphics [:fonts :bold])]
|
||||||
(g/text-font graphics bold)
|
(g/text-font graphics bold)
|
||||||
(assoc application
|
(assoc application
|
||||||
|
:this-update #{}
|
||||||
|
:next-update #{}
|
||||||
:nicknames {}
|
:nicknames {}
|
||||||
:chronological-text-events []
|
:chronological-text-events []
|
||||||
:text-event-map {}
|
:text-event-map {}
|
||||||
|
@ -111,6 +111,7 @@
|
|||||||
(defn- drag-thumb [button state]
|
(defn- drag-thumb [button state]
|
||||||
(let [graphics (get-in state [:application :graphics])
|
(let [graphics (get-in state [:application :graphics])
|
||||||
thumb-path (:path button)
|
thumb-path (:path button)
|
||||||
|
parent-path (drop-last thumb-path)
|
||||||
article-window-path (drop-last thumb-path)
|
article-window-path (drop-last thumb-path)
|
||||||
header-frame-path (concat article-window-path [:header-frame])
|
header-frame-path (concat article-window-path [:header-frame])
|
||||||
header-frame (get-in state header-frame-path)
|
header-frame (get-in state header-frame-path)
|
||||||
@ -125,7 +126,7 @@
|
|||||||
state (assoc-in state
|
state (assoc-in state
|
||||||
(concat header-frame-path [:display-position])
|
(concat header-frame-path [:display-position])
|
||||||
display-position)]
|
display-position)]
|
||||||
(app/update-articles state)))
|
(app/update-widget state parent-path)))
|
||||||
|
|
||||||
(defn- lock-thumb [widget state]
|
(defn- lock-thumb [widget state]
|
||||||
(app/lock-mouse state widget))
|
(app/lock-mouse state widget))
|
||||||
|
@ -92,12 +92,13 @@
|
|||||||
|
|
||||||
(defn toggle-thread [button state]
|
(defn toggle-thread [button state]
|
||||||
(let [id (:id button)
|
(let [id (:id button)
|
||||||
|
frame-path (drop-last (:path button))
|
||||||
open-thread (get-in state [:application :open-thread])
|
open-thread (get-in state [:application :open-thread])
|
||||||
open-thread (if (contains? open-thread id)
|
open-thread (if (contains? open-thread id)
|
||||||
(disj open-thread id)
|
(disj open-thread id)
|
||||||
(conj open-thread id))
|
(conj open-thread id))
|
||||||
state (assoc-in state [:application :open-thread] open-thread)]
|
state (assoc-in state [:application :open-thread] open-thread)]
|
||||||
(app/update-articles state)))
|
(app/update-widget state frame-path)))
|
||||||
|
|
||||||
(defrecord button-creator [state frame graphics])
|
(defrecord button-creator [state frame graphics])
|
||||||
|
|
||||||
@ -156,7 +157,7 @@
|
|||||||
(recur (assoc frame id button) (rest buttons))))))
|
(recur (assoc frame id button) (rest buttons))))))
|
||||||
|
|
||||||
(defn- update-header-frame [state frame]
|
(defn- update-header-frame [state frame]
|
||||||
(if (app/update-articles? state)
|
(if (app/update-widget? state frame)
|
||||||
(let [application (:application state)
|
(let [application (:application state)
|
||||||
event-map (:text-event-map application)
|
event-map (:text-event-map application)
|
||||||
events (:chronological-text-events application)
|
events (:chronological-text-events application)
|
||||||
@ -177,8 +178,7 @@
|
|||||||
marked-up-headers (map a/markup-header headers)
|
marked-up-headers (map a/markup-header headers)
|
||||||
frame (assoc frame :displayed-headers marked-up-headers
|
frame (assoc frame :displayed-headers marked-up-headers
|
||||||
:total-headers total-events)
|
:total-headers total-events)
|
||||||
state (assoc-in state frame-path frame)
|
state (assoc-in state frame-path frame)]
|
||||||
state (app/articles-updated state)]
|
|
||||||
state)
|
state)
|
||||||
state))
|
state))
|
||||||
|
|
||||||
@ -204,7 +204,7 @@
|
|||||||
display-position (max 0 display-position)
|
display-position (max 0 display-position)
|
||||||
frame (assoc frame :display-position display-position)
|
frame (assoc frame :display-position display-position)
|
||||||
state (assoc-in state frame-path frame)
|
state (assoc-in state frame-path frame)
|
||||||
state (app/update-articles state)]
|
state (app/update-widget state frame)]
|
||||||
state))
|
state))
|
||||||
|
|
||||||
(defn mouse-wheel [widget state clicks]
|
(defn mouse-wheel [widget state clicks]
|
||||||
|
Loading…
Reference in New Issue
Block a user