HP Spinner on Mobile

src/cljs/wish/db.cljs

@@ -3,6 +3,7 @@
 (def default-db
   {:page [:splash]
    :device-type :default
+   :touch? false ; true if there is a touch screen
 
    :updates {:latest nil
              :ignored :unknown}

src/cljs/wish/events.cljs

@@ -41,6 +41,12 @@
   (fn-traced [db [device-type]]
     (assoc db :device-type device-type)))
 
+(reg-event-db
+  :set-touch
+  [trim-v]
+  (fn-traced [db [touch?]]
+    (assoc db :touch? touch?)))
+
 (reg-event-fx
   ::update-keymap
   [trim-v (inject-cofx ::inject/sub [:meta/kind])]

src/cljs/wish/sheets/dnd5e/overlays/hp.cljs

@@ -12,7 +12,13 @@
             [wish.views.widgets :as widgets
              :refer-macros [icon]
              :refer [expandable formatted-text]]
-            [wish.views.widgets.fast-numeric]))
+            [wish.views.widgets.fast-numeric]
+            [wish.views.widgets.spinning-modifier
+             :refer [spinning-modifier]]))
+
+(defn- apply-hp-delta! [delta max-hp]
+  (>evt [::events/update-hp delta max-hp])
+  (>evt [:toggle-overlay nil]))
 
 (defn- condition-widget
   [[id level] _on-delete]
@@ -118,8 +124,7 @@
    {:on-submit (fn-click
                  (let [{:keys [heal damage]} @state]
                    (log "Update HP: heal +" heal "  -" damage)
-                   (>evt [::events/update-hp (- heal damage) max-hp])
-                   (>evt [:toggle-overlay nil])))}
+                   (apply-hp-delta! (- heal damage) max-hp)))}
    [:div.sections
 
     [:div.quick-adjust
@@ -191,34 +196,78 @@
       :save! #(>evt [::events/temp-max-hp! %2])}]]])
 
 
+(defn- non-touchable-ui [{:keys [state hp max-hp max-mod new-hp]}]
+  [:<>
+   [:h4 "Hit Points"]
+   [hp-form
+    :hp hp
+    :max-hp max-hp
+    :max-mod max-mod]
+
+   [:h5.centered.section-header "Quick Adjust"]
+   [quick-adjust-form state
+    :hp hp
+    :max-hp max-hp
+    :new-hp new-hp]
+   ])
+
+(defn- touchable-ui [{:keys [state hp max-hp]}]
+  [:<>
+   [:h4 "Hit Points"]
+
+   [:div.touchable
+    [spinning-modifier
+     state
+     :initial hp
+     :maximum max-hp
+     :delta->color (fn delta->color [delta]
+                     (cond
+                       (> delta 0) "#00cc00"
+                       (< delta 0) "#cc0000"))
+     :per-rotation (condp > max-hp
+                     100 20
+                     40)
+     :path [:heal]]
+
+    (when (let [delta (:heal @state)]
+            (and delta (not= 0 delta)))
+      [:div.sections
+       [:input.apply {:type 'button
+                      :value "Apply!"
+                      :on-click (fn-click
+                                  (apply-hp-delta! (:heal @state) max-hp))
+                      }] ])
+    ]
+   ])
+
 ; ======= public interface ================================
 
 (defn overlay []
   (r/with-let [state (r/atom {})]
     (let [[hp max-hp max-mod] (<sub [::hp/state])
           temp-hp (<sub [::hp/temp])
           {:keys [heal damage]} @state
+          touch? (<sub [:touch?])
+
           new-hp (max
                    0  ; you can't go negative in 5e
                    (min (+ max-hp temp-hp) ; don't collapse temp-hp above max
                         (- (+ hp heal)
-                           damage)))]
+                           damage)))
+
+          data {:state state
+                :hp hp
+                :max-hp max-hp
+                :max-mod max-mod
+                :new-hp new-hp}]
 
       [:div (styles/hp-overlay)
        (when (= 0 hp)
          [saving-throws])
 
-       [:h4 "Hit Points"]
-       [hp-form
-        :hp hp
-        :max-hp max-hp
-        :max-mod max-mod]
-
-       [:h5.centered.section-header "Quick Adjust"]
-       [quick-adjust-form state
-        :hp hp
-        :max-hp max-hp
-        :new-hp new-hp]
+       (if touch?
+         [touchable-ui data]
+         [non-touchable-ui data])
 
        ; temporary health management
        [:h5.centered.section-header "Temporary Health"]

src/cljs/wish/sheets/dnd5e/overlays/style.cljs

@@ -85,6 +85,12 @@
   [:.centered styles/text-center]
   [:.section-header {:margin-bottom "0px"}]
 
+  [:.touchable (merge flex/vertical
+                      flex/align-center)
+   [:input.apply (merge
+                   styles/button
+                   {:margin-top "1em"})]]
+
   [:.new-hp (merge styles/text-center
                    {:padding "12px"
                     :width "4em"})

src/cljs/wish/subs.cljs

@@ -16,6 +16,7 @@
 (def ^:private non-storable-providers #{:wish :demo})
 
 (reg-sub :device-type :device-type)
+(reg-sub :touch? :touch?)
 (reg-sub :showing-overlay :showing-overlay)
 
 (reg-sub

src/cljs/wish/views.cljs

@@ -58,6 +58,11 @@
     "(max-width: 479px)" [:set-device :smartphone]
     [:set-device :default]]
 
+   [media-tracker
+    "(hover: none) and (pointer: coarse)" [:set-touch true]
+    "(hover: none) and (pointer: fine)" [:set-touch true]
+    [:set-touch false]]
+
    [error-boundary
     [router pages]]
 

src/cljs/wish/views/widgets/circular_progress.cljs

@@ -5,7 +5,8 @@
             [wish.style :as theme]
             [wish.style.media :as media]))
 
-(defattrs circular-progress-attrs [width circumference stroke-width]
+(defattrs circular-progress-attrs [width circumference stroke-width
+                                   transition-duration color]
   {:height (px width)
    :width (px width)}
 
@@ -16,23 +17,25 @@
 
   [:.circle {:stroke-dasharray [[circumference circumference]]
              :stroke-width stroke-width
-             :stroke theme/text-primary-on-light
+             :stroke (or color theme/text-primary-on-light)
 
-             :transition [[:stroke-dashoffset "0.35s"]]
+             :transition [[:stroke-dashoffset transition-duration]]
              :transform "rotate(-90deg)"
              :transform-origin [[:50% :50%]]}
    (at-media media/dark-scheme
-     {:stroke theme/text-primary-on-dark})])
+     {:stroke (or color theme/text-primary-on-dark)})])
 
 (defn circular-progress
-  [current max & {:keys [stroke-width width]
+  [current max & {:keys [stroke-width width transition-duration color]
                   :or {stroke-width 4
+                       transition-duration "0.35s"
                        width 32}}]
   (let [radius (* 0.5 width)
-        inner-radius (- (/ width 2) (* 2 stroke-width))
+        inner-radius (- radius (/ stroke-width 2))
         circumference (* 2 inner-radius js/Math.PI)
         perc (/ current max)]
-    [:svg (circular-progress-attrs width circumference stroke-width)
+    [:svg (circular-progress-attrs width circumference stroke-width
+                                   transition-duration color)
      [:circle.slot {:fill 'transparent
                     :cx radius
                     :cy radius

src/cljs/wish/views/widgets/spinning_modifier.cljs

@@ -0,0 +1,122 @@
+(ns wish.views.widgets.spinning-modifier
+  (:require [reagent.core :as r]
+            [spade.core :refer [defattrs defclass defkeyframes]]
+            [wish.views.widgets.circular-progress
+             :refer [circular-progress]]))
+
+; by accepting the delta, we ensure that the animation has "changed"
+; every time they rotate, so this animation will restart, giving a
+; ratchet-like effect, like the numbers "clicking" into place.
+(defkeyframes grow-in [delta]
+  ^{:key delta}
+  [:from {:transform "scale(0.8)"}]
+  [:to {:transform "scale(1.0)"}])
+
+(defclass spinning-modifier-class []
+  {:display 'inline-block
+   :position 'relative}
+
+  [:.spinner {:touch-action 'none}]
+
+  [:.value {:position 'absolute
+            :left 0
+            :right 0
+            :text-align 'center
+            :top :50%
+            :transform "translateY(-50%)"}
+   [:.mod {:font-size "110%"
+           :font-weight 'bold}]])
+
+(defattrs modifier-attrs [color delta]
+  ^{:key ""} ; we don't need to create a new class every time
+  {:animation [[(grow-in delta) "175ms" "cubic-bezier(0, 0, 0.2, 1)"]]
+   :color color})
+
+(defn- polar-angle
+  "Given a box circumscribing a circle and a point relative to that box,
+   compute the polar coordinate angle of that point.  In other words,
+   project the point onto the circumference of the circle, and get the
+   angle of the equivalent polar coordinate.
+
+   0 degrees is 'east'; 90 is 'south', etc"
+  [element point]
+  (let [[x y w] element
+        [px py] point
+
+        ; shift the point so the box has origin at 0 0
+        ; with radius w/2
+        radius (/ w 2)
+        px (- px x radius)
+        py (- py y radius)]
+
+    ; from: https://math.stackexchange.com/a/1744369
+    (js/Math.atan2 py px)))
+
+(def ^:private two-pi (* js/Math.PI 2))
+
+(defn compute-rotation [element last-touch this-touch]
+  (let [last-angle (polar-angle element last-touch)
+        this-angle (polar-angle element this-touch)
+        delta (- this-angle last-angle)
+        normalized (cond
+                     (> delta js/Math.PI) (- two-pi delta)
+                     (< delta (- js/Math.PI)) (+ two-pi delta)
+                     :else delta)]
+    (-> normalized
+
+        ; convert to degrees:
+        (* 180)
+        (/ js/Math.PI))))
+
+(defn on-touch-move [state-ref rotation-ref, ^js e]
+  (let [touch (first (.-touches e))
+        state @state-ref
+        this-touch [(.-clientX touch) (.-clientY touch)]]
+    (when-let [last-touch (:last-touch state)]
+      (swap! rotation-ref + (compute-rotation
+                              (:element state)
+                              last-touch
+                              this-touch)))
+    (swap! state-ref assoc :last-touch this-touch)))
+
+(defn spinning-modifier [ratom & {:keys [initial maximum
+                                         delta->color
+                                         per-rotation path]
+                                  :or {delta->color (constantly nil)}}]
+  (letfn [(<v []
+            (get-in @ratom path 0))
+          (v< [v]
+            (swap! ratom assoc-in path v))]
+    (r/with-let [state (atom nil)
+                 rotation (r/atom 0)]
+      (let [delta (int (* per-rotation (/ @rotation 360)))
+            current (min (+ initial delta)
+                         maximum)
+            color (delta->color delta)]
+
+        (when-not (= (<v) delta)
+          (v< delta))
+
+        [:div {:class (spinning-modifier-class)
+               :on-touch-move (partial on-touch-move state rotation)
+               :on-touch-end #(swap! state dissoc :last-touch)}
+         [:div.spinner {:ref #(when-let [el %]
+                                (let [rect (.getBoundingClientRect el)]
+                                  (swap! state assoc :element
+                                         [(.-x rect) (.-y rect)
+                                          (.-width rect)
+                                          (.-height rect)])))}
+          [circular-progress delta per-rotation
+           :color color
+           :transition-duration "0.2s"
+           :stroke-width 16
+           :width 112]]
+
+         [:div.value
+          [:div.result current]
+
+          (when-not (= 0 delta)
+            [:div.mod (modifier-attrs color delta)
+             (when (> delta 0) "+")
+             delta])]
+         ]))))

test/cljs/wish/views/widgets/spinning_modifier_test.cljs

@@ -0,0 +1,21 @@
+(ns wish.views.widgets.spinning-modifier-test
+  (:require [cljs.test :refer-macros [deftest testing is]]
+            [wish.views.widgets.spinning-modifier
+             :refer [compute-rotation]]))
+
+(deftest compute-rotation-test
+  (testing "Rotate from 3 o'clock to 6 o'clock"
+    (is (= 90
+           (compute-rotation
+             [0 0 10 10]
+
+             ; touches:
+             [10 5] [5 10]))))
+
+  (testing "Rotate through 9 o'clock"
+    (is (< 0
+           (compute-rotation
+             [0 0 10 10]
+
+             [0 6] [0 4])))))
+