things can bump into things

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

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

@ -9,6 +9,23 @@
(< (+ x w) (+ cx cw))
(< (+ 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]
(let [{:keys [x y d]} obj]
(cond
@ -26,14 +43,24 @@
:y (+ y pxs))
: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
{cx :x cy :y cw :w ch :h} container]
(case d
: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))
:s (update obj :y #(- (+ cy ch) h 1))
:s (assoc obj :y (- (+ cy ch) h 1))
:? obj)))
(defn pps->px [gamestate obj]
@ -47,7 +74,7 @@
(let [moved (moved-object obj pxs)]
(if (in? moved container)
moved
(bump-in-wall obj container))))
(bump-inside-container obj container))))
(defn move-inside-gamestate [gamestate obj]
(let [pxs (pps->px gamestate obj)

Loading…
Cancel
Save