touch.cljs

(ns er-webui.util.touch
  (:require
   [taoensso.timbre :refer-macros [debug info warn error]]))

(defprotocol ITouchState
  (-start [self event])
  (-move [self event])
  (-end [self event])
  (-cancel [self event])

  ;; can be used to simulate touch with a mouse
  (-mouse-down [self event])
  (-mouse-move [self event])
  (-mouse-up [self event])

  (-handles? [self event-key]))

(defn maybe-call-handler
  ([handlers key]
   (maybe-call-handler handlers key nil))
  ([handlers key override-result]
   (fn [state & other-args]
     (if-let [handler (get handlers key)]
       (let [r (apply handler state other-args)]
         (if (not-empty override-result)
           (first override-result)
           r))
       state))))

(defrecord TouchState [handlers state-atom]
  ITouchState
  (-start [self event]
    (swap! state-atom
           (maybe-call-handler handlers :start)
           event))

  (-move [self event]
    (swap! state-atom
           (maybe-call-handler handlers :move)
           event))

  (-end [self event]
    (swap! state-atom
           (maybe-call-handler handlers :end [nil])
           event))

  (-cancel [self event]
    (swap! state-atom
           (maybe-call-handler handlers :cancel [nil])
           event))

  (-mouse-down [self event]
    (swap! state-atom
           (maybe-call-handler handlers :mouse-down)
           event))

  (-mouse-move [self event]
    (swap! state-atom
           (maybe-call-handler handlers :mouse-move)
           event))

  (-mouse-up [self event]
    (swap! state-atom
           (maybe-call-handler handlers :mouse-up [nil])
           event))

  (-handles? [self event-key]
    (contains? handlers event-key)))

(defn create-touch-state
  "create a TouchState from a map of handler fns.
   each handler fn will take a current state and
   an event, and return an updated state
   {:start (fn [state event])
    :move ... :end ... :cancel ..}"
  [handlers]
  (map->TouchState {:handlers handlers
                    :state-atom (atom nil)}))

(defn touch-handlers
  "return a map of handlers for reagent component attrs"
  [touch-state]
  (->> [:start :move :end :cancel :mouse-down :mouse-move :mouse-up]
       (reduce
        (fn [h ek]
          (if (-handles? touch-state ek)
            (merge h
                   (case ek
                     :start {:on-touch-start
                             (fn [event]
                               (-start touch-state event))}

                     :move  {:on-touch-move
                             (fn [event]
                               (-move touch-state event))}

                     :end {:on-touch-end
                           (fn [event]
                             (-end touch-state event))}

                     :cancel {:on-touch-cancel
                              (fn [event]
                                (-cancel touch-state event))}

                     :mouse-down {:on-mouse-down
                                  (fn [event]
                                    (-mouse-down touch-state event))}

                     :mouse-move {:on-mouse-move
                                  (fn [event]
                                    (-mouse-move touch-state event))}

                     :mouse-up {:on-mouse-up
                                (fn [event]
                                  (-mouse-up touch-state event))}))
            h))
        {})))


(defn create-touch-tap-state
  "create a touch-state with handlers for recognizing a tap...
   on-tap is a 0-args fn called when a tap is recognized"
  [on-tap]
  (create-touch-state
   {:start (fn [st ev]
             (let [touch-list (.-targetTouches ev)
                   l (some-> touch-list .-length)]
               (when (and l (= 1 l))
                 (debug "touch-tap - starting")
                 touch-list)))
    :move (fn [st ev]
            (debug "touch-tap - cancelling after move")
            nil)
    :end (fn [st ev]
           (when st
             (debug "touch-tap - firing!")
             (.preventDefault ev)
             (.stopPropagation ev)
             (on-tap)))}))