Partition the UI and Nostr packages. Polymorphic deployment of draw-widget.

src/more_speech/article.clj

@@ -15,6 +15,15 @@
 (s/def ::author-pubkey string?)
 (s/def ::author-nickname-tuple (s/tuple ::author-pubkey ::author-nickname))
 
+(defn make-article [name time body]
+  {:group ""
+   :author name
+   :subject "?"
+   :time time
+   :body body
+   :thread-count 1}
+  )
+
 (defn format-time [time]
   (let [time (* time 1000)
         date (Date. (long time))]

src/more_speech/core.clj

@@ -1,70 +1,19 @@
 (ns more-speech.core
   (:require [quil.core :as q]
             [quil.middleware :as m]
-            [more-speech.article :as a]
-            [more-speech.text :as text]
-            [clojure.data.json :as json]
-            [clojure.string :as string]))
+            [more-speech.ui.text :as text]
+            [more-speech.nostr.events :as nostr]
+            [more-speech.ui.widget :refer [widget
+                                           draw-widget]]
+            [more-speech.ui.article-window :refer [map->article-window
+                                                   draw-article-window]]
+            [more-speech.ui.author-window :refer [map->author-window
+                                                  draw-author-window]]
+            [more-speech.ui.application :refer [make-application]]
+            ))
 
 (def events (atom []))
 
-(defprotocol widget
-  (setup-widget [widget state])
-  (update-widget [widget state])
-  (draw-widget [widget state])
-  (mouse-up [widget state position])
-  (mouse-down [widget state position]))
-
-(defrecord article-window [x y w h fonts]
-  widget
-  (setup-widget [widget state])
-  (update-widget [widget state])
-  (draw-widget [widget state])
-  (mouse-up [widget state position])
-  (mouse-down [widget state position])
-  )
-
-(defrecord author-window [x y w h fonts]
-  widget
-  (setup-widget [widget state])
-  (update-widget [widget state])
-  (draw-widget [widget state])
-  (mouse-up [widget state position])
-  (mouse-down [widget state position])
-  )
-
-(declare draw-author-window)
-(declare draw-article-window)
-
-(defrecord application []
-  widget
-  (setup-widget [widget state])
-  (update-widget [widget state])
-
-  (draw-widget [application _]
-    (draw-article-window application (:article-window application))
-    (draw-author-window application (:author-window application)))
-
-  (mouse-up [widget state position])
-  (mouse-down [widget state position])
-  )
-
-(defn make-application [bold regular]
-  (map->application
-    {:articles []
-     :nicknames {}
-
-     :article-window (map->article-window
-                       {:x 50 :y 10 :w (text/pos-width 105) :h (- (q/screen-height) 100)
-                        :fonts {:bold bold :regular regular}
-                        })
-
-     :author-window (map->author-window {:x (+ 50 (text/pos-width 110)) :y 10
-                                         :w (text/pos-width 30) :h (- (q/screen-height) 100)
-                                         :fonts {:bold bold :regular regular}})
-     }
-    ))
-
 (defn setup []
   (q/frame-rate 30)
   (q/color-mode :rgb)
@@ -74,93 +23,18 @@
     {:application (make-application bold regular)}
     ))
 
