Added a gravity control slider
parent
c84788aa43
commit
3b4171c716
|
@ -2,7 +2,7 @@
|
|||
<html lang="en">
|
||||
<head>
|
||||
<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="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
|
||||
<![endif]-->
|
||||
|
@ -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 {
|
|||
<body>
|
||||
<center>
|
||||
<div id="screen">
|
||||
<h2 id="title">Gravity Pong!</h2>
|
||||
<div>
|
||||
<span id="state">press <space> 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">
|
||||
<a target="_blank" href="https://github.com/abhin4v/frpong">Source</a>
|
||||
<span id="state">press <space> to start</span>
|
||||
</span>
|
||||
</div>
|
||||
<svg id="canvas">
|
||||
|
@ -44,9 +54,14 @@ body {
|
|||
<rect id="rpaddle" />
|
||||
</svg>
|
||||
<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
|
||||
<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>
|
||||
</center>
|
||||
|
|
|
@ -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 (<! 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")
|
||||
(start-on-space)))
|
||||
(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))))
|
||||
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)
|
||||
|
|
Loading…
Reference in New Issue