diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index 38356c3..b880521 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/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 *) <$> diff --git a/src/Classes/Physics/Mass.hs b/src/Classes/Physics/Mass.hs index f382865..d05c3e6 100644 --- a/src/Classes/Physics/Mass.hs +++ b/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 diff --git a/src/Map.hs b/src/Map.hs index 9ec933a..3c0ba90 100644 --- a/src/Map.hs +++ b/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 diff --git a/src/Renderer.hs b/src/Renderer.hs index cd498cd..8b8245f 100644 --- a/src/Renderer.hs +++ b/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 diff --git a/src/Types/Application.hs b/src/Types/Application.hs index 8e50bc5..a3fd388 100644 --- a/src/Types/Application.hs +++ b/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 diff --git a/src/Types/Graphics/VertexBuffer.hs b/src/Types/Graphics/VertexBuffer.hs index bc5590e..848a5a2 100644 --- a/src/Types/Graphics/VertexBuffer.hs +++ b/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 diff --git a/src/Types/Player.hs b/src/Types/Player.hs index bce369f..72c8680 100644 --- a/src/Types/Player.hs +++ b/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) diff --git a/src/Types/Texture.hs b/src/Types/Texture.hs index 0f6040e..c1e63d3 100644 --- a/src/Types/Texture.hs +++ b/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