2013-09-15 03:19:05 +05:30
|
|
|
(ns frpong.core
|
2013-09-26 02:45:13 +05:30
|
|
|
(:require [frpong.helpers :as h]
|
2013-10-11 18:26:04 +05:30
|
|
|
[cljs.core.async :refer [<! >! chan put!]]
|
|
|
|
[domina :as dom :refer [log]])
|
2013-09-25 15:28:33 +05:30
|
|
|
(:require-macros [cljs.core.async.macros :as m :refer [go]]
|
|
|
|
[frpong.core :refer (go-loop)]))
|
2013-09-25 16:37:14 +05:30
|
|
|
;;
|
|
|
|
;; Signal Diagram
|
|
|
|
;;
|
2013-09-25 17:08:06 +05:30
|
|
|
;; +---------------------+
|
|
|
|
;; | +-------------+ |
|
|
|
|
;; | | | |
|
|
|
|
;; v v | |
|
|
|
|
;; +----------+ vel-chan | |
|
|
|
|
;; +-->|c-detector+----------+ |
|
|
|
|
;; | +----------+ | |
|
|
|
|
;; | +-----------------+ |
|
|
|
|
;; | | +-----------------+
|
|
|
|
;; | | | |
|
|
|
|
;; | v v |
|
|
|
|
;; +---------+ frame-chan +------+ tick-chan | +----------+ pos-chan |
|
|
|
|
;; |frame-gen+------------>|ticker+-----------+-->|positioner+--------------+
|
|
|
|
;; +---------+ +------+ +----------+ |
|
|
|
|
;; +---------------------+
|
|
|
|
;; |
|
|
|
|
;; v
|
|
|
|
;; +----------+
|
|
|
|
;; | renderer |
|
|
|
|
;; +----------+
|
2013-09-15 03:19:05 +05:30
|
|
|
|
2013-09-25 22:05:07 +05:30
|
|
|
(defn abs [x] (.abs js/Math x))
|
|
|
|
|
2013-10-09 00:33:56 +05:30
|
|
|
(defn tick-chan [frames]
|
2013-09-25 23:24:43 +05:30
|
|
|
(let [c (chan)]
|
|
|
|
(go
|
2013-10-09 00:33:56 +05:30
|
|
|
(loop [prev (<! frames)]
|
|
|
|
(let [t (<! frames)]
|
2013-09-25 23:24:43 +05:30
|
|
|
(when (< t (* 10 prev))
|
|
|
|
(>! c t))
|
|
|
|
(recur t))))
|
|
|
|
c))
|
|
|
|
|
2013-10-11 21:40:23 +05:30
|
|
|
(defn ticker [[frames stop-frames] ticks game-state]
|
|
|
|
(let [ticks-in (tick-chan (h/diff-chan frames))]
|
|
|
|
(go-loop
|
|
|
|
(if-not (= :gameover (<! game-state))
|
|
|
|
(>! ticks (<! ticks-in))
|
|
|
|
(stop-frames)))))
|
|
|
|
|
2013-10-09 00:33:56 +05:30
|
|
|
(defn ball-positioner [ticks vel pos-in pos-out]
|
2013-09-25 15:28:33 +05:30
|
|
|
(go-loop
|
2013-10-11 18:26:04 +05:30
|
|
|
(let [tick (<! ticks)
|
2013-10-09 00:33:56 +05:30
|
|
|
[vel-x vel-y] (<! vel)
|
2013-10-11 18:26:04 +05:30
|
|
|
[x y] (<! pos-in)
|
|
|
|
pos-next [(+ x (* vel-x tick)) (+ y (* vel-y tick))]]
|
2013-10-09 00:33:56 +05:30
|
|
|
(>! pos-out pos-next))))
|
2013-09-15 03:19:05 +05:30
|
|
|
|
2013-10-11 18:26:04 +05:30
|
|
|
(defn paddle-positioner [keycodes max-y movement pos-in pos-out]
|
|
|
|
(let [keys (h/key-chan keycodes)]
|
|
|
|
(go-loop
|
|
|
|
(let [pos (<! pos-in)]
|
|
|
|
(>! pos-out
|
|
|
|
(condp = (<! keys)
|
|
|
|
:up (max (- pos movement) 0)
|
|
|
|
:down (min (+ pos movement) max-y)))))))
|
|
|
|
|
2013-10-11 17:58:36 +05:30
|
|
|
(defn collision-detector
|
|
|
|
[{:keys [width height padding paddle-size paddle-width]}
|
2013-10-11 21:40:23 +05:30
|
|
|
ticks game-state pos vel-in vel-out pl-pos pr-pos]
|
2013-10-11 18:26:04 +05:30
|
|
|
(let [ef-paddle-width (+ paddle-width padding)
|
|
|
|
adjust-v (fn [state v] [(condp = state
|
|
|
|
:collision-left (abs v)
|
2013-10-11 17:58:36 +05:30
|
|
|
:collision-right (- (abs v))
|
2013-10-11 18:26:04 +05:30
|
|
|
:moving v
|
|
|
|
:gameover 0)
|
2013-10-11 17:58:36 +05:30
|
|
|
state])
|
2013-10-11 18:26:04 +05:30
|
|
|
in-y-range? (fn [y p-pos] (and (> y (+ p-pos padding))
|
|
|
|
(< y (- (+ p-pos paddle-size) padding))))
|
2013-10-11 17:58:36 +05:30
|
|
|
detect-x-collision (fn [x y pl-pos pr-pos]
|
|
|
|
(cond
|
2013-10-11 18:26:04 +05:30
|
|
|
(< x ef-paddle-width)
|
|
|
|
(if (in-y-range? y pl-pos) :collision-left :gameover)
|
|
|
|
(> x (- width ef-paddle-width))
|
|
|
|
(if (in-y-range? y pr-pos) :collision-right :gameover)
|
|
|
|
:else :moving))
|
|
|
|
detect-y-collision (fn [y] (cond
|
|
|
|
(< y padding) :collision-left
|
|
|
|
(> y (- height padding)) :collision-right
|
|
|
|
:else :moving))]
|
2013-09-26 19:30:50 +05:30
|
|
|
(go-loop
|
2013-10-11 18:26:04 +05:30
|
|
|
(let [tick (<! ticks)
|
2013-10-09 00:33:56 +05:30
|
|
|
[vel-x vel-y] (<! vel-in)
|
2013-10-11 18:26:04 +05:30
|
|
|
[x y] (<! pos)
|
|
|
|
pl-pos (<! pl-pos)
|
|
|
|
pr-pos (<! pr-pos)
|
|
|
|
[xn yn] [(+ x (* vel-x tick)) (+ y (* vel-y tick))]
|
2013-10-11 17:58:36 +05:30
|
|
|
[vel-xn bs-x] (adjust-v (detect-x-collision xn yn pl-pos pr-pos) vel-x)
|
|
|
|
[vel-yn bs-y] (adjust-v (detect-y-collision yn) vel-y)]
|
2013-10-09 00:33:56 +05:30
|
|
|
(>! vel-out [vel-xn vel-yn])
|
2013-10-11 17:58:36 +05:30
|
|
|
(>! game-state
|
|
|
|
(cond
|
|
|
|
(= bs-x :gameover) :gameover
|
|
|
|
(or (= bs-x :collision-left) (= bs-x :collision-right)
|
|
|
|
(= bs-y :collision-left) (= bs-y :collision-right)) :collision
|
|
|
|
:else :moving))))))
|
2013-09-15 03:19:05 +05:30
|
|
|
|
2013-10-11 18:26:04 +05:30
|
|
|
(defn renderer [game-state pos pl-pos pr-pos]
|
|
|
|
(let [ball-el (dom/by-id "ball")
|
|
|
|
state-el (dom/by-id "state")
|
2013-09-26 19:30:50 +05:30
|
|
|
lpaddle-el (dom/by-id "lpaddle")
|
|
|
|
rpaddle-el (dom/by-id "rpaddle")]
|
2013-09-25 22:05:07 +05:30
|
|
|
(go-loop
|
2013-10-11 17:58:36 +05:30
|
|
|
(let [[x y] (<! pos)
|
2013-10-11 18:26:04 +05:30
|
|
|
gs (<! game-state)]
|
2013-10-11 17:58:36 +05:30
|
|
|
(dom/set-text! state-el (name gs))
|
2013-09-26 19:30:50 +05:30
|
|
|
(doto ball-el
|
2013-09-26 10:52:21 +05:30
|
|
|
(dom/set-attr! "cx" x)
|
2013-10-11 17:58:36 +05:30
|
|
|
(dom/set-attr! "cy" y))))
|
2013-09-26 02:45:13 +05:30
|
|
|
(go-loop
|
2013-10-09 00:33:56 +05:30
|
|
|
(dom/set-attr! lpaddle-el "y" (<! pl-pos)))
|
2013-09-26 02:45:13 +05:30
|
|
|
(go-loop
|
2013-10-09 00:33:56 +05:30
|
|
|
(dom/set-attr! rpaddle-el "y" (<! pr-pos)))))
|
2013-09-25 22:05:07 +05:30
|
|
|
|
2013-09-26 03:02:16 +05:30
|
|
|
(defn game-setup [{:keys [width height padding paddle-size] :as layout} paddle-movement
|
2013-10-11 21:40:23 +05:30
|
|
|
frames game-state pos vel pl-pos pr-pos]
|
2013-10-11 18:26:04 +05:30
|
|
|
(let [max-y (- height paddle-size)
|
|
|
|
ticks (chan)
|
|
|
|
[tick-pos tick-collsion tick-pl tick-pr] (h/multiplex ticks 4)
|
|
|
|
[pos-in pos-collision pos-render] (h/multiplex pos 3)
|
|
|
|
[vel-pos vel-collision] (h/multiplex vel 2)
|
2013-10-11 17:58:36 +05:30
|
|
|
[pl-pos-in pl-pos-collision pl-pos-render] (h/multiplex pl-pos 3)
|
|
|
|
[pr-pos-in pr-pos-collision pr-pos-render] (h/multiplex pr-pos 3)
|
2013-10-11 21:40:23 +05:30
|
|
|
[game-state-ticker game-state-render] (h/multiplex game-state 2)]
|
|
|
|
(ticker frames ticks game-state-ticker)
|
2013-10-11 17:58:36 +05:30
|
|
|
(ball-positioner tick-pos vel-pos pos-in pos)
|
2013-10-11 21:40:23 +05:30
|
|
|
(collision-detector layout tick-collsion game-state pos-collision vel-collision vel
|
2013-10-09 00:33:56 +05:30
|
|
|
(h/sustain pl-pos-collision tick-pl)
|
2013-10-11 21:40:23 +05:30
|
|
|
(h/sustain pr-pos-collision tick-pr))
|
2013-10-11 17:58:36 +05:30
|
|
|
(paddle-positioner {83 :down 87 :up} max-y paddle-movement pl-pos-in pl-pos)
|
|
|
|
(paddle-positioner {38 :up 40 :down} max-y paddle-movement pr-pos-in pr-pos)
|
2013-10-11 18:26:04 +05:30
|
|
|
[game-state-render pos-render pl-pos-render pr-pos-render]))
|
2013-09-25 22:05:07 +05:30
|
|
|
|
2013-09-26 10:52:21 +05:30
|
|
|
(defn game-init [{:keys [height paddle-size] :as layout}
|
2013-10-11 21:40:23 +05:30
|
|
|
{:keys [init-pos init-vel paddle-movement]} frames]
|
2013-10-09 00:33:56 +05:30
|
|
|
(let [init-paddle-pos (/ (- height paddle-size) 2)
|
2013-10-11 18:26:04 +05:30
|
|
|
pos (chan 1)
|
|
|
|
vel (chan 1)
|
|
|
|
pl-pos (chan 1)
|
|
|
|
pr-pos (chan 1)
|
|
|
|
game-state (chan 1)]
|
2013-10-09 00:33:56 +05:30
|
|
|
(put! pos init-pos)
|
|
|
|
(put! vel init-vel)
|
|
|
|
(put! pl-pos init-paddle-pos)
|
|
|
|
(put! pr-pos init-paddle-pos)
|
2013-10-11 17:58:36 +05:30
|
|
|
(put! game-state :moving)
|
2013-09-25 22:05:07 +05:30
|
|
|
|
2013-09-26 10:52:21 +05:30
|
|
|
(apply renderer
|
2013-10-11 21:40:23 +05:30
|
|
|
(game-setup layout paddle-movement frames game-state pos vel pl-pos pr-pos))))
|
2013-09-25 22:05:07 +05:30
|
|
|
|
2013-09-15 03:19:05 +05:30
|
|
|
(defn ^:export init []
|
2013-10-11 21:40:23 +05:30
|
|
|
(let [layout {:width 800
|
2013-10-11 18:26:04 +05:30
|
|
|
:height 400
|
|
|
|
:padding 5
|
|
|
|
:paddle-size 100
|
|
|
|
:paddle-width 10
|
|
|
|
:ball-radius 5}
|
2013-10-11 17:58:36 +05:30
|
|
|
init-vals {:init-pos [50 100]
|
|
|
|
:init-vel [0.3 0.33]
|
|
|
|
:paddle-movement 20}
|
2013-09-26 19:30:50 +05:30
|
|
|
|
2013-10-11 21:40:23 +05:30
|
|
|
[frames stop-frames] (h/frame-chan)
|
|
|
|
[frames-fps frames-count frames-game] (h/multiplex frames 3)
|
|
|
|
fps (h/map-chan #(/ 1000 %) (h/diff-chan frames-fps))
|
|
|
|
frames-count (h/counting-chan frames-count)
|
|
|
|
|
2013-10-11 18:26:04 +05:30
|
|
|
fps-el (dom/by-id "fps")
|
2013-09-26 19:30:50 +05:30
|
|
|
frame-el (dom/by-id "frame")]
|
2013-09-26 10:52:21 +05:30
|
|
|
(doto (dom/by-id "canvas")
|
|
|
|
(dom/set-style! "width" (str (:width layout) "px"))
|
|
|
|
(dom/set-style! "height" (str (:height layout) "px")))
|
2013-10-11 17:58:36 +05:30
|
|
|
(doto (dom/by-id "ball")
|
|
|
|
(dom/set-attr! "r" (:ball-radius layout))
|
|
|
|
(dom/set-attr! "cx" (first (:init-pos init-vals)))
|
|
|
|
(dom/set-attr! "cy" (second (:init-pos init-vals))))
|
|
|
|
(doseq [id ["lpaddle" "rpaddle"]]
|
|
|
|
(doto (dom/by-id id)
|
|
|
|
(dom/set-attr! "width" (:paddle-width layout))
|
|
|
|
(dom/set-attr! "height" (:paddle-size layout))
|
|
|
|
(dom/set-attr! "y" (/ (- (:height layout) (:paddle-size layout)) 2))))
|
|
|
|
(dom/set-attr! (dom/by-id "lpaddle") "x" 0)
|
|
|
|
(dom/set-attr! (dom/by-id "rpaddle") "x" (- (:width layout) (:paddle-width layout)))
|
|
|
|
|
2013-09-25 23:24:43 +05:30
|
|
|
(go-loop
|
2013-10-09 00:33:56 +05:30
|
|
|
(dom/set-text! fps-el (<! fps))
|
|
|
|
(dom/set-text! frame-el (<! frames-count)))
|
2013-10-11 21:40:23 +05:30
|
|
|
(game-init layout init-vals [frames-game stop-frames])))
|