Added a gravity control slider

Abhinav Sarkar 10 years ago
parent c84788aa43
commit 3b4171c716
  1. 25
  2. 37
  3. 19

@ -2,7 +2,7 @@
<html lang="en">
<meta charset="utf-8">
<title>Functional Reactive Pong in Clojure using core.async</title>
<title>Gravity Pong: Functional Reactive Programming in Clojure using core.async</title>
<!--[if lt IE 9]>
<script src=""></script>
@ -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 {
<div id="screen">
<h2 id="title">Gravity Pong!</h2>
<span id="state">press &lt;space&gt; to start</span>
<span style="float: left; vertical-align: top;">Gravity
<input id="gravity" type="range" min="1" max="10" value="1" step="1" />
<span style="float: right; font-size: small">
<a target="_blank" href="">Source</a>
<span id="state">press &lt;space&gt; to start</span>
<svg id="canvas">
@ -44,9 +54,14 @@ body {
<rect id="rpaddle" />
<div style="float: left">score <span id="score">0</span></div>
<div style="float: left">
score <span id="score">0</span>
fps <span id="fps">0</span>
use W-S keys to move the left paddle and Up-Down arrow keys to move the right paddle
<div style="float: right"><span id="fps">0</span> fps</div>
<div style="float: right">
<a target="_blank" href="">Source</a>

@ -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]]
[ :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 (<! ticks)))
[x y] (<! pos)
[lpaddle-y rpaddle-y] (<! pd-pos)
[state score] (<! game-state)
state-text (condp = state
:moving "Playing"
:collision "Playing"
:gameover "Game Over")]
[state score] (<! game-state)]
(doto ball-el
(dom/set-attr! "cx" x)
(dom/set-attr! "cy" y))
@ -317,14 +323,13 @@
(dom/set-attr! rpaddle-el "y" rpaddle-y)
(when-not (= fps fps-p)
(dom/set-text! fps-el fps))
(when-not (= state state-p)
(dom/set-text! state-el state-text))
(when-not (= score score-p)
(dom/set-text! score-el score))
(when (= state :gameover)
(do (dom/set-text! state-el "press <space> to restart")
(do (dom/set-style! ball-el "fill" "red")
(dom/set-text! state-el "press <space> to restart")
(recur fps state-text score))))))
(recur fps score))))))
;; Everything is ready now. Layout the game and start it on pressing <space>!
(defn ^:export frpong []

@ -126,15 +126,20 @@
(recur v))))
(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
(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)