diff --git a/resources/public/index.html b/resources/public/index.html
index 8a2780e..cbef49c 100644
--- a/resources/public/index.html
+++ b/resources/public/index.html
@@ -2,7 +2,7 @@
- Functional Reactive Pong in Clojure using core.async
+ Gravity Pong: Functional Reactive Programming in Clojure using core.async
@@ -11,6 +11,13 @@ body {
font-family: monospace;
}
+#title {
+ margin: 0px;
+ position: absolute;
+ width: 98%;
+ z-index: -1;
+}
+
#ball {
fill: orange;
}
@@ -32,10 +39,13 @@ body {
+
Gravity Pong!
-
score 0
+
+ score 0
+ fps 0
+
use W-S keys to move the left paddle and Up-Down arrow keys to move the right paddle
-
0 fps
+
diff --git a/src/cljs/frpong/core.cljs b/src/cljs/frpong/core.cljs
index 84e3f3a..ba831df 100644
--- a/src/cljs/frpong/core.cljs
+++ b/src/cljs/frpong/core.cljs
@@ -1,5 +1,5 @@
(ns frpong.core
- (:require [frpong.helpers :refer (mult tap diff-chan key-chan frame-chan event-chan)]
+ (:require [frpong.helpers :refer (mult tap map-chan diff-chan key-chan frame-chan event-chan sustain)]
[cljs.core.async :refer [! chan put! close! sliding-buffer]]
[domina :as dom :refer [log]]
[domina.events :as ev])
@@ -52,13 +52,13 @@
;; Global settings
(def *width* (- (.-scrollWidth (.-body js/document)) 20))
-(def *height* (- (.-scrollHeight (.-body js/document)) 125))
+(def *height* (- (.-scrollHeight (.-body js/document)) 130))
(def *center* [(/ *width* 2 ) (/ *height* 2)])
(def *padding* 5)
(def *paddle-size* 100)
(def *ball-radius* 8)
-(def *ball-speed* 0.5)
+(def *ball-speed* 0.6)
(def *init-vel-deg-lim* [35 55])
(def *perturb-factor* 0.02)
@@ -68,7 +68,13 @@
(def *ef-paddle-width* (+ *paddle-width* *padding*))
(def *init-paddle-pos* (/ (- *height* *paddle-size*) 2))
-(def *G* 0.01)
+(def *gravity* (atom 0.01))
+
+;; listen for changes in the gravity input slider and set the atom value accordingly
+(ev/listen! (dom/by-id "gravity") :change
+ #(let [val (* (int (dom/value (dom/by-id "gravity"))) 0.005)]
+ (reset! *gravity* val)
+ (.blur (dom/by-id "gravity"))))
(defn layout-game
"Lays out the game screen."
@@ -111,6 +117,7 @@
pd-pos (chan 1) ;; paddles position signal
game-state (chan 1) ;; game state signal, the state of the game and the current score
init-vel (initial-velocity)]
+ (log "Starting game")
(setup-components frames keydowns keyups game-state pos vel acc pd-pos)
;; start the game by setting the initial values of the signals
@@ -173,13 +180,14 @@
"Calculates acceleration due to gravitation for the ball caused by a unit mass placed at the
center of the board."
[[x y]]
- (let [[cx cy] *center*
+ (let [grav (deref *gravity*)
+ [cx cy] *center*
x-dist (- cx x)
y-dist (- cy y)
distance (sqrt (+ (sq x-dist) (sq y-dist)))
bearing [(/ x-dist distance) (/ y-dist distance)]]
(if-not (= distance 0)
- (map #(* *G* % (/ 1 distance)) bearing)
+ (map #(* grav % (/ 1 distance)) bearing)
[0 0])))
(defn gravitation
@@ -301,15 +309,13 @@
lpaddle-el (dom/by-id "lpaddle")
rpaddle-el (dom/by-id "rpaddle")
fps-el (dom/by-id "fps")]
- (go (loop [fps-p nil state-p nil score-p nil]
+ (dom/set-style! ball-el "fill" "orange")
+ (dom/set-text! state-el "")
+ (go (loop [fps-p nil score-p nil]
(let [fps (int (/ 1000 ( to restart")
+ (do (dom/set-style! ball-el "fill" "red")
+ (dom/set-text! state-el "press to restart")
(start-on-space)))
- (recur fps state-text score))))))
+ (recur fps score))))))
;; Everything is ready now. Layout the game and start it on pressing !
(defn ^:export frpong []
diff --git a/src/cljs/frpong/helpers.cljs b/src/cljs/frpong/helpers.cljs
index dc5e7e2..2e018e0 100644
--- a/src/cljs/frpong/helpers.cljs
+++ b/src/cljs/frpong/helpers.cljs
@@ -126,15 +126,20 @@
(recur v))))
c))
-(defn event-chan [event-type]
- (let [c (chan)]
- (ev/listen! event-type #(put! c %))
- [c #(do (ev/unlisten! event-type) (close! c))]))
+(defn event-chan
+ ([event-type]
+ (let [c (chan)]
+ (ev/listen! ev/root-element event-type #(put! c %))
+ [c #(do (ev/unlisten! ev/root-element event-type) (close! c))]))
+ ([node event-type]
+ (let [c (chan)]
+ (ev/listen! node event-type #(put! c %))
+ [c #(do (ev/unlisten! node event-type) (close! c))])))
(defn key-chan [keydowns keyups sampler keycodes]
- (let [c (chan)
- ops {keydowns conj
- keyups disj}]
+ (let [c (chan)
+ ops { keydowns conj
+ keyups disj }]
(go (loop [keys #{}]
(let [[v ch] (alts! [keydowns keyups sampler] :priority true)]
(if-not (nil? v)