Rectangle collision

constrained.cljs

;; load this example in a browser from this link:
;; http://app.klipse.tech/?container=1&cljs_in.gist=timothypratley/f55596fa4c39e9e8326b2cfec0ec4551
(ns constrained.core
  (:require [reagent.core :as reagent]
            [goog.dom :as dom]))

(set! *warn-on-infer* true)

(defn collision? [x y w h other-rectangles]
  (some
    (fn a-collision? [{:keys [left top width height]}]
      (and
        (< x (+ left width))
        (> x (- left w))
        (< y (+ top height))
        (> y (- top h))))
    other-rectangles))

(defn solve [current-x current-y target-x target-y w h other-rectangles]
  (cond
    (and (< current-x target-x) (not (collision? (inc current-x) current-y w h other-rectangles)))
    (recur (inc current-x) current-y target-x target-y w h other-rectangles)
    (and (> current-x target-x) (not (collision? (dec current-x) current-y w h other-rectangles)))
    (recur (dec current-x) current-y target-x target-y w h other-rectangles)
    (and (< current-y target-y) (not (collision? current-x (inc current-y) w h other-rectangles)))
    (recur current-x (inc current-y) target-x target-y w h other-rectangles)
    (and (> current-y target-y) (not (collision? current-x (dec current-y) w h other-rectangles)))
    (recur current-x (dec current-y) target-x target-y w h other-rectangles)
    :else
    [current-x current-y]))

(defn move [{:keys [rectangles] :as app-state} idx target-x target-y]
  (let [{:keys [left top width height]} (get rectangles idx)
        other-rectangles (concat (take idx rectangles)
                                 (drop (inc idx) rectangles))
        [next-x next-y]
        (if (collision? target-x target-y width height other-rectangles)
          (solve left top target-x target-y width height other-rectangles)
          [target-x target-y])]
    (update-in app-state [:rectangles idx]
               assoc :left next-x :top next-y)))

(defn main-view [app-state]
  (let [rectangles (:rectangles @app-state)]
    [:div
     [:h2 "Drag the rectangles around..."]
     (into
       [:div {:style {:position "relative"}}]
       (map-indexed
         (fn [idx {:keys [left top] :as rectangle}]
           [:div {:draggable true
                  :style (merge {:position "absolute"} rectangle)
                  :on-drag-start
                  (fn rectangle-drag-start [^js/MouseEvent e]
                    (.setDragImage (.-dataTransfer e) (js/Image.) 0 0)
                    (swap! app-state assoc :drag-from
                           {:dx (- (.-clientX e) left)
                            :dy (- (.-clientY e) top)}))
                  :on-drag
                  (fn rectangle-drag [^js/MouseEvent e]
                    (let [{:keys [dx dy]} (:drag-from @app-state)
                          mouse-x (.-clientX e)
                          mouse-y (.-clientY e)]
                      ;; TODO: better way to detect last event?
                      (when (or (not= mouse-x 0) (not= mouse-y 0))
                        (let [target-x (- mouse-x dx)
                              target-y (- mouse-y dy)]
                          (swap! app-state move idx target-x target-y)))))
                  :on-drag-end
                  (fn rectangle-drag-end [e]
                    (swap! app-state dissoc :drag-from))}])
         rectangles))]))

(defn random-rect []
  {:top (rand-int 800) :left (rand-int 800)
   :width (inc (rand-int 50)) :height (inc (rand-int 50))
   :background-color (rand-nth ["#090300"
                                "#db2d20"
                                "#01a252"
                                "#fded02"
                                "#01a0e4"
                                "#a16a94"
                                "#b5e4f4"
                                "#a5a2a2"
                                "#5c5855"
                                "#db2d20"
                                "#01a252"
                                "#fded02"
                                "#01a0e4"
                                "#a16a94"
                                "#b5e4f4"])})

(def app-state
  (reagent/atom
    {:rectangles (vec (repeatedly 100 random-rect))}))

(reagent/render-component [main-view app-state]
                          (dom/getElement "klipse-container"))