Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

vector/position defrecord ^double

  • Loading branch information...
commit 82d59297dc8c54fccb37b92725f0547def0d6157 1 parent 965bf71
@unclebob authored
View
47 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))
View
24 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)))
View
4 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"
View
2  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))))
View
35 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)))
View
24 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"

0 comments on commit 82d5929

Please sign in to comment.
Something went wrong with that request. Please try again.