mitigate 'swamping' and hunt warnings

src/Classes/Physics/Collidible.hs

@@ -31,7 +31,7 @@ class (Show c, Mass c) => Collidible c where
         (V2 m2x1 m2y1) = position m2 + fst (boundary m2) + delta2
         (V2 m2x2 m2y2) = position m2 + snd (boundary m2) + delta2
         delta1@(V2 vx1 vy1) = (dt *) <$> velocity m1
-        delta2@(V2 vx2 vy2) = (dt *) <$> velocity m2
+        delta2 = (dt *) <$> velocity m2
         dtx 0 = dt
         dtx vx =
           if vx > 0
@@ -55,9 +55,11 @@ class (Show c, Mass c) => Collidible c where
           , m2y2 < m1y2 && m2y2 > m1y1
           ]
     in
-      (if vx1 == 0 then posColl else dt > dtx vx1)
+      -- (if vx1 == 0 then posColl else dt > dtx vx1)
+      (dt > dtx vx1 || posColl)
       &&
-      (if vy1 == 0 then posColl else dt > dty vy1)
+      -- (if vy1 == 0 then posColl else dt > dty vy1)
+      (dt > dty vy1 || posColl)
 
   -- | This Function is called for every collision on both colliding objects.
   collide
@@ -78,12 +80,32 @@ elasticCollision
 elasticCollision damping mo1 mo2 =
   let (V2 v1x v1y) = velocity mo1
       (V2 v2x v2y) = velocity mo2
+      p1@(V2 p1x p1y) = position mo1
+      p2 = position mo2
+      (V2 m1x1 m1y1, V2 m1x2 m1y2) = boundary mo1
+      (V2 m2x1 m2y1, V2 m2x2 m2y2) = boundary mo2
       m1 = mass mo1
       m2 = mass mo2
       v1x' = 2 * (m1 * v1x + m2 * v2x) / (m1 + m2) - v1x
       v1y' = 2 * (m1 * v1y + m2 * v2y) / (m1 + m2) - v1y
+      (V2 dx dy) = p2 - p1
+      np = V2
+        ( p1x + if v1x == 0
+          then 0
+          else 
+            if dx < 0
+            then (abs m2x1 + abs m1x2 - abs dx)
+            else - (abs m2x2 + abs m1x1 - abs dx)
+          )
+        ( p1y + if v1y == 0
+          then 0
+          else 
+            if dy < 0
+            then (abs m2y1 + abs m1y2 - abs dy)
+            else - (abs m2y2 + abs m1y1 - abs dy)
+          )
   in
-    (velocityUpdater mo1)
+    (velocityUpdater ((positionUpdater mo1) np))
       (if m1 == recip 0
         then V2 0 0
         else (damping *) <$>

src/Classes/Physics/Mass.hs

@@ -51,7 +51,7 @@ class Mass m where
       (velocityUpdater m) vel
 
   -- | Apply velocity to mass object and thus change its position
-  -- Changes in position smaller than a pixel are ignored.
+  -- Changes in position smaller than around half a pixel per second are ignored.
   move
     :: Double -- ^ Time step duration
     -> m      -- ^ Original mass object
@@ -59,6 +59,6 @@ class Mass m where
   move dt m =
     let dpos = ((dt *) <$> velocity m)
     in
-      if quadrance dpos < 1
-      then m
-      else (positionUpdater m) (position m + dpos)
+      if quadrance dpos * sqrt 2 > dt
+      then (positionUpdater m) (position m + dpos)
+      else m

src/Map.hs

@@ -40,7 +40,7 @@ readLayer
   :: (Word, FilePath) -- ^ index and path of the layer descriptor image
   -> V2 Float         -- ^ size of Tilemap in pixels
   -> IO ((V.Vector Tile), V2 Int)
-readLayer (idx, path) (V2 tx ty) = do
+readLayer (_, path) (V2 tx ty) = do
   img <- flipVertically <$> convertRGBA8 <$> either error id <$> readImage path
   let width = imageWidth img
       height = imageHeight img

src/Renderer.hs

@@ -1,14 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Renderer where
 
-import Affection
-
-import SDL (($=), get)
-
 import qualified Graphics.Rendering.OpenGL as GL
 
-import Data.String (fromString)
-
 import Control.Concurrent.STM
 
 import Foreign.Ptr

src/Types/Application.hs

@@ -1,21 +1,14 @@
 {-# LANGUAGE ExistentialQuantification #-}
 module Types.Application where
 
-import Affection
-
 import qualified SDL
 
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.STM
 
-import qualified Data.Map.Strict as M
-
-import qualified Data.Text as T
-
 -- internal imports
 
 import Types.Subsystems
-import Types.Map
 import Types.Util
 
 import Classes.Scene

src/Types/Graphics/VertexBuffer.hs

@@ -6,7 +6,7 @@ module Types.Graphics.VertexBuffer where
 
 import qualified Graphics.Rendering.OpenGL as GL
 
-import SDL (($=), get)
+import SDL (($=))
 
 import Control.Monad.Loops (whileM_)
 
@@ -16,7 +16,6 @@ import qualified Data.Vector.Storable as VS
 
 import Linear
 
-import Foreign
 import Foreign
 import Foreign.C.Types
 import Foreign.Storable.Generic
@@ -193,7 +192,7 @@ instance VertexLayout Vertex where
 
   layoutElements _ =
     foldl
-      (\acc a@(index, count) -> 
+      (\acc (index, count) -> 
         ( index
         , GL.VertexArrayDescriptor
           count

src/Types/Player.hs

@@ -3,8 +3,6 @@ module Types.Player where
 
 import Affection as A
 
-import qualified Graphics.Rendering.OpenGL as GL
-
 import Linear
 
 import qualified Data.Vector as V
@@ -33,7 +31,7 @@ data Pituicat = Pituicat
 
 instance Drawable Pituicat where
 
-  toVertices (Pituicat pos@(V2 x y) _ _ _ tex) =
+  toVertices (Pituicat (V2 x y) _ _ _ _) =
     ( V.fromList [0, 1, 2, 2, 3, 0]
     , V.fromList
       [ newVertex
@@ -110,4 +108,4 @@ instance Collidible Pituicat where
       Debug
       ("*boing* meow! other: " <>
         fromString (show other))
-      (elasticCollision 0.1 cat other)
+      (elasticCollision 0.3 cat other)

src/Types/Texture.hs

@@ -4,8 +4,6 @@ import SDL (($=), get)
 
 import qualified Graphics.Rendering.OpenGL as GL
 
-import SDL (($=), get)
-
 import Codec.Picture
 import Codec.Picture.Extra
 
@@ -14,7 +12,6 @@ import Data.Vector.Storable (unsafeWith)
 import Linear
 
 import Foreign
-import Foreign.Ptr
 
 -- internal imports
 
@@ -32,7 +29,7 @@ instance Bindable Texture where
     GL.activeTexture $= textureSlot t
     GL.textureBinding GL.Texture2D $= Just (textureId t)
 
-  unbind t = GL.textureBinding GL.Texture2D $= Nothing
+  unbind _ = GL.textureBinding GL.Texture2D $= Nothing
 
 newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture)
 newTexture fp slot = do
@@ -74,7 +71,7 @@ newTexture fp slot = do
     return (fmap fromIntegral dimensions, tex)
 
 loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO ()
-loadTexture tex dimensions data_ =
+loadTexture _ dimensions data_ =
   let (V2 w h) = dimensions
   in  GL.texImage2D
     GL.Texture2D