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

update-widget now just returns the state. When you use the State monad, you gotta really USE the State monad!

Browse Source
This commit is contained in:
Robert C. Martin 2022-02-04 08:25:26 -06:00
parent 09ccc80a28
commit 54bb26c8a4
8 changed files with 47 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
spec/more_speech/ui/button_spec.clj
View File

@ -9,37 +9,43 @@
(get-mouse [graphics] [x y which]))
(defn- left-up [button state]
[(assoc button :left-came-up true)
state])
(assoc-in state (conj (:path button) :left-came-up) true))
(declare b)
(describe "mouse position within button"
(with b (map->button {:x 10 :y 10 :w 10 :h 10
:button-state :whatever
:left-up left-up}))
:left-up left-up
:path [:application :button]}))
(it "is :out if mouse is not in the rectangle."
(let [mock-g (->mouse-pos 0 0 nil)
[b _] (w/update-widget @b {:application {:graphics mock-g}})]
state (w/update-widget @b {:application {:graphics mock-g}})
b (get-in state [:application :button])]
(should= :out (:button-state b))))
(it "is :in if mouse is in rectangle."
(let [mock-g (->mouse-pos 10 10 nil)
[b _] (w/update-widget @b {:application {:graphics mock-g}})]
state (w/update-widget @b {:application {:graphics mock-g}})
b (get-in state [:application :button])]
(should= :in (:button-state b))))
(it "is :left if mouse is in rectangle and left is down."
(let [mock-g (->mouse-pos 10 10 :left)
[b _] (w/update-widget @b {:application {:graphics mock-g}})]
state (w/update-widget @b {:application {:graphics mock-g}})
b (get-in state [:application :button])]
(should= :left (:button-state b))))
(it "is :right if mouse is in rectangle and right is down."
(let [mock-g (->mouse-pos 10 10 :right)
[b _] (w/update-widget @b {:application {:graphics mock-g}})]
state (w/update-widget @b {:application {:graphics mock-g}})
b (get-in state [:application :button])]
(should= :right (:button-state b))))
(it "calls :left-up if left button comes up while inside."
(let [mock-g (->mouse-pos 10 10 nil)
b (assoc @b :button-state :left)
[b _] (w/update-widget b {:application {:graphics mock-g}})]
state (w/update-widget b {:application {:graphics mock-g
:button b}})
b (get-in state [:application :button])]
(should (:left-came-up b))))
)

4
spec/more_speech/ui/widget_spec.clj
View File

@ -12,6 +12,8 @@
(setup-widget [widget state]
(assoc widget :child (->child))))
(defn- f [widget state] (assoc-in state (conj (:path widget) :did-f) true))
(describe "Widgets"
(context "get child widgets"
(it "gets one child"
@ -36,7 +38,6 @@
child-2 (assoc (->child) :path [:parent :child-2])
parent {:path [:parent] :child-1 child-1 :child-2 child-2}
state {:parent parent}
f (fn [widget state] [(assoc widget :did-f true) state])
state (update-children parent state f)]
(should (get-in state [:parent :child-1 :did-f] false))
(should (get-in state [:parent :child-2 :did-f] false))))
@ -47,7 +48,6 @@
parent {:path [:parent] :child child}
state {:parent parent}
state (setup-child-widgets parent state)
f (fn [widget state] [(assoc widget :did-f true) state])
state (update-children (:parent state) state f)]
(should (get-in state [:parent :child :did-f] false))
(should (get-in state [:parent :child :child :did-f] false)))))

3
src/more_speech/core.clj
View File

@ -29,8 +29,7 @@
))
(defn update-state [{:keys [application] :as state}]
(let [[application state] (update-widget application state)
state (assoc state :application application)
(let [state (update-widget application state)
state (update-child-widgets (:application state) state)]
(if (empty? @events)
state

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

@ -16,7 +16,7 @@
(setup-widget [widget state]
(setup-application widget path state))
(update-widget [widget state]
[widget state])
state)
(draw-widget [application state]
(draw-child-widgets application state))
)

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

@ -25,7 +25,7 @@
:draw down-arrow})
))
(update-widget [widget state]
[widget state])
state)
(draw-widget [widget state]
(draw-article-window (:application state) widget))
)
@ -38,7 +38,7 @@
display-position (+ display-position 19)
article-window (assoc article-window :display-position display-position)
state (assoc-in state parent-path article-window)]
[button state]))
state))
(defn- scroll-down [button state]
(let [button-path (:path button)
@ -48,7 +48,7 @@
display-position (max 0 (- display-position 19))
article-window (assoc article-window :display-position display-position)
state (assoc-in state parent-path article-window)]
[button state]))
state))
(defn draw-article [window cursor article]
(let [g (:graphics cursor)]

2
src/more_speech/ui/author_window.clj
View File

@ -13,7 +13,7 @@
(setup-widget [widget state]
widget)
(update-widget [widget state]
[widget state])
state)
(draw-widget [widget state]
(draw-author-window (:application state) widget))
)

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

@ -35,12 +35,10 @@
previous-state (:button-state button)
in? (util/inside-rect [x y w h] [mx my])
button-state (get-button-state in? which)
[button state] (if (and (nil? which) (= :left previous-state))
((:left-up button) button state)
[button state])]
[(assoc button :button-state button-state)
state]
)
state (if (and (nil? which) (= :left previous-state))
((:left-up button) button state)
state)]
(assoc-in state (conj (:path button) :button-state) button-state))
)
(defn up-arrow [graphics {:keys [x y w h button-state]}]
@ -69,22 +67,22 @@
(defn down-arrow [graphics {:keys [x y w h button-state]}]
(g/stroke graphics [0 0 0])
(let [weight (if (= button-state :in) 2 1)
fill (if (= button-state :left) [0 0 0] [nil])
w2 (/ w 2)
h2 (/ h 2)
w3 (/ w 3)
w23 (* 2 w3)
pa [w2 h]
pb [w h2]
pc [w23 h2]
pd [w23 0]
pe [w3 0]
pf [w3 h2]
pg [0 h2]]
(g/with-translation
graphics [x y]
(fn [graphics]
(g/stroke-weight graphics weight)
(g/fill graphics fill)
(g/polygon graphics [pa pb pc pd pe pf pg pa])))))
(let [weight (if (= button-state :in) 2 1)
fill (if (= button-state :left) [0 0 0] [nil])
w2 (/ w 2)
h2 (/ h 2)
w3 (/ w 3)
w23 (* 2 w3)
pa [w2 h]
pb [w h2]
pc [w23 h2]
pd [w23 0]
pe [w3 0]
pf [w3 h2]
pg [0 h2]]
(g/with-translation
graphics [x y]
(fn [graphics]
(g/stroke-weight graphics weight)
(g/fill graphics fill)
(g/polygon graphics [pa pb pc pd pe pf pg pa])))))

5
src/more_speech/ui/widget.clj
View File

@ -2,7 +2,7 @@
(defprotocol widget
(setup-widget [widget state] "returns the setup widget")
(update-widget [widget state] "returns [widget state] updated.")
(update-widget [widget state] "returns state updated.")
(draw-widget [widget state] "returns nothing. No state change.")
)
@ -38,8 +38,7 @@
(let [child-tag (first child-tags)
child-path (conj path child-tag)
child (get-in state child-path)
[child state] (f child state)
state (assoc-in state child-path child)
state (f child state)
child (get-in state child-path)
state (update-children child state f)]
(recur state (rest child-tags))))))