vector/position defrecord ^double

unclebob · May 9, 2014 · 82d5929 · 82d5929
1 parent 965bf71
commit 82d5929
Show file tree

Hide file tree

Showing 6 changed files with 59 additions and 77 deletions.
diff --git a/src/orbit/world.clj b/src/orbit/world.clj
@@ -25,17 +25,17 @@
     (Color. 255 215 0)))
 
 (defn to-object-coords [screen-coords mag sun-center]
-  (let [x-offset (- (first center) (* mag (first sun-center)))
-        y-offset (- (last center) (* mag (last sun-center)))
-        x (/ (- (first screen-coords) x-offset) mag)
-        y (/ (- (last screen-coords) y-offset) mag)]
+  (let [x-offset (- (:x center) (* mag (:x sun-center)))
+        y-offset (- (:y center) (* mag (:y sun-center)))
+        x (/ (- (:x screen-coords) x-offset) mag)
+        y (/ (- (:y screen-coords) y-offset) mag)]
     [x y]))
 
 (defn to-screen-coords [object-coords mag sun-center]
-  (let [x-offset (- (first center) (* mag (first sun-center)))
-        y-offset (- (last center) (* mag (last sun-center)))
-        x (+ x-offset (* mag (first object-coords)))
-        y (+ y-offset (* mag (last object-coords)))]
+  (let [x-offset (- (:x center) (* mag (:x sun-center)))
+        y-offset (- (:y center) (* mag (:y sun-center)))
+        x (+ x-offset (* mag (:x object-coords)))
+        y (+ y-offset (* mag (:y object-coords)))]
     [x y]))
 
 (defn draw-object [g obj mag sun-center]
@@ -88,8 +88,8 @@
   (swap! controls-atom assoc :collisions (age-collisions (:collisions @controls-atom))))
 
 (defn prune-history [world-history]
-  (if (> (count world-history) 200)
-    (let [r (rand-int 100)]
+  (if (> (count world-history) 100)
+    (let [r (rand-int 50)]
       (vec (concat (take r world-history) (drop (inc r) world-history))))
     world-history))
 
@@ -196,7 +196,7 @@
 (defn create-world []
   (let [v0 (vector/make)
         sun (object/make center 1500 (vector/make 0 0) v0 "sun")]
-    (loop [world [sun] n 300]
+    (loop [world [sun] n 400]
       (if (zero? n)
         world
         (recur (conj world (random-object sun n)) (dec n))))))
@@ -242,19 +242,18 @@
       (.setVisible true)
       (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE))
     (future
-      (let [begin-time (System/currentTimeMillis)]
-        (while (> 10000 (- (System/currentTimeMillis) begin-time))
-          (let [start-time (System/currentTimeMillis)]
-            (Thread/sleep (* 2 (:delay @controls-atom)))
-            (when (:track-sun @controls-atom)
-              (magnify 1.0 controls-atom world-history-atom))
-            (update-screen world-history-atom controls-atom)
-            (when (not (nil? (:mouseUp @controls-atom)))
-              (handle-mouse world-history-atom controls-atom))
-            (swap! controls-atom assoc :tick-time (- (System/currentTimeMillis) start-time))
-            (swap! controls-atom assoc :tick (inc (:tick @controls-atom)))
-            (.repaint panel)))
-        ))))
+      (while true
+        (let [start-time (System/currentTimeMillis)]
+          (Thread/sleep (* 2 (:delay @controls-atom)))
+          (when (:track-sun @controls-atom)
+            (magnify 1.0 controls-atom world-history-atom))
+          (update-screen world-history-atom controls-atom)
+          (when (not (nil? (:mouseUp @controls-atom)))
+            (handle-mouse world-history-atom controls-atom))
+          (swap! controls-atom assoc :tick-time (- (System/currentTimeMillis) start-time))
+          (swap! controls-atom assoc :tick (inc (:tick @controls-atom)))
+          (.repaint panel)))
+      )))
 
 (defn run-world []
   (world-frame))
diff --git a/src/physics/position.clj b/src/physics/position.clj
@@ -1,19 +1,21 @@
 (ns physics.position)
 
-(defn origin? [p]
-  (every? zero? p))
+(defrecord position [^double x ^double y])
 
 (defn make
-  ([]    [0 0])
-  ([x y] [x y]))
+  ([]    (position. 0 0))
+  ([x y] (position. x y)))
+
+(defn origin? [p]
+  (and (zero? (:x p)) (zero? (:y p))))
 
-(defn add [[x1 y1] [x2 y2]]
-  [(+ x1 x2) (+ y1 y2)])
+(defn add [{x1 :x y1 :y} {x2 :x y2 :y}]
+  (position. (+ x1 x2) (+ y1 y2)))
 
