Om drag & snap

canvas.cljs

(ns runes24.components.canvas
  (:require [clojure.string :as str]
            [cljs.core.async :as async]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer [html] :include-macros true]
            [shodan.console :as console]
            [runes24.components.meaning-rune :refer [meaning-rune]]
            [runes24.utils :as utils]
))

(defn handle-resize [app owner]
  (let [node (om/get-node owner "svg-root")
        cx (/ (.-clientWidth node) 2)
        cy (/ (.-clientHeight node) 2)
        r (min cx cy)
        n (om/read app :runes count)]
    (mapv (fn [[k v]] (om/set-state! owner [k] v))
          {:cx cx
           :cy cy
           :r r
           :star (utils/star-points n cx cy (* (om/read app :star-outer-radius) r) (* (om/read app :star-inner-radius) r))
           :positions-star (utils/polygon-points n cx cy (* (om/read app :position-rune-radius) r))
           :meanings-radius (* r (/ (+ (om/read app :middle-circle-radius) (om/read app :inner-circle-radius)) 2))})))

(defn handle-events [app owner [type :as e]]
  (case type
    :resize (handle-resize app owner)
    nil))

(defn position-rune [app owner {:keys [x y rune r]}]
  (om/component
    (html
      [:text.rune.position-rune
       {:x x
        :y y
        :style {:font-size (str (* r (:position-rune-size app)) "px")}}
       rune])))

(defn canvas [app owner opts]
  (reify
    om/IInitState
    (init-state [_]
      (utils/make-events-with-mixer))
    om/IWillMount
    (will-mount [_]
      (utils/handle! app owner (om/get-state owner :events) handle-events))
    om/IDidMount
    (did-mount [_ node]
      (async/admix
        (om/get-state owner :mixer)
        (async/map< (constantly [:resize]) (utils/listen! js/window :resize)))
      (async/put! (om/get-state owner :events) [:resize]))
    om/IRender
    (render [_]
      (let [{:keys [cx cy r star positions-star meanings-radius]} (om/get-state owner)]
        (html
          [:svg.span1
           {:version "1.1"
            :xmlns "http://www.w3.org/2000/svg"
            :ref "svg-root"}
           [:polygon.star {:points (str/join " " (map (partial str/join ",") star))}]
           [:circle.middle-circle {:cx cx :cy cy :r (* (:middle-circle-radius app) r)}]
           [:circle.inner-circle {:cx cx :cy cy :r (* (:inner-circle-radius app) r)}]
           (map
             (fn [rune [x y]]
               (om/build position-rune
                         app
                         {:opts {:x x :y y :rune rune :r r}
                          :react-key (str "position-rune-" rune)}))
             (:runes app)
             positions-star)
           (map
             (fn [rune i]
               (om/build meaning-rune
                         app
                         {:opts {:rune rune :i i :r meanings-radius :cx cx :cy cy}
                          :react-key (str "meaning-rune-" rune)}))
             (:runes app)
             (range))
           ])))))

meaning_rune.cljs

(ns runes24.components.meaning-rune
  (:require-macros [cljs.core.async.macros :refer [go-loop alt!]])
  (:require [cljs.core.async :as async]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer [html] :include-macros true]
            [dommy.core :as dom]
            [shodan.console :as console]
            [runes24.utils :as utils]
))

(defn location [e]
  (let [e (or (.-nativeEvent e) e)]
    [(.-pageX e) (.-pageY e)]))

(defn drag! [owner p]
  (when (om/get-state owner :drag?)
    (let [{:keys [xy drag-from] :or {drag-from p}} (om/get-state owner)]
      (mapv (fn [[k v]] (om/set-state! owner [k] v))
            {:xy (mapv + xy p (mapv - drag-from))
             :drag-from p}))))

(defn stop-drag [owner p]
  (when (om/get-state owner :drag?)
    (mapv (fn [[e f]] (dom/unlisten! js/window e f)) (om/get-state owner :drag-listeners))
    (om/set-state! owner :drag? false)))

(defn start-drag [owner p]
  (when-not (om/get-state owner :drag?)
    (mapv (fn [[e f]] (dom/listen! js/window e f)) (om/get-state owner :drag-listeners))
    (om/set-state! owner :drag? true)))

(defn handle-drag [app owner]
  (let [c (async/map< (fn [[t e]] [t (location e)]) (om/get-state owner :drag-chan))]
    (go-loop
      []
      (when-let [[t p] (async/<! c)]
        (case t
          :start (start-drag owner p)
          :move (drag! owner p)
          :stop (stop-drag owner p)
          nil)
        (recur)))))

(defn meaning-rune [app owner {:keys [rune i r cx cy]}]
  (reify
    om/IInitState
    (init-state [_]
      (let [drag-chan (async/chan)]
        ; FIXME no magic numbers! why 50?
        {:drag? false
         :drag-chan drag-chan
         :drag-listeners {:mousemove #(async/put! drag-chan [:move %])
                          :mouseup #(async/put! drag-chan [:stop %])}
         :xy [(-> i (rem 8) inc (* 50)) (-> i (quot 8) inc (* 50))]
         :position [nil nil]}))
    om/IDidMount
    (did-mount [_ node]
      (handle-drag app owner))
    ()
    om/IRender
      (let [[old-pos k] (om/get-state owner :position)
            rc (count (:runes app))
            [x y] (if (or (om/get-state owner :drag?) (nil? old-pos))
                    (om/get-state owner :xy)
                    (utils/polygon-point k rc cx cy r))
            [p n] (utils/nearest-polygon-point x y rc cx cy r)
            sz (* r (:meaning-rune-size app))
            close (< (utils/distance p [x y]) sz)
            pos ((:runes app) n)
            new-position ((:runes app) n)
            pos-rune (get-in app [:spread pos])
            snap (and close (or (nil? pos-rune) (= pos-rune rune)))
            [x y] (if snap p [x y])
            ]
        (if snap
          (do
            (om/set-state! owner :position [pos n])
            (om/transact! app :spread assoc pos rune))
          (om/set-state! owner :position [nil nil]))
        (when (and old-pos (not= pos old-pos))
          (om/transact! app :spread assoc old-pos nil))
        (html
          [:text.rune.meaning-rune
           {:x x
            :y y
            :on-mouse-down #(async/put! (om/get-state owner :drag-chan) [:start %])
            :style {:font-size (str sz "px")}}
           rune])))))