Created
September 17, 2015 13:58
-
-
Save halogenandtoast/5da1f7490f46e254997b to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (ns cljs.pong.main | |
| (:require [goog.dom :as dom] | |
| [goog.events :as events])) | |
| (def animate | |
| (or (.-requestAnimationFrame js/window) | |
| (.-webkitRequestAnimationFrame js/window) | |
| (.-mozRequestAnimationFrame js/window) | |
| #(.setTimeout js/window %1 (/ 1000 60)))) | |
| (def canvas (.createElement js/document "canvas")) | |
| (def width 400) | |
| (def height 600) | |
| (set! (.-width canvas) width) | |
| (set! (.-height canvas) height) | |
| (def context (.getContext canvas "2d")) | |
| (def ball-color "#000000") | |
| (def background-color "#FF00FF") | |
| (def paddle-color "#0000FF") | |
| (def paddle-width 50) | |
| (def paddle-height 10) | |
| (defn half [x] (/ x 2)) | |
| (defn tick-ball [{x_speed :x_speed y_speed :y_speed :as ball}] | |
| (-> ball | |
| (update-in [:y] + y_speed) | |
| (update-in [:x] + x_speed))) | |
| (defn out-of-bounds? [value max-value] | |
| (or (neg? value) (> value max-value))) | |
| (defn adjust-ball-out-of-bounds-y [{y :y :as ball}] | |
| (if (out-of-bounds? y height) | |
| (merge ball {:x_speed 0 :y_speed 3 :x 200 :y (half height)}) | |
| ball)) | |
| (defn paddle-and-ball-collided? [paddle ball] | |
| (let [top-x (- (:x ball) 5) | |
| top-y (- (:y ball) 5) | |
| bottom-x (+ (:x ball) 5) | |
| bottom-y (+ (:y ball) 5)] | |
| (and | |
| (< top-y (+ (:y paddle) (:height paddle))) | |
| (> bottom-y (:y paddle)) | |
| (< top-x (+ (:x paddle) (:width paddle))) | |
| (> bottom-x (:x paddle))))) | |
| (defn bounce-ball [ball x_speed y_speed] | |
| (-> ball | |
| (assoc-in [:y_speed] y_speed) | |
| (update-in [:x_speed] + (half x_speed)) | |
| (update-in [:y] + y_speed))) | |
| (defn adjust-ball-for-paddles [ball game] | |
| (let [player (get-in game [:player :paddle]) | |
| computer (get-in game [:computer :paddle])] | |
| (condp paddle-and-ball-collided? ball | |
| player (bounce-ball ball (:x_speed player) -3) | |
| computer (bounce-ball ball (:x_speed computer) 3) | |
| ball))) | |
| (defn adjust-ball-x [ball] | |
| (let [top_x (- (:x ball) 5) | |
| bottom_x (+ (:x ball) 5)] | |
| (if (neg? top_x) | |
| (merge ball {:x 5 :x_speed (- (:x_speed ball))}) | |
| (if (> bottom_x 400) | |
| (merge ball {:x 395 :x_speed (- (:x_speed ball))}) | |
| ball)))) | |
| (defn adjust-ball-y [ball game] | |
| (-> ball | |
| (adjust-ball-out-of-bounds-y) | |
| (adjust-ball-for-paddles game))) | |
| (defn update-ball [ball game] | |
| (-> ball | |
| (tick-ball) | |
| (adjust-ball-x) | |
| (adjust-ball-y game))) | |
| (defn move-paddle [paddle x] | |
| (-> paddle | |
| (update-in [:x] + x) | |
| (merge {:x_speed x}))) | |
| (defn adjust-paddle-position [paddle] | |
| (if (neg? (:x paddle)) | |
| (merge paddle {:x 0 :x_speed 0}) | |
| (if (> (+ (:x paddle) (:width paddle)) 400) | |
| (merge paddle {:x (- 400 (:width paddle)) :x_speed 0}) | |
| paddle))) | |
| (defn update-paddle [paddle x] | |
| (-> paddle | |
| (move-paddle x) | |
| (adjust-paddle-position))) | |
| (defn update-player [player keys-pressed] | |
| (reduce | |
| (fn [player key-pressed] | |
| (case key-pressed | |
| 37 (update-in player [:paddle] update-paddle -4) | |
| 39 (update-in player [:paddle] update-paddle 4) | |
| player)) | |
| player | |
| @keys-pressed)) | |
| (defn middle-of-paddle [paddle] | |
| (+ (:x paddle) (half (:width paddle)))) | |
| (defn x-distance-from-ball [paddle ball] | |
| (- (middle-of-paddle paddle) (:x ball))) | |
| (defn compute-paddle-speed [x-distance] | |
| (- (max -5 (min 5 x-distance)))) | |
| (defn update-computer [computer ball] | |
| (let [paddle (:paddle computer) | |
| speed (compute-paddle-speed (x-distance-from-ball paddle ball))] | |
| (update-in computer [:paddle] update-paddle speed))) | |
| (defn update [game keys-pressed] | |
| (-> game | |
| (update-in [:ball] update-ball game) | |
| (update-in [:player] update-player keys-pressed) | |
| (update-in [:computer] update-computer (:ball game)))) | |
| (defn set-fill [color] | |
| (set! (.-fillStyle context) color)) | |
| (defn draw-rect [x y width height color] | |
| (set-fill color) | |
| (.fillRect context x y width height)) | |
| (defn draw-circle [x y radius color] | |
| (.beginPath context) | |
| (.arc context x y radius (* 2 (.-PI js/Math)) false) | |
| (set-fill color) | |
| (.fill context)) | |
| (defn render-background [] | |
| (draw-rect 0 0 width height background-color)) | |
| (defn render-paddle [paddle] | |
| (draw-rect (:x paddle) (:y paddle) (:width paddle) (:height paddle) paddle-color)) | |
| (defn render-player [user] | |
| (render-paddle (:paddle user))) | |
| (defn render-ball [{x :x y :y radius :radius}] | |
| (draw-circle x y radius ball-color)) | |
| (defn render [{player :player computer :computer ball :ball}] | |
| (render-background) | |
| (render-player player) | |
| (render-player computer) | |
| (render-ball ball)) | |
| (defn make-paddle [x y] | |
| {:x x :y y :width paddle-width :height paddle-height :x_speed 0 :y_speed 0}) | |
| (defn make-ball [x y] | |
| {:x x :y y :x_speed 0 :y_speed 3 :radius 5}) | |
| (defn make-player [y] | |
| {:paddle (make-paddle 175 y)}) | |
| (defn make-game [] | |
| {:player (make-player (- height 20)) | |
| :computer (make-player 10) | |
| :ball (make-ball 200 (half height))}) | |
| (defn step [game keys-pressed] | |
| (let [game' (update game keys-pressed)] | |
| (render game') | |
| (animate #(step game' keys-pressed)))) | |
| (defn init [] | |
| (dom/appendChild (.-body js/document) canvas) | |
| (let [game (make-game) | |
| keys-pressed (atom (set []))] | |
| (events/listen js/window "keydown" (fn [event] (swap! keys-pressed conj (.-keyCode event)))) | |
| (events/listen js/window "keyup" (fn [event] (swap! keys-pressed disj (.-keyCode event)))) | |
| (step game keys-pressed))) | |
| (set! (.-onload js/window) init) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment