abhin4v
/
frpong
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added a gravity control slider

master
Abhinav Sarkar 2013-10-15 19:03:31 +05:30
parent c84788aa43
commit 3b4171c716
3 changed files with 53 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
resources/public/index.html
View File

@ -2,7 +2,7 @@
<html lang="en"> <html lang="en">
<head> <head>
<meta charset="utf-8"> <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]> <!--[if lt IE 9]>
<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script> <script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
<![endif]--> <![endif]-->
@ -11,6 +11,13 @@ body {
font-family: monospace; font-family: monospace;
} }
#title {
margin: 0px;
position: absolute;
width: 98%;
z-index: -1;
}
#ball { #ball {
fill: orange; fill: orange;
} }
@ -32,10 +39,13 @@ body {
<body> <body>
<center> <center>
<div id="screen"> <div id="screen">
<h2 id="title">Gravity Pong!</h2>
<div> <div>
<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>
<span style="float: right; font-size: small"> <span style="float: right; font-size: small">
<a target="_blank" href="https://github.com/abhin4v/frpong">Source</a> <span id="state">press &lt;space&gt; to start</span>
</span> </span>
</div> </div>
<svg id="canvas"> <svg id="canvas">
@ -44,9 +54,14 @@ body {
<rect id="rpaddle" /> <rect id="rpaddle" />
</svg> </svg>
<div> <div>
<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>
</div>
use W-S keys to move the left paddle and Up-Down arrow keys to move the right paddle 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="https://github.com/abhin4v/frpong">Source</a>
</div>
</div> </div>
</div> </div>
</center> </center>

37
src/cljs/frpong/core.cljs
View File

@ -1,5 +1,5 @@
(ns frpong.core (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]] [cljs.core.async :refer [<! >! chan put! close! sliding-buffer]]
[domina :as dom :refer [log]] [domina :as dom :refer [log]]
[domina.events :as ev]) [domina.events :as ev])
@ -52,13 +52,13 @@
;; Global settings ;; Global settings
(def *width* (- (.-scrollWidth (.-body js/document)) 20)) (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 *center* [(/ *width* 2 ) (/ *height* 2)])
(def *padding* 5) (def *padding* 5)
(def *paddle-size* 100) (def *paddle-size* 100)
(def *ball-radius* 8) (def *ball-radius* 8)
(def *ball-speed* 0.5) (def *ball-speed* 0.6)
(def *init-vel-deg-lim* [35 55]) (def *init-vel-deg-lim* [35 55])
(def *perturb-factor* 0.02) (def *perturb-factor* 0.02)
@ -68,7 +68,13 @@
(def *ef-paddle-width* (+ *paddle-width* *padding*)) (def *ef-paddle-width* (+ *paddle-width* *padding*))
(def *init-paddle-pos* (/ (- *height* *paddle-size*) 2)) (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 (defn layout-game
"Lays out the game screen." "Lays out the game screen."
@ -111,6 +117,7 @@
pd-pos (chan 1) ;; paddles position signal pd-pos (chan 1) ;; paddles position signal
game-state (chan 1) ;; game state signal, the state of the game and the current score game-state (chan 1) ;; game state signal, the state of the game and the current score
init-vel (initial-velocity)] init-vel (initial-velocity)]
(log "Starting game")
(setup-components frames keydowns keyups game-state pos vel acc pd-pos) (setup-components frames keydowns keyups game-state pos vel acc pd-pos)
;; start the game by setting the initial values of the signals ;; 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 "Calculates acceleration due to gravitation for the ball caused by a unit mass placed at the
center of the board." center of the board."
[[x y]] [[x y]]
(let [[cx cy] *center* (let [grav (deref *gravity*)
[cx cy] *center*
x-dist (- cx x) x-dist (- cx x)
y-dist (- cy y) y-dist (- cy y)
distance (sqrt (+ (sq x-dist) (sq y-dist))) distance (sqrt (+ (sq x-dist) (sq y-dist)))
bearing [(/ x-dist distance) (/ y-dist distance)]] bearing [(/ x-dist distance) (/ y-dist distance)]]
(if-not (= distance 0) (if-not (= distance 0)
(map #(* *G* % (/ 1 distance)) bearing) (map #(* grav % (/ 1 distance)) bearing)
[0 0]))) [0 0])))
(defn gravitation (defn gravitation
@ -301,15 +309,13 @@
lpaddle-el (dom/by-id "lpaddle") lpaddle-el (dom/by-id "lpaddle")
rpaddle-el (dom/by-id "rpaddle") rpaddle-el (dom/by-id "rpaddle")
fps-el (dom/by-id "fps")] 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))) (let [fps (int (/ 1000 (<! ticks)))
[x y] (<! pos) [x y] (<! pos)
[lpaddle-y rpaddle-y] (<! pd-pos) [lpaddle-y rpaddle-y] (<! pd-pos)
[state score] (<! game-state) [state score] (<! game-state)]
state-text (condp = state
:moving "Playing"
:collision "Playing"
:gameover "Game Over")]
(doto ball-el (doto ball-el
(dom/set-attr! "cx" x) (dom/set-attr! "cx" x)
(dom/set-attr! "cy" y)) (dom/set-attr! "cy" y))
@ -317,14 +323,13 @@
(dom/set-attr! rpaddle-el "y" rpaddle-y) (dom/set-attr! rpaddle-el "y" rpaddle-y)
(when-not (= fps fps-p) (when-not (= fps fps-p)
(dom/set-text! fps-el fps)) (dom/set-text! fps-el fps))
(when-not (= state state-p)
(dom/set-text! state-el state-text))
(when-not (= score score-p) (when-not (= score score-p)
(dom/set-text! score-el score)) (dom/set-text! score-el score))
(when (= state :gameover) (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")
(start-on-space))) (start-on-space)))
(recur fps state-text score)))))) (recur fps score))))))
;; Everything is ready now. Layout the game and start it on pressing <space>! ;; Everything is ready now. Layout the game and start it on pressing <space>!
(defn ^:export frpong [] (defn ^:export frpong []

19
src/cljs/frpong/helpers.cljs
View File

@ -126,15 +126,20 @@
(recur v)))) (recur v))))
c)) c))
(defn event-chan [event-type] (defn event-chan
(let [c (chan)] ([event-type]
(ev/listen! event-type #(put! c %)) (let [c (chan)]
[c #(do (ev/unlisten! event-type) (close! c))])) (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] (defn key-chan [keydowns keyups sampler keycodes]
(let [c (chan) (let [c (chan)
ops {keydowns conj ops { keydowns conj
keyups disj}] keyups disj }]
(go (loop [keys #{}] (go (loop [keys #{}]
(let [[v ch] (alts! [keydowns keyups sampler] :priority true)] (let [[v ch] (alts! [keydowns keyups sampler] :priority true)]
(if-not (nil? v) (if-not (nil? v)