blog about

XKCD click and drag with Clojurescript

25 Sep 2012

Today is reinvent the wheel day. And this day was a pleasure for me to reinvent the famous xkcd 'click and drag' comic with Clojurescript.

My solution is programmed like the xkcd version. That programming style is not the best for a language like clojurescript. There are better ways to do that.

Here is the result

click and drag

And here is the clojurescript source.

(ns drag-and-drop)

(def comic (js/jQuery "#comic"))
(def comic_size [(.width comic) (.height comic)])
(def the_map (.find comic ".map"))
(def centre [-1 0])
(def tilesize 2048)
(def position [0 0])
(def size [14 48 25 33])
(def scroll_delta [0 0])
(def to_remove nil)

(defn clj->js
   (string? x) x
   (keyword? x) (name x)
   (map? x) (.-strobj (reduce (fn [m [k v]]
                                (assoc m (clj->js k) (clj->js v))) {} x))
   (coll? x) (apply array (map clj->js x))
   :else x))

(defn tile_name
  [x y]
  (let [x (- x (get size 3))
        y (- y (get size 0))]
    (str (if (>= y 0)
           (str (inc y) "s")
           (str (- y) "n"))
         (if (>= x 0)
           (str (inc x) "e")
           (str (- x) "w")))))

(defn init
  (.css comic (clj->js
               {:z-index 1
                :overflow "hidden"
                :width "740px"
                :height "694px"
                :margin "0px auto 0"
                :background "#fff"
                :position "relative"}))

  (.css (.children comic "img") (clj->js
                                 {:background "transparent"
                                  :position "relative"}))

  (let [map_size [(* (+ (get size 1) (get size 3)) tilesize)
                  (* (+ (get size 0) (get size 2)) tilesize)]]
        (.css the_map (clj->js
                       {:width (first map_size)
                        :height (second map_size)
                        :position "absolute"
                        :zIndex -1

  (.css (.find the_map ".ground") (clj->js
                                   {:top (* (get size 0) tilesize)
                                    :height (* (get size 2) tilesize)
                                    :position "absolute"
                                    :width "100%"
                                    :zIndex -1
                                    :background "#000"}))

  (set! position [(- (* (+ (get size 3) 0.03) tilesize))
                  (- (* (- (get size 0) 0.55) tilesize))]))

(defn update
  (.css the_map (clj->js {:left (first position)
                          :top (second position)}))

  (let [new_centre [(Math/floor (- (/ (first position) tilesize)))
                    (Math/floor (- (/ (second position) tilesize)))]]
        (if (not (= new_centre centre))
            (set! centre new_centre)
            (set! to_remove (.not (.children the_map) ".ground"))
            (doseq [[x y] (for [x (range -1 2) y (range -1 2)] [x y])]
              (let [name (tile_name (+ (first centre) x) (+ (second centre) y))
                    class_name (str "tile" name)
                    url (str "<img class=\"" class_name "\" "
                             ".png\" style=\"top:"
                             (* (+ (second centre) y) tilesize) "px;"
                             "left:" (* (+ (first centre) x) tilesize)
                             "px; z-index: 2;position: absolute;\"" "/>")
                    tile (.find the_map (str "." class_name))]
                (if (= (.-length tile) 0)
                  (let [image (js/jQuery url)]
                    (.load image (fn [] (.append the_map image))))
                  (set! to_remove (.not to_remove tile)))))
              (.remove to_remove)))))

(defn event_pos
  (let [get_pos (fn [e] {:pageX (.-pageX e)
                         :pageY (.-pageY e)})]
  (if (.match (.-type e) "^touch")
    (get_pos (aget (.-changedTouches (.-originalEvent e)) 0))
    (get_pos e))))

(defn clamp
  [x min_val max_val]
  (max (min x max_val) min_val))

(defn drag
  (if-not (nil? scroll_delta)
    (let [pos (event_pos e)]
      (set! position
            [(Math.round (clamp (+ (:pageX pos) (first scroll_delta))
                                (- (+ (* (+ (get size 1) (get size 3)) tilesize)
                                      (first comic_size)))
             (Math.round (clamp (+ (:pageY pos) (second scroll_delta))
                                (- (+ (* (+ (get size 0) (get size 2)) tilesize)
                                      (second comic_size)))

(defn register
  (.on comic "mousedown touchstart"
       (fn [e]
         (let [pos (event_pos e)]
           (set! scroll_delta [(- (first position) (:pageX pos))
                               (- (second position) (:pageY pos))])
           (.on comic (if (= "mousedown" (.-type e))
           (.preventDefault e))))
  (.on comic "mouseup touchend"
       (fn [e]
         (.off comic "mousemove touchmove" drag)
         (set! scroll_delta nil))))

comments powered by Disqus
Kai Strempel