pingping -- start of a pong game with quil

core.clj

(ns pingping.core
  (:import [java.awt.event KeyEvent])
  (:require [quil.core :as q]))


(defn draw-rect [r]
  (q/rect (:x r) (:y r) (:w r) (:h r)))


;; define left- and right-side rackets, as well as a ball and ball velocity
(def r-left (atom {:x 10 :y 65 :w 10 :h 70}))
(def r-right (atom {:x 430 :y 65 :w 10 :h 70}))
(def ball (atom {:x 225 :y 100 :w 10 :h 10}))
(def ball-dir (atom [3 0]))
;; store the old ball dir in the event of a pause
(def old-ball-dir (atom [0 0]))
;; track the number of racket hits
(def racket-hits (atom 0))
;; track the score
(def score (atom [0 0]))


;; calculates a new ball position from a ball and ball-dir
(defn next-ball [b [dx dy]]
  (assoc b :x (+ (:x b) dx)
           :y (+ (:y b) dy)))


;; reset the ball's position to the middle
(defn reset-ball [b]
  (assoc b :x 225 :y 100))


;; calculate where the ball hits the racket
;; 0.5, 0 or -0.5 depending on where it hits
(defn anglefactor [r b]
  (- (/ (- (:y b) (:y r))
        (:h r))
     0.5))


;; bump the ball's velocity based on some factor
(defn bump-vel [[dx dy] f]
  (cond
    (and (>= dx 0) (>= dy 0))
    [(+ dx f) (+ dy f)]
    (and (< dx 0) (>= dy 0))
    [(- dx f) (+ dy f)]
    (and (< dx 0) (< dy 0))
    [(- dx f) (- dy f)]
    (and (>= dx 0) (< dy 0))
    [(+ dx f) (- dy f)]
    :else
    [dx dy]))


;; determine if two rectangles intersect
(defn rect-intersects? [a b]
  (let [top-left-corner-a-x (:x a)
        top-left-corner-a-y (:y a)
        bottom-right-corner-a-x (+ (:x a) (:w a))
        bottom-right-corner-a-y (+ (:y a) (:h a))
        top-left-corner-b-x (:x b)
        top-left-corner-b-y (:y b)
        bottom-right-corner-b-x (+ (:x b) (:w b))
        bottom-right-corner-b-y (+ (:y b) (:h b))]
    (cond
      (and
        (<= top-left-corner-a-x bottom-right-corner-b-x)
        (>= bottom-right-corner-a-x top-left-corner-b-x)
        (<= top-left-corner-a-y bottom-right-corner-b-y)
        (>= bottom-right-corner-a-y top-left-corner-b-y))
      true
      :else
      false)))


(defn update []
  ; update the ball's position
  (swap! ball next-ball @ball-dir)

  ; ball hit top or bottom border? invert the y direction
  (when (or (> (:y @ball) 200) (< (:y @ball) 0))
   (swap! ball-dir (fn [[x y]] [x (- y)])))

  ; ball hit left racket..
  ; invert x, set y to anglefactor, increase ball-dir
  (when (rect-intersects? @r-left @ball)
    (let [t (anglefactor @r-left @ball)]
      (swap! ball-dir (fn [[x _]] [(- x) t])))
    (swap! ball-dir bump-vel (/ @racket-hits 3))
    (swap! racket-hits inc))

  ; ball hit right racket..
  ; invert x, set y to anglefactor, increase ball-dir
  (when (rect-intersects? @r-right @ball)
    (let [t (anglefactor @r-right @ball)]
      (swap! ball-dir (fn [[x _]] [(- x) t])))
    (swap! ball-dir bump-vel (/ @racket-hits 3))
    (swap! racket-hits inc))

  ; ball goes past the left paddle..
  ; update the score, reset the ball
  (when (< (+ (:w @ball) (:x @ball)) 0)
    (swap! score (fn [[l r]] [l (inc r)]))
    (println @score)
    (swap! ball reset-ball)
    (swap! ball-dir (fn [dir] [-3 0]))
    (swap! racket-hits (fn [hits] 0)))

  ; ball goes past the right paddle..
  ; update the score, reset the ball
  (when (> (:x @ball) 450)
    (swap! score (fn [[l r]] [(inc l) r]))
    (println @score)
    (swap! ball reset-ball)
    (swap! ball-dir (fn [dir] [3 0]))
    (swap! racket-hits (fn [hits] 0))))


(defn draw []
  (q/background-float 0x20)
  (q/fill 0xff)
  (draw-rect @r-left)
  (draw-rect @r-right)
  (draw-rect @ball))


(defn key-pressed []
  (cond
    ; left player uses W/S
    (= (q/key-code) KeyEvent/VK_W)
    (swap! r-left update-in [:y] (fn [y] (- y 7)))
    (= (q/key-code) KeyEvent/VK_S)
    (swap! r-left update-in [:y] (fn [y] (+ y 7)))

    ; right player uses up/down
    (= (q/key-code) KeyEvent/VK_UP)
    (swap! r-right update-in [:y] (fn [y] (- y 7)))
    (= (q/key-code) KeyEvent/VK_DOWN)
    (swap! r-right update-in [:y] (fn [y] (+ y 7)))

    ; pause with spacebar
    (= (q/key-code) KeyEvent/VK_SPACE)
    (cond
      ; if the ball's not moving, unpause
      (= @ball-dir [0 0])
      (swap! ball-dir (fn [dir] [(get @old-ball-dir 0) (get @old-ball-dir 1)]))
      ; if the ball is moving, pause and store the old ball-dir
      :else
      (do
        (swap! old-ball-dir (fn [dir] [(get @ball-dir 0) (get @ball-dir 1)]))
        (swap! ball-dir (fn [dir] [0 0]))))))


(q/defsketch example
  :title "oh my"
  :size [450 200]
  :setup (fn [] (q/smooth) (q/no-stroke) (q/frame-rate 60))
  :draw (fn [] (update) (draw))
  :key-pressed key-pressed)


(defn -main [& args]
  (example))

project.clj

(defproject pingping "0.1.0-SNAPSHOT"
  :description "FIXME: write description"
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.6.0"]
                 [quil "1.7.0"]]

  :main pingping.core)