rough sketch of reactive svg rendering

core.cljs

(ns savage.core
  (:require-macros [reagent.ratom :refer [reaction]])
  (:require [reagent.core :as reagent :refer [cursor atom track track!]]
            [reagent.ratom :refer [make-reaction]]
            [clojure.set :as set]
            [clojure.string :as string]))

(enable-console-print!)

(defn sqrt [x] (.sqrt js/Math x))
(defn cos [x] (.cos js/Math x))
(defn sin [x] (.sin js/Math x))

;; time
(def timestamp (atom 0))
(def delta (atom 0))
(def deltas (reaction (min (/ @delta 1000) 1)))

(def pressed-keys (atom #{}))
(def mouse (atom {:x 0 :y 0}))

;; keys
(defn extract-keys [obj keys]
  (->> keys
       (mapcat (fn [k] [(keyword k)
                        (aget obj k)]))
       (apply hash-map)))

(set! (.-onmousemove js/document) 
      (fn [e]
        (.preventDefault e)
        (reset! mouse {:x (.-x e) :y (.-y e)})))

(let [event-keys ["altKey" "ctrlKey" "metaKey" "shiftKey" "keyIdentifier" "keyCode"]]
  (set! (.-onkeydown js/document) 
        (fn [e]
          (.preventDefault e)
          (if (and (>= (.-keyCode e) 32)
                   (not= (.-keyCode e) 91)
                   )
            (swap! pressed-keys conj
                   (extract-keys e event-keys)))))
  (set! (.-onkeyup js/document)
        (fn [e]
          (.preventDefault e)
          (swap! pressed-keys disj
                 (extract-keys e event-keys)))))
  

;; shapes
(defn circle
  ([spec] [:circle spec])
  ([x y r] (circle {:cx x :cy y :r r})))

(defn text [x y s]
  [:text {:x x :y y} (str s)])

(defn point [p]
  (let [x (or (get p :x)
              (get p 0)
              (throw (str "No x coordinate in " p)))
        y (or (get p :y)
              (get p 1)
              (throw (str "No x coordinate in " p)))]
    {:x x :y y}))

(defn line [[from to]]
  [:line {:x1 (:x (point from)) :y1 (:y (point from))
          :x2 (:x (point to)) :y2 (:y (point to))
          :shapeRendering "crispEdges"}])

(defn polyline [ps]
  (let [ps (->> (if (number? (first ps))
                  (->> ps
                       (partition 2 2)
                       (map vec))
                  ps)
                (map point)
                (map #(str (:x %) "," (:y %) " "))
                (apply str))]
    [:polyline {:points ps}])
  )



;; game

(def dummy-g [:g])

(defn debug [{:keys [x y a r id] :as data}]
  ^{:key id}
  [:g {:id (str "debug" id)
       :transform (str "translate(" x " " y ") rotate(" (mod (+ 90 (* (/ 180 3.1415) a))
                                                             360) ")")}
   [:path {:d (str "M-1 0 L1 0 M0 -1 L0 1 M0 -1 L0.5 -0.5 M0 -1 L-0.5 -0.5" 
                    ; " M0 " r " A " r " " r " 0 0 0 0 -" r "A " r " " r " 0 0 0 0 " r
                    )}]
   ; [line [[-1 0] [1 0]]]
   ; [line [[0 -1] [0 1]]]
   ; [line [[0 -1] [0.5 -0.5]]]
   ; [line [[0 -1] [-0.5 -0.5]]]
   ; [circle 0 0 r]
   ]
  )

(defn debug-all [ss]
  [:g {:style #js {:stroke "rgb(0,255,0)"
                   :fill "none"
                   :strokeWidth 0.1}}
   (doall (map debug ss))
   ])

(defn ship [{:keys [x y a colliding?] :as data}]
  [:g
   ; [debug data]
   [:g
    {:transform (str "translate(" x " " y ") rotate(" (mod (+ 90 (* (/ 180 3.1415) a))
                                                                     360) ")")
     :style #js {:stroke (if colliding? "none" "white")
                 :fill (if colliding? "red" "none")
                 :strokeWidth 0.1}}
    [polyline [0 -1 -1 1 0 0.5 1 1 0 -1]]
    ]])

(defn move-player [{:keys [x y a] :as p}]
  (if (some #(= "Up" (:keyIdentifier %)) @pressed-keys)
    (let [x* (+ x (* 20 @deltas (cos a)))
          y* (+ y (* 20 @deltas (sin a)))]
      (-> p
          (assoc :x x* :y y*)))
    p))

(defn rotate-player [p]
  (cond
    (some #(= "Left" (:keyIdentifier %)) @pressed-keys)
    (update p :a #(- % (* 10 @deltas)))
    (some #(= "Right" (:keyIdentifier %)) @pressed-keys)
    (update p :a #(+ % (* 10 @deltas)))
    :else p))

(defn player-physics [{:keys [x y a inertia] :as p}]
  (if-not (some #(= "Up" (:keyIdentifier %)) @pressed-keys)
    (let [x* (+ x (* inertia @deltas (cos a)))
          y* (+ y (* inertia @deltas (sin a)))
          inertia* (* inertia 0.95)]
      (assoc p :x x* :y y* :inertia inertia*))
    (assoc p :inertia 20)
    ))

(defn update-player [s]
  (let [player* (-> (:player s)
                    move-player
                    rotate-player
                    player-physics
                    )]
    (assoc s :player player*)))

(defn update-rock [{:keys [x y a colliding?] :as r}]
  (let [speed (if colliding?
                0.1
                1)
        x* (+ x (* 10 @deltas speed (cos a)))
        y* (+ y (* 10 @deltas speed (sin a)))]
    (assoc r :x x* :y y* :a (+ a (* 1 @deltas)))))

(defn update-rocks [s]
  (let [rocks* (->> (:rocks s)
                    (map update-rock))]
    (assoc s :rocks rocks*)))

(defn touching? [{x1 :x y1 :y r1 :r}
                 {x2 :x y2 :y r2 :r}]
  (let [d (+ r1 r2)]
    (<= (sqrt (+ (* (- x1 x2) (- x1 x2))
                 (* (- y1 y2) (- y1 y2))))
        d)))

(defn detect-collisions [{:keys [player rocks] :as s}]
  (let [colliding-rocks (map #(if (touching? player %)
                                (assoc % :colliding? true)
                                (assoc % :colliding? false))
                             rocks)
        player (if (pos? (count (filter :colliding? colliding-rocks)))
                 (assoc player :colliding? true)
                 (assoc player :colliding? false))]
    (assoc s :player player :rocks colliding-rocks)))

(defn update-state [s]
  (-> s 
      update-player
      ; update-rocks
      detect-collisions
      ))


(def state
  (atom {:player {:x 10
                  :y 10
                  :a 0
                  :r 1}
         :rocks (for [x (range 30)
                      y (range 30)]
                  {:id (gensym)
                   :x (+ 20 (rand 5) x)
                   :y (+ 20 (rand 5) y)
                   :r (+ 2 (rand))
                   :a (rand)})}))

(def player (cursor state [:player]))
(def rocks (cursor state [:rocks]))

(defn asteroids []
  [:svg {:width "100%" :height "100%"
         :style #js {:background "black"
                     :fill "white"}}
   ; (text 10 10 (some #(= "Left" (:keyIdentifier %)) @pressed-keys))
   ; (text 10 25 @rocks)
   (text 10 40 (str "fps:" (int (/ 1000 @delta))))
   
   [:g {:transform "scale(10)"}
    [ship @player]

    [debug-all @rocks]]])

(defn on-js-reload []
  (println "Reloaded...")
  ; (reset! world/app-state (world/new-world))
  (reagent/render-component
    [asteroids]
    (. js/document (getElementById "app"))))

(on-js-reload)

(defn render-loop [t]
  (reset! delta (- t @timestamp))
  (reset! timestamp t)
  (swap! state update-state)
  (.requestAnimationFrame js/window render-loop))

(defonce animation-frame
  (.requestAnimationFrame
    js/window
    render-loop))