things can bump into things

master
Josha von Gizycki 7 years ago
parent c370d37157
commit 160aa92b8b

@ -9,10 +9,10 @@
{ {
:bumper :bumper
{ {
:x 50 :x 100
:y 50 :y 80
:w 10 :w 50
:h 10 :h 50
} }
:box :box
{ {
@ -20,20 +20,27 @@
:y 5 :y 5
:w 10 :w 10
:h 10 :h 10
:pps 100 :pps 150
:d :? :d :?
:color :black
} }
})) }))
(defn update [gamestate scenedata] (defn update [gamestate scenedata]
(let [box (get-in scenedata [:data :box]) (let [box (get-in scenedata [:data :box])
bumper (get-in scenedata [:data :bumper])
dir (input/dirinput) dir (input/dirinput)
box (assoc box :d dir)] box (assoc box :d dir)
mbox (objects/move-inside-gamestate
gamestate
box)]
(assoc-in scenedata (assoc-in scenedata
[:data :box] [:data :box]
(objects/move-inside-gamestate (if (objects/collide? mbox bumper)
gamestate (-> box
box)))) (objects/bump-into bumper)
(assoc :color :red))
(assoc mbox :color :black)))))
(defn draw [gamestate scenedata] (defn draw [gamestate scenedata]
(let [{{:keys [bumper box]} :data} scenedata (let [{{:keys [bumper box]} :data} scenedata
@ -41,6 +48,11 @@
(let [{:keys [x y w h]} bumper] (let [{:keys [x y w h]} bumper]
(.fillRect ctx (.fillRect ctx
x y w h)) x y w h))
(let [{:keys [x y w h]} box] (let [{:keys [x y w h color]} box
ctx (:2d gamestate)]
(aset ctx "strokeStyle"
(if (= :red color)
"red"
"black"))
(.strokeRect ctx (.strokeRect ctx
x y w h)))) x y w h))))

@ -9,6 +9,23 @@
(< (+ x w) (+ cx cw)) (< (+ x w) (+ cx cw))
(< (+ y h) (+ cy ch))))) (< (+ y h) (+ cy ch)))))
(defn collide? [obj obj2]
(let [{:keys [x y w h]} obj
{ox :x oy :y ow :w oh :h} obj2]
(or
; top left corner
(and (>= x ox) (>= y oy)
(<= x (+ ox ow)) (<= y (+ oy oh)))
; top right corner
(and (>= (+ x h) ox) (>= y oy)
(<= (+ x h) (+ ox ow)) (<= y (+ oy oh)))
; bottom left corner
(and (>= x ox) (>= (+ y h) oy)
(<= x (+ ox ow)) (<= (+ y h) (+ oy oh)))
; bottom right corner
(and (>= (+ x w) ox) (>= (+ y h) oy)
(<= (+ x w) (+ ox ow)) (<= (+ y h) (+ oy oh))))))
(defn moved-object [obj pxs] (defn moved-object [obj pxs]
(let [{:keys [x y d]} obj] (let [{:keys [x y d]} obj]
(cond (cond
@ -26,14 +43,24 @@
:y (+ y pxs)) :y (+ y pxs))
:else obj))) :else obj)))
(defn bump-in-wall [obj container] (defn bump-into [obj obj2]
(let [{:keys [x y w h d]} obj
{ox :x oy :y ow :w oh :h} obj2]
(case d
:w (assoc obj :x (+ ox ow 1))
:e (assoc obj :x (dec (- ox w)))
:n (assoc obj :y (+ oy oh 1))
:s (assoc obj :y (dec (- oy h)))
obj)))
(defn bump-inside-container [obj container]
(let [{:keys [x y w h d]} obj (let [{:keys [x y w h d]} obj
{cx :x cy :y cw :w ch :h} container] {cx :x cy :y cw :w ch :h} container]
(case d (case d
:w (assoc obj :x (inc cx)) :w (assoc obj :x (inc cx))
:e (update obj :x #(- (+ cx cw) w 1)) :e (assoc obj :x (- (+ cx cw) w 1))
:n (assoc obj :y (inc cy)) :n (assoc obj :y (inc cy))
:s (update obj :y #(- (+ cy ch) h 1)) :s (assoc obj :y (- (+ cy ch) h 1))
:? obj))) :? obj)))
(defn pps->px [gamestate obj] (defn pps->px [gamestate obj]
@ -47,7 +74,7 @@
(let [moved (moved-object obj pxs)] (let [moved (moved-object obj pxs)]
(if (in? moved container) (if (in? moved container)
moved moved
(bump-in-wall obj container)))) (bump-inside-container obj container))))
(defn move-inside-gamestate [gamestate obj] (defn move-inside-gamestate [gamestate obj]
(let [pxs (pps->px gamestate obj) (let [pxs (pps->px gamestate obj)

Loading…
Cancel
Save