From 3b4171c7161ce01739b4bfa0dd954e702d78ee3c Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Tue, 15 Oct 2013 19:03:31 +0530 Subject: [PATCH] Added a gravity control slider --- resources/public/index.html | 25 +++++++++++++++++++----- src/cljs/frpong/core.cljs | 37 ++++++++++++++++++++---------------- src/cljs/frpong/helpers.cljs | 19 +++++++++++------- 3 files changed, 53 insertions(+), 28 deletions(-) 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!

- press <space> to start + Gravity + + - Source + press <space> to start
@@ -44,9 +54,14 @@ body {
-
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
+
+ Source +
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)