2D Physics
November 9, 2014 ยท View on GitHub
(def ^:const pixels-per-tile 32)
(defn create-ball-body! [screen radius] (let [body (add-body! screen (body-def :dynamic))] (->> (circle-shape :set-radius radius) (fixture-def :density 1 :friction 0 :restitution 1 :shape) (body! body :create-fixture)) body))
(defn create-rect-body! [screen width height] (let [body (add-body! screen (body-def :static))] (->> [0 0 0 height width height width 0 0 0] float-array (chain-shape :create-chain) (fixture-def :density 1 :shape) (body! body :create-fixture)) body))
(defn create-ball-entity! [screen] (let [radius (/ 50 pixels-per-tile 2) ball (shape :line :set-color (color :teal) :circle 0 0 radius 20)] (assoc ball :body (create-ball-body! screen radius))))
(defn create-rect-entity! [screen block width height] (assoc block :body (create-rect-body! screen width height) :width width :height height))
(defn move-paddle! [entities] (when-let [entity (some #(if (:paddle? %) %) entities)] (body-x! entity (- (/ (game :x) pixels-per-tile) (/ (:width entity) 2)))))
(defscreen main-screen :on-show (fn [screen entities] (let [screen (update! screen :camera (orthographic) :renderer (stage) :world (box-2d 0 0)) game-w (/ (game :width) pixels-per-tile) game-h (/ (game :height) pixels-per-tile) floor-h (/ 1 pixels-per-tile) block-w (/ 100 pixels-per-tile) block-h (/ 30 pixels-per-tile) block (shape :line :set-color (color :green) :rect 0 0 block-w block-h) block-cols (int (/ game-w block-w)) block-rows (int (/ game-h 2 block-h)) ball (doto (create-ball-entity! screen) (body-position! (/ 100 pixels-per-tile) (/ 100 pixels-per-tile) 0) (body! :set-linear-velocity 10 10)) paddle (doto (create-rect-entity! screen block block-w block-h) (body-position! 0 0 0)) wall (doto {:body (create-rect-body! screen game-w game-h)} (body-position! 0 0 0)) floor (doto {:body (create-rect-body! screen game-w floor-h)} (body-position! 0 0 0))] ; set the screen width in tiles (width! screen game-w) ; return the entities [(assoc ball :ball? true) (assoc paddle :paddle? true) (assoc wall :wall? true) (assoc floor :floor? true) (for [col (range block-cols) row (range block-rows) :let [x (* col block-w) y (+ (* row block-h) (- game-h (* block-h block-rows)))]] (assoc (doto (create-rect-entity! screen block block-w block-h) (body-position! x y 0)) :block? true))]))
:on-render (fn [screen entities] (clear!) (->> entities (step! screen) (render! screen)))
:on-mouse-moved (fn [screen entities] (move-paddle! entities) nil)
:on-touch-dragged (fn [screen entities] (move-paddle! entities) nil)
:on-begin-contact (fn [screen entities] (when-let [entity (first-entity screen entities)] (cond (:floor? entity) (restart-game!) (:block? entity) (remove #(= entity %) entities)))))
(set-game-screen! main-screen)