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

Repartition functions in article-window and header-frame in preparation for text-window generalization.

Browse Source
This commit is contained in:
Robert C. Martin 2022-02-20 10:51:25 -06:00
parent 97a89886fe
commit 8e196c3983
8 changed files with 166 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
spec/more_speech/content/article_spec.clj
View File

@ -56,4 +56,57 @@
:new-line]
(markup-author author-tuple)))))
(describe "threading of events"
(it "does not thread if open events that have no references"
(let [event1 {:id 1}
event2 {:id 2}
event-map {1 event1
2 event2}
events [1 2]
open-events #{1 2}
threaded-events (thread-events events event-map open-events)]
(should= [1 2] (map :id threaded-events))
(should= [0 0] (map :indent threaded-events)))
)
(it "does not thread events that have references but are not open"
(let [event1 {:id 1 :references [3]}
event2 {:id 2}
event3 {:id 3}
event-map {1 event1
2 event2
3 event3}
events [1 2 3]
open-events #{}
threaded-events (thread-events events event-map open-events)]
(should= [1 2 3] (map :id threaded-events))
(should= [0 0 0] (map :indent threaded-events))))
(it "threads events that have references and are open"
(let [event1 {:id 1 :references [3]}
event2 {:id 2}
event3 {:id 3}
event-map {1 event1
2 event2
3 event3}
events [1 2 3]
open-events #{1}
threaded-events (thread-events events event-map open-events)]
(should= [1 3 2] (map :id threaded-events))
(should= [0 1 0] (map :indent threaded-events))))
(it "treats all articles threaded below an open article as open"
(let [event1 {:id 1 :references [2]}
event2 {:id 2 :references [3]}
event3 {:id 3}
event-map {1 event1
2 event2
3 event3}
events [1 2 3]
open-events #{1}
threaded-events (thread-events events event-map open-events)]
(should= [1 2 3] (map :id threaded-events))
(should= [0 1 2] (map :indent threaded-events))))
)

20
spec/more_speech/ui/app_util_spec.clj
View File

@ -20,9 +20,7 @@
(with state {:application {:path [:application]
:next-update #{}
:this-update #{}
:child @child-widget
}
})
:child @child-widget}})
(it "adds a widget path"
@ -52,13 +50,11 @@
state (assoc-in state
[:application :this-update]
(get-in state [:application :next-update]))]
(should (update-widget? state @grandchild-widget)))
)
(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)))
)
(should-not (update-widget? state @child-widget))))
(it "checks for ancestors"
(should (is-ancestor? [:x] [:x]))
@ -70,7 +66,11 @@
(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]))
(should-not (is-ancestor? [:x :y :z] [:x :y]))))
)
)
(describe "clear-widgets"
(it "clears out the widgets from the header frame"
(let [frame {:x :not-widget :w1 (->mock-widget)}
frame (clear-widgets frame)]
(should-be-nil (:w1 frame))
(should= {:x :not-widget} frame))))

59
spec/more_speech/ui/header_frame_spec.clj
View File

