Big Changes

The entire game was almost completely rewritten. Added fast traces, missile's fragments and more. Unfortunately, the tests became incorrect, so I deleted them. I'm going to write new tests as soon as I can.

Author: rexim

src/hyperspace/game.clj

@@ -1,64 +1,129 @@
-(ns hyperspace.game
-  (:use (hyperspace geometry
-                    gravity
-                    world)))
-
-(defn get-player
-  [world name]
-  (first (filter #(= name (:name %)) (:players world))))
-
-(defn update-player-params
-  [world name heading power]
-  (assoc world
-    :players (map (fn [player]
-                    (if (= (:name player) name)
-                      (assoc player
-                        :heading heading
-                        :power power)
-                      player))
-                  (:players world))))
-
-(defn fire
-  [world player-name]
-  (let [player (get-player world player-name)
-        {point :center
-         power :power
-         angle :heading} player
-        bullet (make-bullet point (make-vector-radial power angle))]
-    (assoc world
-      :bullets (conj (:bullets world) bullet))))
-
-(defn destroy-bullet?
-  [bullet planets]
-  (let [bullet-center (:center bullet)]
-    (some (fn [{planet-radius :radius
-                planet-center :center}]
-            (<= (point-distance bullet-center
-                                planet-center)
-                planet-radius))
-          planets)))
-
-(defn update-bullet
-  [bullet planets]
-  (if (= (:status bullet) :dead)
-    bullet
-    (let [acceleration (get-acceleration bullet planets)
-          {position :center
-           velocity :velocity
-           traces :traces} bullet]
-      (assoc bullet
-        :center   (move-point position velocity)
-        :velocity (vector-sum velocity acceleration)
-        :status   (if (destroy-bullet? bullet planets) :dead :alive)
-        :traces   (conj traces position)))))
-
-(defn update-world
-  "Simulates few steps for world. Returns new world and remaining time."
-  [world time]
-  (let [{bullets :bullets
-         planets :planets} world]
-    (if (< time 1)
-      [world time]
-      (recur (assoc world
-               :bullets (doall (map #(update-bullet % planets) bullets)))
-             (- time 1)))))
+(ns hyperspace.game
+  (:use [hyperspace world geometry gravity misc]))
+
+(defn turn-right
+  [{[player & _] :players
+    :as world}
+   delta-angle]
+  (let [{[angle, _] :heading} player]
+    (assoc-in world
+              [:players 0 :heading 0]
+              (- angle delta-angle))))
+
+(defn turn-left
+  [{[player & _] :players
+    :as world}
+   delta-angle]
+  (let [{[angle, _] :heading} player]
+    (assoc-in world
+              [:players 0 :heading 0]
+              (+ angle delta-angle))))
+
+(defn increase-power
+  [world delta-power]
+  (let [power (get-in world [:players 0 :heading 1])]
+    (assoc-in world
+              [:players 0 :heading 1]
+              (saturation (+ power delta-power)
+                          1 10))))
+
+(defn decrease-power
+  [world delta-power]
+  (let [power (get-in world [:players 0 :heading 1])]
+    (assoc-in world
+              [:players 0 :heading 1]
+              (saturation (- power delta-power)
+                          1 10))))
+
+(defn fire
+  [{[player & _] :players
+    :as world}]
+  (let [{position               :position
+         [_, power :as heading] :heading} player
+         missile-position (-> (polar->cartesian heading)
+                              normilize-vector
+                              (multiply-by-scalar (+ player-radius
+                                                     missile-radius))
+                              (vector-sum position))
+         missile-velocity (-> (polar->cartesian heading)
+                              normilize-vector
+                              (multiply-by-scalar (* power 100)))]
+    (add-missile world
+                 missile-position
+                 missile-velocity)))
+
+(defn update-particle
+  [{position :position
+    velocity :velocity
+    :as particle}
+   planets
+   delta-time]
+  (let [acceleration (apply vector-sum
+                            (map #(gravity-acceleration particle %)
+                                 planets))
+        ;; FIXME: Duplicate code
+        new-velocity (-> acceleration
+                         (multiply-by-scalar (* delta-time 1e-3))
+                         (vector-sum velocity))
+        new-position (-> new-velocity
+                         (multiply-by-scalar (* delta-time 1e-3))
+                         (vector-sum position))]
+    (assoc particle
+      :position new-position
+      :velocity new-velocity)))
+
+(defn update-traces
+  [traces
+   {position :position
+    trace-index :trace-index}]
+  (update-in traces [trace-index] conj position))
+
+(defn break-particle
+  [{particle-position :position
+    particle-radius   :radius
+    velocity          :velocity
+    radius            :radius
+    :as particle}
+   planets]
+  (let [planet (some #(when (circle-X-circle? % particle) %) planets)]
+    (if (and planet (> radius 1.0))
+      (let [{planet-position   :position
+             planet-radius     :radius} planet
+
+             fragments-position (-> (vector-subtract particle-position planet-position)
+                                    normilize-vector
+                                    (multiply-by-scalar (+ particle-radius planet-radius 5))
+                                    (vector-sum planet-position))]
+        (repeatedly 5
+                    (fn []
+                      (make-fragment fragments-position
+                                     (polar->cartesian [(rand (* 2 Math/PI)),
+                                                        (/ (vector-length velocity) 2)])
+                                     (- radius 2)))))
+      ())))
+
+(defn update-world
+  [{missiles :missiles
+    planets :planets
+    fragments :fragments
+    traces :traces
+    :as world}
+   delta-time]
+  (let [broken-particles (mapcat #(break-particle % planets)
+                                 (concat missiles fragments))
+        ;; FIXME: Duplicate code
+        new-missiles (->> missiles
+                          (filter #(circle-X-rectangle? % world))
+                          (remove #(circle-X-any-circle? % planets))
+                          (map #(update-particle % planets delta-time)))
+        new-fragments (->> fragments
+                           (concat broken-particles)
+                           (filter #(circle-X-rectangle? % world))
+                           (remove #(circle-X-any-circle? % planets))
+                           (map #(update-particle % planets delta-time)))
+
+        new-traces  (reduce update-traces traces new-missiles)]
+    (assoc world
+      :missiles new-missiles
+      :fragments new-fragments
+      :traces new-traces)))

src/hyperspace/geometry.clj

@@ -1,51 +1,65 @@
-(ns hyperspace.geometry)
-
-(defrecord Point2 [x y])
-(defrecord Vector2 [x y])
-
-(def make-point ->Point2)
-(def make-vector ->Vector2)
-
-(defn make-vector-radial
-  [length angle]
-  (let [x (* length (Math/cos angle))
-        y (* length (Math/sin angle))]
-    (make-vector x y)))
-
-(defn move-point
-  [point vector]
-  (let [new-x (+ (:x point) (:x vector))
-        new-y (+ (:y point) (:y vector))]
-    (make-point new-x new-y)))
-
-(defn point-distance
-  [p1 p2]
-  (let [x1 (:x p1)
-        x2 (:x p2)
-        y1 (:y p1)
-        y2 (:y p2)]
-    (Math/sqrt (+ (Math/pow (- x2 x1) 2)
-                  (Math/pow (- y2 y1) 2)))))
-
-(defn vector-sum
-  [v1 v2]
-  (let [new-x (+ (:x v1) (:x v2))
-        new-y (+ (:y v1) (:y v2))]
-    (make-vector new-x new-y)))
-
-(defn vector-length
-  [v]
-  (Math/sqrt (+ (Math/pow (:x v) 2)
-                (Math/pow (:y v) 2))))
-
-(defn vector-bearing
-  [v]
-  (Math/atan2 (:y v) (:x v)))
-
-(defn bearing-to
-  [p1 p2]
-  (let [x1 (:x p1)
-        x2 (:x p2)
-        y1 (:y p1)
-        y2 (:y p2)]
-    (Math/atan2 (- y2 y1) (- x2 x1))))
+(ns hyperspace.geometry)
+
+(def
+  ^{:arglists '([vtr & vtrs])
+    :doc "Returns the sum of vectors. The result vector has a minimum
+  possible dimension."}
+  vector-sum (partial mapv +))
+
+(def
+  ^{:arglists '([vtr & vtrs])
+    :doc "If no vtrs are supplied, returns the negation of vtr, else
+  subtracts the vtrs from vtr and returns the result. The result
+  vector has a minimum possible dimension."}
+  vector-subtract
+  (partial mapv -))
+
+(defn multiply-by-scalar
+  "Returns the multiplication of vtr and scalar."
+  [vtr scalar]
+  (mapv #(* scalar %) vtr))
+
+(defn vector-length
+  "Returns the length of vtr."
+  [vtr]
+  (Math/sqrt (reduce #(+ %1 (* %2 %2)) 0.0 vtr)))
+
+(defn normilize-vector
+  [vtr]
+  (let [length (vector-length vtr)]
+    (mapv #(/ % length) vtr)))
+
+(defn distance
+  "Returns the distance between p1 and p2."
+  [p1 p2]
+  (vector-length (vector-subtract p1 p2)))
+
+(defn polar->cartesian
+  "Converts polar coordinates to the cartesian ones."
+  [[a, d]]
+  [(* d (Math/cos a))
+   (* d (Math/sin a))])
+
+(defn cartesian->polar
+  "Converts cartesian cooradinates to the polar ones."
+  [[x, y]]
+  [(Math/atan2 y x)
+   (Math/sqrt (+ (* x x) (* y y)))])
+
+(defn circle-X-circle?
+  "Does the first circle intersects the second one?"
+  [{position1 :position radius1 :radius}
+   {position2 :position radius2 :radius}]
+  (<= (distance position1 position2)
+      (+ radius1 radius2)))
+
+(defn circle-X-any-circle?
+  [circle other-circles]
+  (some #(circle-X-circle? % circle) other-circles))
+
+(defn circle-X-rectangle?
+  "Does the circle intersects the rectangle?"
+  [{[cx, cy] :position radius :radius}
+   {[rx, ry] :position [width, height] :size}]
+  (and (<= (- rx radius) cx (+ rx width radius))
+       (<= (- ry radius) cy (+ ry height radius))))

src/hyperspace/gravity.clj

@@ -1,26 +1,16 @@
-(ns hyperspace.gravity
-  (:use (hyperspace geometry)))
-
-(def gravity-constant 6.6725e-11)
-(def bullet-mass 1)
-
-(defn gravity-force
-  [m1 m2 distance]
-  (/ (* gravity-constant m1 m2) (Math/pow distance 2)))
-
-(defn planet-gravity-force
-  [planet bullet]
-  (let [planet-center (:center planet)
-        bullet-center (:center bullet)
-        planet-mass (:mass planet)
-        distance (point-distance planet-center bullet-center)
-        force (gravity-force planet-mass bullet-mass distance)
-        acceleration (/ force bullet-mass)
-        angle (bearing-to bullet-center planet-center)]
-    (make-vector-radial acceleration angle)))
-
-(defn get-acceleration
-  [bullet planets]
-  (reduce #(vector-sum %1 (planet-gravity-force %2 bullet))
-          (make-vector 0 0)
-          planets))
+(ns hyperspace.gravity
+  (:use [hyperspace geometry]))
+
+(def gravity-constant 0.1;6.6725e-11
+  )
+
+(defn gravity-acceleration
+  [{position1 :position mass1 :mass}
+   {position2 :position mass2 :mass}]
+  (let [d (distance position1 position2)
+        force (/ (* gravity-constant mass1 mass2)
+                 (* d d))
+        acceleration (/ force mass1)]
+    (-> (vector-subtract position2 position1)
+        normilize-vector
+        (multiply-by-scalar acceleration))))

src/hyperspace/main.clj

@@ -1,8 +1,7 @@
-(ns hyperspace.main
-  (:use (hyperspace ui
-                    world)))
-
-(defn -main
-  [& args]
-  (let [world (generate-world)]
-    (start-ui world)))
+(ns hyperspace.main
+  (:use [hyperspace game geometry ui world]
+        [clojure.pprint :only (pprint)]))
+
+(defn -main
+  [& args]
+  (start-ui (generate-world 800 600)))

src/hyperspace/misc.clj

@@ -4,3 +4,10 @@
   "Returns a random integer between low (inclusive) and high (inclusive)"
   [low high]
   (+ low (rand-int (+ 1 (- high low)))))
+
+(defn saturation
+  [value low high]
+  (cond
+    (< value low) low
+    (< high value) high
+    :else value))