mitigate 'swamping' and hunt warnings

This commit is contained in:
nek0 2021-01-03 01:43:37 +01:00
parent 20954c0484
commit 3797869d14
8 changed files with 37 additions and 34 deletions

View File

@ -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 *) <$>

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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