@ -5,59 +5,6 @@
[more-speech.ui.graphics :as g]
[more-speech.ui.config :as config]))
(describe "threading of events"
(it "does not thread if open events that have no references"
(let [event1 {:id 1}
event2 {:id 2}
event-map {1 event1
2 event2}
events [1 2]
open-events #{1 2}
threaded-events (thread-events events event-map open-events)]
(should= [1 2] (map :id threaded-events))
(should= [0 0] (map :indent threaded-events)))
)
(it "does not thread events that have references but are not open"
(let [event1 {:id 1 :references [3]}
event2 {:id 2}
event3 {:id 3}
event-map {1 event1
2 event2
3 event3}
events [1 2 3]
open-events #{}
threaded-events (thread-events events event-map open-events)]
(should= [1 2 3] (map :id threaded-events))
(should= [0 0 0] (map :indent threaded-events))))
(it "threads events that have references and are open"
(let [event1 {:id 1 :references [3]}
event2 {:id 2}
event3 {:id 3}
event-map {1 event1
2 event2
3 event3}
events [1 2 3]
open-events #{1}
threaded-events (thread-events events event-map open-events)]
(should= [1 3 2] (map :id threaded-events))
(should= [0 1 0] (map :indent threaded-events))))
(it "treats all articles threaded below an open article as open"
(let [event1 {:id 1 :references [2]}
event2 {:id 2 :references [3]}
event3 {:id 3}
event-map {1 event1
2 event2
3 event3}
events [1 2 3]
open-events #{1}
threaded-events (thread-events events event-map open-events)]
(should= [1 2 3] (map :id threaded-events))
(should= [0 1 2] (map :indent threaded-events))))
)
(defrecord mock-graphics []
g/graphics
(line-height [graphics]
@ -100,12 +47,6 @@
:indent 1}
(event->header @text-event @nicknames)))
(it "clears out the widgets from the header frame"
(let [frame {:x :not-widget :w1 (->mock-widget)}
frame (clear-widgets frame)]
(should-be-nil (:w1 frame))
(should= {:x :not-widget} frame)))
(it "creates buttons for threads"
(let [headers [{:id 1 :thread-count 1 :indent 0}
{:id 2 :thread-count 1 :indent 1}

38
src/more_speech/content/article.clj
View File

@ -1,6 +1,7 @@
(ns more-speech.content.article
(:require [clojure.spec.alpha :as s]
[more-speech.nostr.util :refer [num->hex-string]])
[more-speech.nostr.util :refer [num->hex-string]]
[clojure.set :as set])
(:import (java.util Date)
(java.text SimpleDateFormat)))
@ -79,3 +80,38 @@
name
:new-line
])
(defn thread-events
"returns events in threaded order."
([events event-map open-events]
(thread-events events event-map open-events 0))
([events event-map open-events indent]
(loop [events events
threaded-events []
processed-events #{}]
(cond
(empty? events)
threaded-events
(contains? processed-events (first events))
(recur (rest events) threaded-events processed-events)
:else
(let [event-id (first events)
event (get event-map event-id)
references (:references event)
no-references? (empty? references)
not-open? (nil? (open-events event-id))
no-thread? (or no-references? (and (zero? indent) not-open?))]
(if no-thread?
(recur (rest events)
(conj threaded-events (assoc event :indent indent))
(conj processed-events event-id))
(let [thread (thread-events references event-map open-events (inc indent))
threaded-events (conj threaded-events (assoc event :indent indent))
threaded-events (vec (concat threaded-events thread))
processed-events (set/union processed-events (set (map :id thread)))]
(recur (rest events)
threaded-events
(conj processed-events event-id)))))
))))

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

@ -52,4 +52,17 @@
(defn get-mouse-lock [state]
"returns path of locked widget or nil."
(get-in state mouse-lock-path nil))
(get-in state mouse-lock-path nil))
(defn clear-widgets [frame]
(loop [elements (keys frame)
frame frame]
(if (empty? elements)
frame
(let [key (first elements)
element (get frame key)]
(if (and (some? element)
(satisfies? w/widget element))
(recur (rest elements)
(dissoc frame key))
(recur (rest elements) frame))))))

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

@ -14,7 +14,8 @@
[more-speech.ui.config :as config]
))
(declare draw-article-window
(declare setup-article-window
draw-article-window
update-article-window
drag-thumb
lock-thumb
@ -24,51 +25,54 @@
(defrecord article-window [x y w h page-up page-down]
widget
(setup-widget [widget state]
(let [dim config/header-frame-dimensions
frame-path (concat (:path widget) [:header-frame])
scroll-up (partial scroll-up frame-path)
scroll-down (partial scroll-down frame-path)
frame (map->header-frame {:x (+ x (:left-margin dim))
:y (+ y (:top-margin dim))
:w (- w (:right-margin dim)
config/scroll-bar-w)
:h (- h (:bottom-margin dim))
:display-position 0})
sb-button-offset (+ (/ config/scroll-bar-w 2)
(/ config/scroll-bar-button-w 2))
sb-button-x (+ x w (- sb-button-offset) 0.5)
widget (assoc widget
:header-frame frame
:page-up (map->button {:x sb-button-x
:y (+ y config/scroll-bar-button-top-margin)
:h config/scroll-bar-button-h
:w config/scroll-bar-button-w
:left-down scroll-down
:left-held scroll-down
:draw up-arrow})
:page-down (map->button {:x sb-button-x
:y (+ y h (- config/scroll-bar-button-bottom-margin))
:h config/scroll-bar-button-h
:w config/scroll-bar-button-w
:left-down scroll-up
:left-held scroll-up
:draw down-arrow})
:thumb (map->button {:x sb-button-x
:y (thumb-position frame)
:h config/thumb-h
:w config/scroll-bar-button-w
:draw draw-thumb
:left-held drag-thumb
:left-down lock-thumb
:left-up unlock-thumb
}))]
widget))
(setup-article-window widget state))
(update-widget [widget state]
(update-article-window widget state))
(draw-widget [widget state]
(draw-article-window state widget)))
(defn setup-article-window [widget state]
(let [{:keys [x y w h]} widget
dim config/header-frame-dimensions
frame-path (concat (:path widget) [:header-frame])
scroll-up (partial scroll-up frame-path)
scroll-down (partial scroll-down frame-path)
frame (map->header-frame {:x (+ x (:left-margin dim))
:y (+ y (:top-margin dim))
:w (- w (:right-margin dim)
config/scroll-bar-w)
:h (- h (:bottom-margin dim))
:display-position 0})
sb-button-offset (+ (/ config/scroll-bar-w 2)
(/ config/scroll-bar-button-w 2))
sb-button-x (+ x w (- sb-button-offset) 0.5)
widget (assoc widget
:header-frame frame
:page-up (map->button {:x sb-button-x
:y (+ y config/scroll-bar-button-top-margin)
:h config/scroll-bar-button-h
:w config/scroll-bar-button-w
:left-down scroll-down
:left-held scroll-down
:draw up-arrow})
:page-down (map->button {:x sb-button-x
:y (+ y h (- config/scroll-bar-button-bottom-margin))
:h config/scroll-bar-button-h
:w config/scroll-bar-button-w
:left-down scroll-up
:left-held scroll-up
:draw down-arrow})
:thumb (map->button {:x sb-button-x
:y (thumb-position frame)
:h config/thumb-h
:w config/scroll-bar-button-w
:draw draw-thumb
:left-held drag-thumb
:left-down lock-thumb
:left-up unlock-thumb
}))]
widget))
(defn update-article-window [widget state]
(let [header-frame (:header-frame widget)
thumb-pos (thumb-position header-frame)

6
src/more_speech/ui/config.clj
View File

@ -23,10 +23,10 @@
:bottom-margin 100})
(def header-frame-dimensions
{:left-margin 1
{:left-margin 0
:right-margin 0
:top-margin 1
:bottom-margin 1})
:top-margin 0
:bottom-margin 0})
(def header-lines 2)
(def header-top-margin 5)

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

@ -9,14 +9,12 @@
down-arrow]]
[more-speech.ui.graphics :as g]
[more-speech.nostr.util :refer [num->hex-string]]
[clojure.set :as set]
[more-speech.ui.app-util :as app]))
(declare setup-header-frame
update-header-frame
draw-header-frame
mouse-wheel
thread-events
draw-headers)
(defrecord header-frame [x y w h display-position]
@ -54,19 +52,6 @@
(defn events->headers [events nicknames]
(map #(event->header % nicknames) events))
(defn clear-widgets [frame]
(loop [elements (keys frame)
frame frame]
(if (empty? elements)
frame
(let [key (first elements)
element (get frame key)]
(if (and (some? element)
(satisfies? widget element))
(recur (rest elements)
(dissoc frame key))
(recur (rest elements) frame))))))
(defn draw-minus [graphics {:keys [x y h w button-state]}]
(g/with-translation
graphics [x y]
@ -162,7 +147,7 @@
event-map (:text-event-map application)
events (:chronological-text-events application)
open-thread (:open-thread application)
threaded-events (thread-events events event-map open-thread)
threaded-events (a/thread-events events event-map open-thread)
total-events (count threaded-events)
display-position (:display-position frame)
end-position (min (count threaded-events) (+ display-position (:n-headers frame)))
@ -172,7 +157,7 @@
bc (make-button-creator state frame)
frame-path (:path frame)
frame (get-in state frame-path)
frame (clear-widgets frame)
frame (app/clear-widgets frame)
buttons (create-thread-buttons bc headers)
frame (add-thread-buttons frame buttons)
marked-up-headers (map a/markup-header headers)
@ -210,47 +195,12 @@
(defn mouse-wheel [widget state clicks]
(scroll-frame (:path widget) state clicks))
(defn scroll-up [frame-path button state]
(defn scroll-up [frame-path _button state]
(scroll-frame frame-path state 1))
(defn scroll-down [frame-path button state]
(defn scroll-down [frame-path _button state]
(scroll-frame frame-path state -1))
(defn thread-events
"returns articles in threaded order."
([events event-map open-events]
(thread-events events event-map open-events 0))
([events event-map open-events indent]
(loop [events events
threaded-events []
processed-events #{}]
(cond
(empty? events)
threaded-events
(contains? processed-events (first events))
(recur (rest events) threaded-events processed-events)
:else
(let [event-id (first events)
event (get event-map event-id)
references (:references event)
no-references? (empty? references)
not-open? (nil? (open-events event-id))
no-thread? (or no-references? (and (zero? indent) not-open?))]
(if no-thread?
(recur (rest events)
(conj threaded-events (assoc event :indent indent))
(conj processed-events event-id))
(let [thread (thread-events references event-map open-events (inc indent))
threaded-events (conj threaded-events (assoc event :indent indent))
threaded-events (vec (concat threaded-events thread))
processed-events (set/union processed-events (set (map :id thread)))]
(recur (rest events)
threaded-events
(conj processed-events event-id)))))
))))
(defn draw-header [frame cursor header index]
(let [g (:graphics cursor)
header-height (+ config/header-top-margin