Decoupling of headers from text-window and text-frame is complete. Now the text-window should be generic and usable for any window displaying text with scrollbars.

spec/more_speech/ui/header_frame_spec.clj

@@ -12,6 +12,11 @@
     20)
   )
 
+(defrecord mock-controls []
+  text-window-controls
+  (get-element-height [_c _state]
+    2))
+
 (defrecord mock-widget []
   widget)
 
@@ -21,11 +26,11 @@
 (describe "article frame"
   (with state {:application
                {:graphics (->mock-graphics)}})
-  (with frame {:x 0 :y 0 :w 500 :h 500})
+  (with frame {:x 0 :y 0 :w 500 :h 500 :controls (->mock-controls)})
   (context "setup"
     (it "determines number of article headers fit in the frame"
       (let [frame (setup-text-frame @state @frame)]
-        (should= 10 (:n-elements frame)))
+        (should= 250 (:n-elements frame)))
       )
     )
 

src/more_speech/core.clj

@@ -53,14 +53,14 @@
   (draw-widget application state)
   )
 
-(defn mouse-wheel [state clicks]
+(defn mouse-wheel [state delta]
   (let [application (:application state)
         x (q/mouse-x)
         y (q/mouse-y)
         widget (w/find-deepest-mouse-target application x y)
         wheel-f (get widget :mouse-wheel)]
     (if (some? wheel-f)
-      (wheel-f widget state clicks)
+      (wheel-f widget state delta)
       state))
   )
 

src/more_speech/ui/application.clj

@@ -19,6 +19,7 @@
                                            setup-child-widgets]]
             [more-speech.ui.text-window :refer [map->text-window]]
             [more-speech.ui.text-frame :refer [map->text-frame]]
+            [more-speech.ui.header-frame-functions :refer [->header-controls]]
             [more-speech.ui.author-window :refer [map->author-window
                                                   draw-author-window]]
             [more-speech.ui.graphics :as g]
@@ -74,7 +75,7 @@
                          :y (:y config/article-window-dimensions)
                          :w (g/pos-width graphics (:char-width config/article-window-dimensions))
                          :h (- (g/screen-height graphics) (:bottom-margin config/article-window-dimensions))
-                         :frame-constructor map->text-frame
+                         :controls (->header-controls)
                          })
 
       :author-window (map->author-window

src/more_speech/ui/header_frame_functions.clj

@@ -7,9 +7,31 @@
             [more-speech.ui.button :refer [map->button
                                            up-arrow
                                            down-arrow]]
-            [more-speech.ui.app-util :as app-util]))
+            [more-speech.ui.app-util :as app-util]
+            [more-speech.ui.text-frame :refer [text-window-controls
+                                               get-element-height
+                                               draw-elements
+                                               update-elements
+                                               scroll-elements]]))
 
-(defn get-element-height [state]
+(declare get-header-height
+         draw-headers
+         update-headers
+         scroll-headers)
+
+(defrecord header-controls []
+  text-window-controls
+  (get-element-height [_c state]
+    (get-header-height state))
+  (draw-elements [_c state frame]
+    (draw-headers state frame))
+  (update-elements [_c state frame]
+    (update-headers state frame))
+  (scroll-elements [_c state frame delta]
+    (scroll-headers state frame delta))
+  )
+
+(defn get-header-height [state]
   (let [graphics (get-in state [:application :graphics])
         line-height (g/line-height graphics)
         header-height (+ config/header-bottom-margin
@@ -109,6 +131,30 @@
             id (:id button)]
         (recur (assoc frame id button) (rest buttons))))))
 
+(defn update-headers [state frame]
+  (let [application (:application state)
+        event-map (:text-event-map application)
+        events (:chronological-text-events application)
+        open-thread (:open-thread application)
+        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-elements frame)))
+        displayed-events (subvec threaded-events display-position end-position)
+        nicknames (:nicknames application)
+        headers (events->headers displayed-events nicknames)
+        bc (make-button-creator state frame)
+        frame-path (:path frame)
+        frame (get-in state frame-path)
+        frame (app-util/clear-widgets frame)
+        buttons (create-thread-buttons bc headers)
+        frame (add-thread-buttons frame buttons)
+        marked-up-headers (map a/markup-header headers)
+        frame (assoc frame :displayed-elements marked-up-headers
+                           :total-elements total-events)
+        state (assoc-in state frame-path frame)]
+    state))
+
 
 (defn draw-header [frame cursor header index]
   (let [g (:graphics cursor)
@@ -136,3 +182,13 @@
             (recur cursor (rest headers) index)
             (recur (draw-header frame cursor header index)
                    (rest headers) (inc index))))))))
+
+(defn scroll-headers [state frame delta]
+  (let [articles (get-in state [:application :chronological-text-events])
+        display-position (:display-position frame)
+        display-position (+ display-position delta)
+        display-position (min (count articles) display-position)
+        display-position (max 0 display-position)
+        frame (assoc frame :display-position display-position)]
+    frame))
+

src/more_speech/ui/text_frame.clj

@@ -2,21 +2,27 @@
   (:require
     [more-speech.ui.widget :refer [widget]]
     [more-speech.ui.graphics :as g]
-    [more-speech.content.article :as a]
     [more-speech.ui.app-util :as app-util]
-    [more-speech.ui.header-frame-functions
-     :refer [get-element-height
-             draw-headers]
-     :as funcs]
     ))
 
