From 160aa92b8b774c6efa395f05e835303615787c7e Mon Sep 17 00:00:00 2001
From: Josha von Gizycki <mail@joshavg.de>
Date: Thu, 19 Oct 2017 17:45:18 +0200
Subject: [PATCH] things can bump into things

---
 src/cljs/topdown2d/demoscene.cljs | 32 +++++++++++++++++++---------
 src/cljs/topdown2d/objects.cljs   | 35 +++++++++++++++++++++++++++----
 2 files changed, 53 insertions(+), 14 deletions(-)

diff --git a/src/cljs/topdown2d/demoscene.cljs b/src/cljs/topdown2d/demoscene.cljs
index 305f6e9..f9921ee 100644
--- a/src/cljs/topdown2d/demoscene.cljs
+++ b/src/cljs/topdown2d/demoscene.cljs
@@ -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))))
diff --git a/src/cljs/topdown2d/objects.cljs b/src/cljs/topdown2d/objects.cljs
index 10c677f..b8b0f45 100644
--- a/src/cljs/topdown2d/objects.cljs
+++ b/src/cljs/topdown2d/objects.cljs
@@ -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)