removed name shadowing possibilities and new angle definition

This commit is contained in:
nek0 2017-06-26 06:57:02 +02:00
parent 17822564c7
commit aeb814a86a
2 changed files with 36 additions and 34 deletions

View file

@ -114,7 +114,7 @@ withAffection AffectionConfig{..} = do
, drawCPP = cpp , drawCPP = cpp
, drawStack = [] , drawStack = []
, elapsedTime = 0 , elapsedTime = 0
, dt = 0 , deltaTime = 0
}) <$> loadState }) <$> loadState
(_, nState) <- runStateT ( A.runState $ do (_, nState) <- runStateT ( A.runState $ do
preLoop preLoop
@ -138,7 +138,7 @@ withAffection AffectionConfig{..} = do
put $ ad put $ ad
{ drawStack = [] { drawStack = []
, elapsedTime = ne , elapsedTime = ne
, dt = dt , deltaTime = dt
} }
-- poll events -- poll events
evs <- preHandleEvents =<< liftIO SDL.pollEvents evs <- preHandleEvents =<< liftIO SDL.pollEvents
@ -214,7 +214,7 @@ getElapsedTime =
getDelta :: Affection us Double getDelta :: Affection us Double
getDelta = getDelta =
dt <$> get deltaTime <$> get
quit :: Affection us () quit :: Affection us ()
quit = do quit = do

View file

@ -10,12 +10,12 @@ module Affection.Types
-- , AffectionDrawInner(..) -- , AffectionDrawInner(..)
, InitComponents(..) , InitComponents(..)
-- , Loop(..) -- , Loop(..)
, RGBA(..) -- , RGBA(..)
, DrawType(..) , DrawType(..)
, DrawRequest(..) , DrawRequest(..)
, RequestPersist(..) , RequestPersist(..)
, Angle(..) , Angle(..)
, ConvertAngle(..) -- , ConvertAngle(..)
-- | Particle system -- | Particle system
, Particle(..) , Particle(..)
, ParticleSystem(..) , ParticleSystem(..)
@ -92,7 +92,7 @@ data AffectionData us = AffectionData
, drawStride :: Int -- ^ Stride of target buffer , drawStride :: Int -- ^ Stride of target buffer
, drawCPP :: Int -- ^ Number of components per pixel , drawCPP :: Int -- ^ Number of components per pixel
, elapsedTime :: Double -- ^ Elapsed time in seconds , elapsedTime :: Double -- ^ Elapsed time in seconds
, dt :: Double -- ^ Elapsed time in seconds since last tick , deltaTime :: Double -- ^ Elapsed time in seconds since last tick
} }
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
@ -143,12 +143,12 @@ type Affection us a = AffectionState (AffectionData us) IO a
-- { runLoop :: f -> (a, f) } -- { runLoop :: f -> (a, f) }
-- deriving (Functor, Applicative, Monad, MonadState (Loop f)) -- deriving (Functor, Applicative, Monad, MonadState (Loop f))
data RGBA = RGBA -- data RGBA = RGBA
{ r :: Int -- { r :: Int
, g :: Int -- , g :: Int
, b :: Int -- , b :: Int
, a :: Int -- , a :: Int
} -- }
-- | Type for defining the draw type of draw functions -- | Type for defining the draw type of draw functions
data DrawType data DrawType
@ -159,29 +159,31 @@ data DrawType
{ lineWidth :: Int -- ^ Width of line in pixels { lineWidth :: Int -- ^ Width of line in pixels
} }
-- | Type for defining angles type Angle = Double
data Angle
= Rad Double -- ^ Angle in radians
| Deg Double -- ^ Angle in degrees
deriving (Show)
-- | Typeclass for converting Angles from 'Deg' to 'Rad' and vice versa. -- -- | Type for defining angles
class ConvertAngle a where -- data Angle
toRad :: a -> a -- Convert to 'Rad' -- = Rad Double -- ^ Angle in radians
toDeg :: a -> a -- Convert to 'Deg' -- | Deg Double -- ^ Angle in degrees
-- deriving (Show)
instance ConvertAngle Angle where --
toRad (Deg x) = Rad $ x * pi / 180 -- -- | Typeclass for converting Angles from 'Deg' to 'Rad' and vice versa.
toRad x = x -- class ConvertAngle a where
-- toRad :: a -> a -- Convert to 'Rad'
toDeg (Rad x) = Deg $ x * 180 / pi -- toDeg :: a -> a -- Convert to 'Deg'
toDeg x = x --
-- instance ConvertAngle Angle where
instance Eq Angle where -- toRad (Deg x) = Rad $ x * pi / 180
(==) (Deg x) (Deg y) = x == y -- toRad x = x
(==) (Rad x) (Rad y) = x == y --
(==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry -- toDeg (Rad x) = Deg $ x * 180 / pi
(==) rx@(Rad _) dy@(Deg _) = toDeg rx == dy -- toDeg x = x
--
-- instance Eq Angle where
-- (==) (Deg x) (Deg y) = x == y
-- (==) (Rad x) (Rad y) = x == y
-- (==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry
-- (==) rx@(Rad _) dy@(Deg _) = toDeg rx == dy
-- | A single particle -- | A single particle
data Particle = Particle data Particle = Particle