+(defprotocol text-window-controls
+  (get-element-height [controls state]
+    "returns the fixed height, in pixels, of the scrolled element.")
+  (draw-elements [controls state frame]
+    "draws :displayed-elements.")
+  (update-elements [controls state frame]
+    "Called only if the widget is in [:application :this-update]
+    sets :total-elements and :displayed-elements")
+  (scroll-elements [controls state frame delta]
+    "sets :display-position"))
+
 (declare setup-text-frame
          update-text-frame
          draw-text-frame
          mouse-wheel
          scroll-frame)
 
-(defrecord text-frame [x y w h display-position]
+(defrecord text-frame [x y w h display-position controls]
   widget
   (setup-widget [widget state]
     (setup-text-frame state widget))
@@ -28,7 +34,8 @@
   )
 
 (defn setup-text-frame [state frame]
-  (let [element-height (get-element-height state)
+  (let [controls (:controls frame)
+        element-height (get-element-height controls state)
         elements (quot (:h frame) element-height)
         frame (assoc frame :n-elements elements
                            :mouse-wheel mouse-wheel
@@ -37,32 +44,11 @@
 
 (defn- update-text-frame [state frame]
   (if (app-util/update-widget? state frame)
-    (let [application (:application state)
+    (update-elements (:controls frame) state frame)
-          event-map (:text-event-map application)
-          events (:chronological-text-events application)
-          open-thread (:open-thread application)
-          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-elements frame)))
-          displayed-events (subvec threaded-events display-position end-position)
-          nicknames (:nicknames application)
-          headers (funcs/events->headers displayed-events nicknames)
-          bc (funcs/make-button-creator state frame)
-          frame-path (:path frame)
-          frame (get-in state frame-path)
-          frame (app-util/clear-widgets frame)
-          buttons (funcs/create-thread-buttons bc headers)
-          frame (funcs/add-thread-buttons frame buttons)
-          marked-up-headers (map a/markup-header headers)
-          frame (assoc frame :displayed-elements marked-up-headers
-                             :total-elements total-events)
-          state (assoc-in state frame-path frame)]
-      state)
     state))
 
 (defn draw-text-frame [state frame]
-  (let [{:keys [x y w h]} frame
+  (let [{:keys [x y w h controls]} frame
         application (:application state)
         g (:graphics application)]
     (g/with-translation
@@ -72,20 +58,15 @@
         (g/stroke-weight g 2)
         (g/no-fill g)
         (g/rect g [0 0 w h])
-        (draw-headers state frame)))))
+        (draw-elements controls state frame)))))
 
 (defn scroll-frame [frame-path state delta]
   (let [frame (get-in state frame-path)
-        articles (get-in state [:application :chronological-text-events])
+        controls (:controls frame)
-        display-position (:display-position frame)
+        state (assoc-in state frame-path (scroll-elements controls state frame delta))
-        display-position (+ display-position delta)
-        display-position (min (count articles) display-position)
-        display-position (max 0 display-position)
-        frame (assoc frame :display-position display-position)
-        state (assoc-in state frame-path frame)
         state (app-util/update-widget state frame)]
     state))
 
-(defn mouse-wheel [widget state clicks]
+(defn mouse-wheel [frame state clicks]
-  (scroll-frame (:path widget) state clicks))
+  (scroll-frame  (:path frame) state clicks))
 

src/more_speech/ui/text_window.clj

@@ -1,6 +1,7 @@
 (ns more-speech.ui.text-window
   (:require
     [more-speech.ui.widget :refer [widget]]
+    [more-speech.ui.text-frame :refer [map->text-frame]]
     [more-speech.ui.button :refer [map->button
                                    up-arrow
                                    down-arrow
@@ -21,7 +22,7 @@
          scroll-up
          scroll-down)
 
-(defrecord text-window [x y w h page-up page-down frame-constructor]
+(defrecord text-window [x y w h page-up page-down controls]
   widget
   (setup-widget [widget state]
     (setup-text-window widget state))
@@ -30,28 +31,29 @@
   (draw-widget [widget state]
     (draw-text-window state widget)))
 
-(defn setup-text-window [widget _state]
+(defn setup-text-window [window _state]
-  (let [{:keys [x y w h frame-constructor]} widget
+  (let [{:keys [x y w h controls]} window
-        frame-path (concat (:path widget) [:text-frame])
+        frame-path (concat (:path window) [:text-frame])
         scroll-up (partial scroll-up frame-path)
         scroll-down (partial scroll-down frame-path)
-        frame (frame-constructor {:x x
+        frame (map->text-frame {:x x
-                                  :y y
+                                :y y
-                                  :w (- w config/scroll-bar-w)
+                                :w (- w config/scroll-bar-w)
-                                  :h h
+                                :h h
-                                  :display-position 0})
+                                :controls controls
+                                :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
+        widget (assoc window
                  :text-frame frame
                  :scroll-down (map->button {:x sb-button-x
-                                        :y (+ y config/scroll-bar-button-top-margin)
+                                            :y (+ y config/scroll-bar-button-top-margin)
-                                        :h config/scroll-bar-button-h
+                                            :h config/scroll-bar-button-h
-                                        :w config/scroll-bar-button-w
+                                            :w config/scroll-bar-button-w
-                                        :left-down scroll-down
+                                            :left-down scroll-down
-                                        :left-held scroll-down
+                                            :left-held scroll-down
-                                        :draw up-arrow})
+                                            :draw up-arrow})
                  :scroll-up (map->button {:x sb-button-x
                                           :y (+ y h (- config/scroll-bar-button-bottom-margin))
                                           :h config/scroll-bar-button-h