-(defn make-article [name time body]
-  {:group ""
-   :author name
-   :subject "?"
-   :time time
-   :body body
-   :thread-count 1}
-  )
-
-(defn process-event [{:keys [application] :as state} event]
-  (let [{:keys [articles nicknames]} application
-        name-of (fn [pubkey] (get nicknames pubkey pubkey))
-        [name subscription-id inner-event :as decoded-msg] event
-        {:strs [id pubkey created_at kind tags content sig]} inner-event]
-    (condp = kind
-      0 (update-in
-          state [:application :nicknames]
-          assoc pubkey (get (json/read-str content) "name" "tilt"))
-      3 (do (printf "%s: %s %s %s\n" kind (a/format-time created_at) (name-of pubkey) content)
-            state)
-      1 (assoc-in state [:application :articles]
-                  (conj articles
-                        (make-article (name-of pubkey) created_at content)))
-      4 (do (printf "%s: %s %s %s\n" kind (a/format-time created_at) (name-of pubkey) content)
-            state)
-      (do (prn "unknown event: " event)
-          state)
-      )))
-
 (defn update-state [state]
   (if (empty? @events)
     state
-    (let [event (first @events)]
-      (swap! events rest)
-      (process-event state event))
-    )
-  )
-
-(defn draw-article [window cursor article]
-  (q/text-align :left)
-  (q/fill 0 0 0)
-  (text/render cursor window (a/markup-article article))
-  )
-
-(defn draw-articles [application {:keys [fonts] :as window}]
-  (loop [cursor (text/->cursor 0 (text/line-height) 5)
-         articles (take 20 (:articles application))]
-    (if (empty? articles)
-      cursor
-      (recur (draw-article window cursor (first articles))
-             (rest articles)))))
-
-(defn draw-article-window [application window]
-  (q/with-translation
-    [(:x window) (:y window)]
-    (q/stroke 0 0 0)
-    (q/stroke-weight 2)
-    (q/fill 255 255 255)
-    (q/rect 0 0 (:w window) (:h window))
-    (draw-articles application window)
-    ))
-
-(defn draw-author [window cursor author]
-  (q/text-align :left)
-  (q/fill 0 0 0)
-  (text/render cursor window (a/markup-author author)))
-
-(defn draw-authors [application window]
-  (q/text-align :left)
-  (q/fill 0 0 0)
-  (loop [cursor (text/->cursor 0 (text/line-height) 5)
-         authors (take-last 60 (sort-by #(string/lower-case (text/nil->blank (second %))) (:nicknames application)))]
-    (if (empty? authors)
-      cursor
-      (recur (draw-author window cursor (first authors))
-             (rest authors))))
-  )
-
-(defn draw-author-window [application window]
-  (q/with-translation
-    [(:x window) (:y window)]
-    (q/stroke 0 0 0)
-    (q/stroke-weight 2)
-    (q/fill 255 255 255)
-    (q/rect 0 0 (:w window) (:h window))
-    (draw-authors application window)
-    ))
+    (let [batch (take 10 @events)]
+      (swap! events #(drop 10 %))
+      (loop [state state
+             batch batch]
+        (if (empty? batch)
+          state
+          (recur
+            (nostr/process-event state (first batch))
+            (rest batch)))))))
 
 (defn draw-state [{:keys [application] :as state}]
   (q/background 240 240 240)

src/more_speech/nostr/events.clj

@@ -0,0 +1,23 @@
+(ns more-speech.nostr.events
+  (:require [more-speech.article :as article]
+            [clojure.data.json :as json]))
+
+(defn process-event [{:keys [application] :as state} event]
+  (let [{:keys [articles nicknames]} application
+        name-of (fn [pubkey] (get nicknames pubkey pubkey))
+        [name subscription-id inner-event :as decoded-msg] event
+        {:strs [id pubkey created_at kind tags content sig]} inner-event]
+    (condp = kind
+      0 (update-in
+          state [:application :nicknames]
+          assoc pubkey (get (json/read-str content) "name" "tilt"))
+      3 (do (printf "%s: %s %s %s\n" kind (article/format-time created_at) (name-of pubkey) content)
+            state)
+      1 (assoc-in state [:application :articles]
+                  (conj articles
+                        (article/make-article (name-of pubkey) created_at content)))
+      4 (do (printf "%s: %s %s %s\n" kind (article/format-time created_at) (name-of pubkey) content)
+            state)
+      (do (prn "unknown event: " event)
+          state)
+      )))

src/more_speech/ui/application.clj

@@ -0,0 +1,43 @@
+(ns more-speech.ui.application
+  (:require [quil.core :as q]
+            [more-speech.ui.text :as text]
+            [more-speech.ui.widget :refer [widget
+                                           draw-widget
+                                           draw-child-widgets]]
+            [more-speech.ui.article-window :refer [map->article-window
+                                                   draw-article-window]]
+            [more-speech.ui.author-window :refer [map->author-window
+                                                  draw-author-window]]))
+
+(defrecord application [widgets]
+  widget
+  (setup-widget [widget state])
+  (update-widget [widget state])
+
+  (draw-widget [application state]
+    ;(draw-widget (:article-window application) state)
+    ;(draw-widget (:author-window application) state)
+    (draw-child-widgets application state)
+    )
+
+  (mouse-up [widget state position])
+  (mouse-down [widget state position])
+  )
+
+(defn make-application [bold regular]
+  (map->application
+    {:articles []
+     :nicknames {}
+
+     :article-window (map->article-window
+                       {:x 50 :y 10 :w (text/pos-width 105) :h (- (q/screen-height) 100)
+                        :fonts {:bold bold :regular regular}
+                        })
+
+     :author-window (map->author-window
+                      {:x (+ 50 (text/pos-width 110)) :y 10
+                       :w (text/pos-width 30) :h (- (q/screen-height) 100)
+                       :fonts {:bold bold :regular regular}})
+     :widgets [:article-window :author-window]
+     }
+    ))

src/more_speech/ui/article_window.clj

@@ -0,0 +1,42 @@
+(ns more-speech.ui.article-window
+  (:require
+    [quil.core :as q]
+    [more-speech.ui.text :as text]
+    [more-speech.article :as a]
+    [more-speech.ui.widget :refer [widget]]))
+
+(declare draw-article-window)
+
+(defrecord article-window [x y w h fonts]
+  widget
+  (setup-widget [widget state])
+  (update-widget [widget state])
+  (draw-widget [widget state]
+    (draw-article-window (:application state) widget))
+  (mouse-up [widget state position])
+  (mouse-down [widget state position])
+  )
+
+(defn draw-article [window cursor article]
+  (q/text-align :left)
+  (q/fill 0 0 0)
+  (text/render cursor window (a/markup-article article))
+  )
+
+(defn draw-articles [application {:keys [fonts] :as window}]
+  (loop [cursor (text/->cursor 0 (text/line-height) 5)
+         articles (take 20 (:articles application))]
+    (if (empty? articles)
+      cursor
+      (recur (draw-article window cursor (first articles))
+             (rest articles)))))
+
+(defn draw-article-window [application window]
+  (q/with-translation
+    [(:x window) (:y window)]
+    (q/stroke 0 0 0)
+    (q/stroke-weight 2)
+    (q/fill 255 255 255)
+    (q/rect 0 0 (:w window) (:h window))
+    (draw-articles application window)
+    ))

src/more_speech/ui/author_window.clj

@@ -0,0 +1,45 @@
+(ns more-speech.ui.author-window
+  (:require
+    [quil.core :as q]
+    [clojure.string :as string]
+    [more-speech.ui.widget :refer [widget]]
+    [more-speech.ui.text :as text]
+    [more-speech.article :as a]))
+
+(declare draw-author-window)
+
+(defrecord author-window [x y w h fonts]
+  widget
+  (setup-widget [widget state])
+  (update-widget [widget state])
+  (draw-widget [widget state]
+    (draw-author-window (:application state) widget))
+  (mouse-up [widget state position])
+  (mouse-down [widget state position])
+  )
+
+(defn draw-author [window cursor author]
+  (q/text-align :left)
+  (q/fill 0 0 0)
+  (text/render cursor window (a/markup-author author)))
+
+(defn draw-authors [application window]
+  (q/text-align :left)
+  (q/fill 0 0 0)
+  (loop [cursor (text/->cursor 0 (text/line-height) 5)
+         authors (take-last 60 (sort-by #(string/lower-case (text/nil->blank (second %))) (:nicknames application)))]
+    (if (empty? authors)
+      cursor
+      (recur (draw-author window cursor (first authors))
+             (rest authors))))
+  )
+
+(defn draw-author-window [application window]
+  (q/with-translation
+    [(:x window) (:y window)]
+    (q/stroke 0 0 0)
+    (q/stroke-weight 2)
+    (q/fill 255 255 255)
+    (q/rect 0 0 (:w window) (:h window))
+    (draw-authors application window)
+    ))

src/more_speech/ui/text.clj

@@ -1,4 +1,4 @@
-(ns more-speech.text
+(ns more-speech.ui.text
   (:require [quil.core :as q]
             [clojure.string :as string])
   )

src/more_speech/ui/widget.clj

@@ -0,0 +1,15 @@
+(ns more-speech.ui.widget)
+
+(defprotocol widget
+  (setup-widget [widget state])
+  (update-widget [widget state])
+  (draw-widget [widget state])
+  (mouse-up [widget state position])
+  (mouse-down [widget state position]))
+
+(defn draw-child-widgets [parent state]
+  (loop [widgets (:widgets parent)]
+    (if (empty? widgets)
+      state
+      (do (draw-widget (get parent (first widgets)) state)
+          (recur (rest widgets))))))