|
@@ -5,7 +5,7 @@
|
5
|
5
|
(:require-macros [frpong.core :refer (go go-loop rd wt)]))
|
6
|
6
|
|
7
|
7
|
;; * `signal` creates a new signal
|
8
|
|
-;; * `keyboard`, `ticks` and `dom-events` create signals for keydown events, browser animation ticks and
|
|
8
|
+;; * `keyboard`, `ticks` and `dom-events` create signals for keydown events, browser animation ticks and
|
9
|
9
|
;; JS DOM events repectively
|
10
|
10
|
;; * `mult` creates a mult(iple) of a signal which can then be tapped using `tap` to create a copy of the
|
11
|
11
|
;; original signal
|
|
@@ -38,8 +38,8 @@
|
38
|
38
|
;; d: paddle positions | |
|
39
|
39
|
;; s: game state +------------------------------------------------------+
|
40
|
40
|
;;
|
41
|
|
-;; All signals except the signal e are at the rate of the signal b. The signal e is at the rate
|
42
|
|
-;; at which the keyboard issues events. The signal b is at the rate at which the browser supplies
|
|
41
|
+;; All signals except the signal e are at the rate of the signal b. The signal e is at the rate
|
|
42
|
+;; at which the keyboard issues events. The signal b is at the rate at which the browser supplies
|
43
|
43
|
;; animation frames.
|
44
|
44
|
|
45
|
45
|
(defn abs [x] (.abs js/Math x))
|
|
@@ -54,77 +54,77 @@
|
54
|
54
|
(defn sin [x] (.sin js/Math x))
|
55
|
55
|
|
56
|
56
|
;; Global settings
|
57
|
|
-(def *width* (- (.-scrollWidth (.-body js/document)) 20))
|
58
|
|
-(def *height* (- (.-scrollHeight (.-body js/document)) 130))
|
59
|
|
-(def *center* [(/ *width* 2 ) (/ *height* 2)])
|
60
|
|
-(def *padding* 5)
|
61
|
|
-(def *paddle-size* 100)
|
|
57
|
+(def width (- (.-scrollWidth (.-body js/document)) 20))
|
|
58
|
+(def height (- (.-scrollHeight (.-body js/document)) 130))
|
|
59
|
+(def center [(/ width 2 ) (/ height 2)])
|
|
60
|
+(def padding 5)
|
|
61
|
+(def paddle-size 100)
|
62
|
62
|
|
63
|
|
-(def *ball-radius* 8)
|
64
|
|
-(def *ball-speed* 0.6)
|
65
|
|
-(def *init-vel-deg-lim* [35 55])
|
66
|
|
-(def *perturb-factor* 0.05)
|
|
63
|
+(def ball-radius 8)
|
|
64
|
+(def ball-speed 0.6)
|
|
65
|
+(def init-vel-deg-lim [35 55])
|
|
66
|
+(def perturb-factor 0.05)
|
67
|
67
|
|
68
|
|
-(def *init-mass-radius* 0)
|
|
68
|
+(def init-mass-radius 0)
|
69
|
69
|
|
70
|
|
-(def *paddle-width* 10)
|
71
|
|
-(def *paddle-step* 8)
|
72
|
|
-(def *max-paddle-y* (- *height* *paddle-size*))
|
73
|
|
-(def *ef-paddle-width* (+ *paddle-width* *padding*))
|
74
|
|
-(def *init-paddle-pos* (/ (- *height* *paddle-size*) 2))
|
|
70
|
+(def paddle-width 10)
|
|
71
|
+(def paddle-step 8)
|
|
72
|
+(def max-paddle-y (- height paddle-size))
|
|
73
|
+(def ef-paddle-width (+ paddle-width padding))
|
|
74
|
+(def init-paddle-pos (/ (- height paddle-size) 2))
|
75
|
75
|
|
76
|
|
-(def *gravity* (atom 0.005))
|
77
|
|
-(def *gravity-step* 0.005)
|
|
76
|
+(def gravity (atom 0.005))
|
|
77
|
+(def gravity-step 0.005)
|
78
|
78
|
|
79
|
79
|
(defn mass-radius []
|
80
|
|
- (+ *init-mass-radius* (* (deref *gravity*) 1000)))
|
|
80
|
+ (+ init-mass-radius (* (deref gravity) 1000)))
|
81
|
81
|
|
82
|
82
|
(defn setup-gravity-controls
|
83
|
83
|
"Sets up keyboard controls for changing gravity."
|
84
|
84
|
[]
|
85
|
85
|
(let [keydowns (first (dom-events :keydown))
|
86
|
|
- actions { 37 #(- % *gravity-step*) 39 #(+ % *gravity-step*) }
|
|
86
|
+ actions { 37 #(- % gravity-step) 39 #(+ % gravity-step) }
|
87
|
87
|
mass-el (dom/by-id "mass")]
|
88
|
88
|
(go-loop
|
89
|
89
|
(let [k (:keyCode (rd keydowns))]
|
90
|
90
|
(when (contains? actions k)
|
91
|
|
- (do (swap! *gravity* #(max 0 (min 0.1 ((actions k) %))))
|
|
91
|
+ (do (swap! gravity #(max 0 (min 0.1 ((actions k) %))))
|
92
|
92
|
(dom/set-attr! mass-el "r" (mass-radius))))))))
|
93
|
93
|
|
94
|
94
|
(defn layout-game
|
95
|
95
|
"Lays out the game screen."
|
96
|
96
|
[]
|
97
|
97
|
(doto (dom/by-id "canvas")
|
98
|
|
- (dom/set-style! "width" (str *width* "px"))
|
99
|
|
- (dom/set-style! "height" (str *height* "px")))
|
|
98
|
+ (dom/set-style! "width" (str width "px"))
|
|
99
|
+ (dom/set-style! "height" (str height "px")))
|
100
|
100
|
(doto (dom/by-id "ball")
|
101
|
|
- (dom/set-attr! "r" *ball-radius*)
|
102
|
|
- (dom/set-attr! "cx" (first *center*))
|
103
|
|
- (dom/set-attr! "cy" (second *center*)))
|
|
101
|
+ (dom/set-attr! "r" ball-radius)
|
|
102
|
+ (dom/set-attr! "cx" (first center))
|
|
103
|
+ (dom/set-attr! "cy" (second center)))
|
104
|
104
|
(doto (dom/by-id "mass")
|
105
|
105
|
(dom/set-attr! "r" (mass-radius))
|
106
|
|
- (dom/set-attr! "cx" (first *center*))
|
107
|
|
- (dom/set-attr! "cy" (second *center*)))
|
|
106
|
+ (dom/set-attr! "cx" (first center))
|
|
107
|
+ (dom/set-attr! "cy" (second center)))
|
108
|
108
|
(doto (dom/by-id "score")
|
109
|
|
- (dom/set-attr! "x" (first *center*))
|
110
|
|
- (dom/set-attr! "y" (- *height* 50)))
|
|
109
|
+ (dom/set-attr! "x" (first center))
|
|
110
|
+ (dom/set-attr! "y" (- height 50)))
|
111
|
111
|
(doseq [id ["lpaddle" "rpaddle"]]
|
112
|
112
|
(doto (dom/by-id id)
|
113
|
|
- (dom/set-attr! "width" *paddle-width*)
|
114
|
|
- (dom/set-attr! "height" *paddle-size*)
|
115
|
|
- (dom/set-attr! "y" (/ (- *height* *paddle-size*) 2))))
|
|
113
|
+ (dom/set-attr! "width" paddle-width)
|
|
114
|
+ (dom/set-attr! "height" paddle-size)
|
|
115
|
+ (dom/set-attr! "y" (/ (- height paddle-size) 2))))
|
116
|
116
|
(dom/set-attr! (dom/by-id "lpaddle") "x" 0)
|
117
|
|
- (dom/set-attr! (dom/by-id "rpaddle") "x" (- *width* *paddle-width*)))
|
|
117
|
+ (dom/set-attr! (dom/by-id "rpaddle") "x" (- width paddle-width)))
|
118
|
118
|
|
119
|
119
|
(defn initial-velocity
|
120
|
120
|
"Calculates a random initial ball velocity, randomly in any four quadrants, between
|
121
|
|
- the limits of degrees specified by *init-vel-deg-lim*."
|
|
121
|
+ the limits of degrees specified by init-vel-deg-lim."
|
122
|
122
|
[]
|
123
|
|
- (let [[l h] *init-vel-deg-lim*
|
|
123
|
+ (let [[l h] init-vel-deg-lim
|
124
|
124
|
sgn #(if (< % 0.5) -1 1)
|
125
|
125
|
deg (+ l (* (- h l) (rand)))
|
126
|
126
|
rad (deg->rad deg)]
|
127
|
|
- (map #(* *ball-speed* %)
|
|
127
|
+ (map #(* ball-speed %)
|
128
|
128
|
[(* (sgn (rand)) (sin rad)) (* (sgn (rand)) (cos rad))])))
|
129
|
129
|
|
130
|
130
|
(defn start-game
|
|
@@ -141,9 +141,9 @@
|
141
|
141
|
|
142
|
142
|
;; start the game by setting the initial values of the signals
|
143
|
143
|
(go
|
144
|
|
- (wt pos *center*)
|
|
144
|
+ (wt pos center)
|
145
|
145
|
(wt vel init-vel)
|
146
|
|
- (wt pd-pos [*init-paddle-pos* *init-paddle-pos*])
|
|
146
|
+ (wt pd-pos [init-paddle-pos init-paddle-pos])
|
147
|
147
|
(wt game-state [:moving 0]))))
|
148
|
148
|
|
149
|
149
|
(defn start-on-space []
|
|
@@ -181,7 +181,7 @@
|
181
|
181
|
|
182
|
182
|
(defn ticker
|
183
|
183
|
"Ticker component.
|
184
|
|
- Reads ticks generated by the browser from the `br-ticks` signal and outputs them to the
|
|
184
|
+ Reads ticks generated by the browser from the `br-ticks` signal and outputs them to the
|
185
|
185
|
`game-ticks` signal as long as the `game-state` signal is not :gameover.
|
186
|
186
|
Once the `game-state` signal is :gameover, stops the game by calling the `stop-game` function.
|
187
|
187
|
Each tick is the number of milliseconds since the last tick was generated."
|
|
@@ -197,8 +197,8 @@
|
197
|
197
|
"Calculates acceleration due to gravitation for the ball caused by the mass placed at the
|
198
|
198
|
center of the board."
|
199
|
199
|
[[x y]]
|
200
|
|
- (let [grav (deref *gravity*)
|
201
|
|
- [cx cy] *center*
|
|
200
|
+ (let [grav (deref gravity)
|
|
201
|
+ [cx cy] center
|
202
|
202
|
x-dist (- cx x)
|
203
|
203
|
y-dist (- cy y)
|
204
|
204
|
distance (sqrt (+ (sq x-dist) (sq y-dist)))
|
|
@@ -240,27 +240,27 @@
|
240
|
240
|
ks (rd keys)
|
241
|
241
|
move (fn [pos up down]
|
242
|
242
|
(cond
|
243
|
|
- (contains? ks up) (max (- pos *paddle-step*) 0)
|
244
|
|
- (contains? ks down) (min (+ pos *paddle-step*) *max-paddle-y*)
|
|
243
|
+ (contains? ks up) (max (- pos paddle-step) 0)
|
|
244
|
+ (contains? ks down) (min (+ pos paddle-step) max-paddle-y)
|
245
|
245
|
:else pos))]
|
246
|
246
|
(wt pos-out [(move lpos :w :s) (move rpos :up :down)]))))
|
247
|
247
|
|
248
|
248
|
(defn in-y-range? [y paddle-y]
|
249
|
|
- (and (> y (- paddle-y *padding*)) (< y (+ paddle-y *paddle-size* *padding*))))
|
|
249
|
+ (and (> y (- paddle-y padding)) (< y (+ paddle-y paddle-size padding))))
|
250
|
250
|
|
251
|
251
|
(defn detect-x-collision [x y lpaddle-y rpaddle-y]
|
252
|
252
|
(cond
|
253
|
|
- (< x *ef-paddle-width*)
|
|
253
|
+ (< x ef-paddle-width)
|
254
|
254
|
(if (in-y-range? y lpaddle-y) :collision-left :gameover)
|
255
|
|
- (> x (- *width* *ef-paddle-width*))
|
|
255
|
+ (> x (- width ef-paddle-width))
|
256
|
256
|
(if (in-y-range? y rpaddle-y) :collision-right :gameover)
|
257
|
257
|
:else :moving))
|
258
|
258
|
|
259
|
259
|
(defn detect-y-collision [y]
|
260
|
260
|
(cond
|
261
|
|
- (< y *padding*) :collision-left
|
262
|
|
- (> y (- *height* *padding*)) :collision-right
|
263
|
|
- :else :moving))
|
|
261
|
+ (< y padding) :collision-left
|
|
262
|
+ (> y (- height padding)) :collision-right
|
|
263
|
+ :else :moving))
|
264
|
264
|
|
265
|
265
|
(defn collision? [state]
|
266
|
266
|
(or (= state :collision-left) (= state :collision-right)))
|
|
@@ -272,7 +272,7 @@
|
272
|
272
|
:moving vel
|
273
|
273
|
:gameover 0))
|
274
|
274
|
|
275
|
|
-(defn perturb [v] (* v (+ 1 (* (rand) *perturb-factor*))))
|
|
275
|
+(defn perturb [v] (* v (+ 1 (* (rand) perturb-factor))))
|
276
|
276
|
|
277
|
277
|
(defn collision-detector [ticks pos vel-in acc pd-pos game-state-in game-state vel-out]
|
278
|
278
|
"Collision Detector component.
|
|
@@ -300,8 +300,8 @@
|
300
|
300
|
y-collision (collision? y-state)
|
301
|
301
|
|
302
|
302
|
;; calculate next velocity and game state
|
303
|
|
- vel-xn (min *ball-speed* (+ (adjust-vel x-state vel-x) (* gx tick)))
|
304
|
|
- vel-yn (min *ball-speed* (+ (adjust-vel y-state vel-y) (* gy tick)))
|
|
303
|
+ vel-xn (min ball-speed (+ (adjust-vel x-state vel-x) (* gx tick)))
|
|
304
|
+ vel-yn (min ball-speed (+ (adjust-vel y-state vel-y) (* gy tick)))
|
305
|
305
|
state-n (cond
|
306
|
306
|
(= x-state :gameover) :gameover
|
307
|
307
|
(or x-collision y-collision) :collision
|