nostr/more-speech
1
0
Fork 0
mirror of https://github.com/unclebob/more-speech.git synced 2024-09-30 02:21:02 +00:00
Code Issues Packages Projects Releases Wiki Activity

Generalize the update scheme in preparation for generalizing text-windows.

Browse Source
This commit is contained in:
Robert C. Martin 2022-02-19 13:41:49 -06:00
parent d749a72550
commit 97a89886fe
7 changed files with 138 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
spec/more_speech/ui/app_util_spec.clj Normal file
View 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]))
)
)

5
src/more_speech/core.clj
View File

@ -30,7 +30,10 @@
(defn update-state [{:keys [application] :as 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)
state
(let [n-events (count @events)

3
src/more_speech/nostr/events.clj
View File

@ -79,7 +79,6 @@
id (:id event)
state (assoc-in state [:application :text-event-map id] event)
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)))

48
src/more_speech/ui/app_util.clj
View File

@ -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])
(defn update-articles [state]
(assoc-in state update-articles-path true))
(defn update-widget [state widget]
(cond
(satisfies? w/widget widget)
(update-in state next-update-path conj (:path widget))
(defn articles-updated [state]
(assoc-in state update-articles-path false))
(coll? widget)
(update-in state next-update-path conj widget)
(defn update-articles? [state]
(get-in state update-articles-path true))
:else
(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]
(assoc-in state mouse-lock-path (:path widget)))

15
src/more_speech/ui/application.clj
View File

@ -4,7 +4,9 @@
;;
;; Members
;; :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
;; the mouse is locked.
;;
@ -15,8 +17,7 @@
draw-widget
draw-child-widgets
setup-child-widgets]]
[more-speech.ui.article-window :refer [map->article-window
draw-article-window]]
[more-speech.ui.article-window :refer [map->article-window]]
[more-speech.ui.author-window :refer [map->author-window
draw-author-window]]
[more-speech.ui.graphics :as g]
@ -30,10 +31,12 @@
(s/def ::chronological-text-events (s/coll-of number?))
(s/def ::text-event-map (s/map-of number? ::events/event))
(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
::graphics
::update-articles
::this-update
::next-update
::mouse-locked-to
::nicknames
::chronological-text-events
@ -58,6 +61,8 @@
bold (get-in graphics [:fonts :bold])]
(g/text-font graphics bold)
(assoc application
:this-update #{}
:next-update #{}
:nicknames {}
:chronological-text-events []
:text-event-map {}

3
src/more_speech/ui/article_window.clj
View File

@ -111,6 +111,7 @@
(defn- drag-thumb [button state]
(let [graphics (get-in state [:application :graphics])
thumb-path (:path button)
parent-path (drop-last thumb-path)
article-window-path (drop-last thumb-path)
header-frame-path (concat article-window-path [:header-frame])
header-frame (get-in state header-frame-path)
@ -125,7 +126,7 @@
state (assoc-in state
(concat header-frame-path [:display-position])
display-position)]
(app/update-articles state)))
(app/update-widget state parent-path)))
(defn- lock-thumb [widget state]
(app/lock-mouse state widget))

10
src/more_speech/ui/header_frame.clj
View File

@ -92,12 +92,13 @@
(defn toggle-thread [button state]
(let [id (:id button)
frame-path (drop-last (:path button))
open-thread (get-in state [:application :open-thread])
open-thread (if (contains? open-thread id)
(disj open-thread id)
(conj open-thread id))
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])
@ -156,7 +157,7 @@
(recur (assoc frame id button) (rest buttons))))))
(defn- update-header-frame [state frame]
(if (app/update-articles? state)
(if (app/update-widget? state frame)
(let [application (:application state)
event-map (:text-event-map application)
events (:chronological-text-events application)
@ -177,8 +178,7 @@
marked-up-headers (map a/markup-header headers)
frame (assoc frame :displayed-headers marked-up-headers
:total-headers total-events)
state (assoc-in state frame-path frame)
state (app/articles-updated state)]
state (assoc-in state frame-path frame)]
state)
state))
@ -204,7 +204,7 @@
display-position (max 0 display-position)
frame (assoc frame :display-position display-position)
state (assoc-in state frame-path frame)
state (app/update-articles state)]
state (app/update-widget state frame)]
state))
(defn mouse-wheel [widget state clicks]