Playing around with quaternions in Arcadia

quaternion_exploration.clj

(ns quaternion-exploration
  (:import [UnityEngine Quaternion Vector3])
  (:use arcadia.core
        arcadia.hydrate
        clojure.repl
        clojure.pprint))

;; like emacs. kind of.
(defn kill! [x]
  (let [spec (dehydrate x)]
    (destroy x)
    spec))

;; for repl redefs, we need something way better than this tho
;; dataflow stuff would be nice
(defmacro defscn [name & body]
  `(do (declare ~name)
       (let [bldg# (do ~@body)]
         (when-not
             (instance? clojure.lang.Var+Unbound
               (var-get (resolve (quote ~name))))
           (destroy ~name))
         (def ~name bldg#))))

;; for branching on type
(defmacro condcast-> [expr xsym & clauses]
  (let [exprsym (gensym "exprsym_")
        [clauses default] (if (even? (count clauses))
                            [clauses nil] 
                            [(butlast clauses)
                             [:else
                              `(let [~xsym ~exprsym]
                                 ~(last clauses))]])
        cs (->> clauses
             (partition 2)
             (mapcat
               (fn [[t then]]
                 `[(instance? ~t ~exprsym)
                   (let [~(with-meta xsym {:tag t}) ~exprsym]
                     ~then)])))]
    `(let [~exprsym ~expr]
       ~(cons 'cond
          (concat cs default)))))

;; vectors 

(defn v3 ^Vector3 [x y z]
  (Vector3. x y z))

(defn v- ^Vector3 [^Vector3 v1 ^Vector3 v2]
  (Vector3/op_Subtraction v1 v2))

(defn v+ ^Vector3 [^Vector3 v1 ^Vector3 v2]
  (Vector3/op_Addition v1 v2))

(defn vmult-scalar ^Vector3 [^Vector3 v s]
  (Vector3/op_Multiply v (float s)))

(defn vmult-vec ^Vector3 [^Vector3 v1 ^Vector3 v2]
  (Vector3.
    (* (.x v1) (.x v2))
    (* (.y v1) (.y v2))
    (* (.z v1) (.z v2))))

(defn v* ^Vector3 [a b]
  (if (instance? Vector3 a)
    (if (instance? Vector3 b)
      (vmult-vec a b)
      (vmult-scalar a b))
    (if (instance? Vector3 b)
      (vmult-scalar b a)
      (throw
        (ArgumentException.
          "v* expects at least one Vector3")))))

;; quaternions

(defn q* [^Quaternion q, a]
  (condcast-> a a
    Vector3    (Quaternion/op_Multiply q a)
    Quaternion (Quaternion/op_Multiply q a)))

(defn qe ^Quaternion [^Vector3 v]
  (Quaternion/Euler v))

(defn qt ^Quaternion [x y z w]
  (Quaternion. x y z w))

;; rotate

(defn point-pivot ^Vector3 [^Vector3 pt, ^Vector3 pv, ang]
  (let [angq (cond 
               (instance? Quaternion ang) ang
               (instance? Vector3 ang)    (qe ang)
               :else (throw
                       (ArgumentException.
                         (str "Expect rotation as Quaternion or Vector3, got "
                           (type ang)))))]
    (v+ (q* angq (v- pt pv)) pv)))

;; stuff

(defn spcscl* [spec mod]
  (update-in-mv spec [:transform :local-scale]
    #(v* % mod)))

(defn spcpos+ [spec mod]
  (update-in-mv spec [:transform :local-position]
    #(v+ % mod)))

(defn spcrot* [spec mod]
  (update-in-mv spec [:transform :local-rotation]
    #(q* % mod)))

(defn range-by
  ([n] (for [i (range)] (* i n)))
  ([n mx] (for [i (range mx)] (* i n))))

;; scene

(defscn pointer
  (let [cubespec   (kill! (create-primitive :cube))
        spherespec (kill! (create-primitive :sphere))
        rect  (deep-merge-mv cubespec
                {:transform [{:local-scale [1 4 1]}]})
        sphr  (deep-merge-mv spherespec
                {:transform [{:local-position [0 2 0]
                              :local-scale    [1 3 2]}]})]
    (hydrate
      {:name "pointer"
       :children [rect sphr]
       :transform [{:local-scale [1.5 1.5 1.5]}]})))

(defscn pointer-trns
  (let [trns   (v3 0 0 15)
        pspec  (-> (dehydrate pointer)
                 (spcpos+ trns)
                 (spcscl* 0.5))
        ticks  10
        pivpt  (v3 0 0 0)
        pntrs  (for [deg (range-by (/ 360 ticks) ticks)
                     :let [pivrot (v3 (- deg) 0 0)]]
                 (-> pspec
                   (update-in-mv [:transform :local-position]
                     #(point-pivot % pivpt pivrot))
                   (spcrot* (qe pivrot))))]
    (hydrate
      {:name "pointer-trns"
       :children (vec pntrs)})))

(defscn pointer-trns-2
  (let [ticks  20
        trns   (v3 0 0 22)
        pspec  (-> (dehydrate pointer)
                 (spcpos+ trns)
                 (spcscl* 0.2))
        degs   (range-by (/ 360 ticks) ticks)
        pivpt  (v3 0 0 0)
        pntrs  (for [deg1 degs
                     deg2 (take (/ ticks 2) degs)
                     :let [pivrot (v3 (- deg1) (- deg2) 0)]]
                 (-> pspec
                   (update-in-mv [:transform :local-position]
                     #(point-pivot % pivpt pivrot))
                   (spcrot* (qe pivrot))))]
    (hydrate
      {:name "pointer-trns-2"
       :children (vec pntrs)})))