-(defn subtract [[x1 y1] [x2 y2]]
-  [(- x1 x2) (- y1 y2)])
+(defn subtract [{x1 :x y1 :y} {x2 :x y2 :y}]
+  (position. (- x1 x2) (- y1 y2)))
 
-(defn distance [[x1 y1] [x2 y2]]
+(defn distance [{x1 :x y1 :y} {x2 :x y2 :y}]
   (Math/sqrt
    (+
     (Math/pow (- x1 x2) 2)
@@ -22,5 +24,5 @@
 (defn mean [a b]
   (/ (+ a b) 2))
 
-(defn average [[x1 y1] [x2 y2]]
-  (make (mean x1 x2) (mean y1 y2)))
+(defn average [{x1 :x y1 :y} {x2 :x y2 :y}]
+  (position. (mean x1 x2) (mean y1 y2)))
diff --git a/src/physics/position_test.clj b/src/physics/position_test.clj
@@ -7,8 +7,8 @@
   (testing "creation"
     (is (position/origin? (position/make)))
     (is (= (position/make 1 1) (position/make 1 1)))
-    (is (= 1 (first (position/make 1 0))))
-    (is (= 0 (second (position/make 1 0))))
+    (is (== 1 (:x (position/make 1 0))))
+    (is (== 0 (:y (position/make 1 0))))
     )
 
   (testing "addition"

diff --git a/src/physics/test_utilities.clj b/src/physics/test_utilities.clj
@@ -3,4 +3,4 @@
 (defn square [n] (* n n))
 (defn close-to [a b] (< (square(- a b)) 0.0001))
 (defn vector-close-to [a b]
-  (and (close-to (first a) (first b)) (close-to (second a) (second b))))
+  (and (close-to (:x a) (:x b)) (close-to (:y a) (:y b))))
diff --git a/src/physics/vector.clj b/src/physics/vector.clj
@@ -1,38 +1,35 @@
-(ns physics.vector (:refer-clojure :exclude (vector)))
+(ns physics.vector
+  (:refer-clojure :exclude (vector))
+  (:require [physics.position :as position])
+  (:import physics.position.position))
 
-(defn zero_mag? [v]
-  (every? zero? v))
 
 (defn make
-  ([]    [0 0])
-  ([x y] [x y]))
+  ([]    (position. 0 0))
+  ([x y] (position. x y)))
 
-(defn add [v1 v2]
-  (make
-    (+ (first v1) (first v2))
-    (+ (last v1) (last v2))))
+(defn zero_mag? [v]
+  (position/origin? v))
 
-(defn subtract [v1 v2]
-  (make
-   (- (first v1) (first v2))
-   (- (last v1) (last v2))))
+(def add position/add)
+(def subtract position/subtract)
 
 (defn scale [v s]
   (make
-   (* (first v) s)
-   (* (last v) s)))
+   (* (:x v) s)
+   (* (:y v) s)))
 
 (defn magnitude [v]
   (Math/sqrt
    (+
-    (Math/pow (first v) 2)
-    (Math/pow (last v) 2))))
+    (Math/pow (:x v) 2)
+    (Math/pow (:y v) 2))))
 
 (defn unit [v]
   (scale v (/ 1 (magnitude v))))
 
-(defn rotate90 [[x y]]
+(defn rotate90 [{x :x y :y}]
   (make (- y) x))
 
-(defn equal [[x1 y1] [x2 y2]]
+(defn equal [{x1 :x y1 :y} {x2 :x y2 :y}]
   (and (== x1 x2) (== y1 y2)))
diff --git a/src/physics/vector_test.clj b/src/physics/vector_test.clj
@@ -4,27 +4,11 @@
 
 (deftest vector-test
   (testing "vector creation"
-    (is (= 0 (first (vector/make))))
-    (is (= 0 (second (vector/make))))
+    (is (== 0 (:x (vector/make))))
+    (is (== 0 (:y (vector/make))))
     (is (= (vector/make 1 1) (vector/make 1 1)))
-    (is (= 1 (first (vector/make 1 0))))
-    (is (= 0 (second (vector/make 1 0))))
-    )
-
-  (testing "vector addition"
-    (is (vector/equal
-      (vector/make 2 2)
-      (vector/add
-        (vector/make 1 1)
-        (vector/make 1 1))))
-    )
-
-  (testing "vector subtraction"
-    (is (vector/equal
-      (vector/make 1 2)
-      (vector/subtract
-        (vector/make 3 4)
-        (vector/make 2 2))))
+    (is (== 1 (:x (vector/make 1 0))))
+    (is (== 0 (:y (vector/make 1 0))))
     )
 
   (testing "vector scaling"