From 179e2f95169d729b9bd4e49728cded6f6843e6a8 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 20 Dec 2016 11:29:03 +0100 Subject: [PATCH] trying hard to make it better --- examples/example01.hs | 25 +++++++++++++------------ examples/example03.hs | 4 ++-- src/Affection/Types.hs | 41 ++++++++++++++++++++++++++++++++++++----- 3 files changed, 51 insertions(+), 19 deletions(-) diff --git a/examples/example01.hs b/examples/example01.hs index 2331e6f..a3358ae 100644 --- a/examples/example01.hs +++ b/examples/example01.hs @@ -116,16 +116,17 @@ load _ = do draw :: Affection UserData () draw = do traceM "drawing" - AffectionData{..} <- get - let UserData{..} = userState - liftIO $ SDL.lockSurface drawSurface - pixels <- liftIO $ SDL.surfacePixels drawSurface - let SDL.Surface rawSurfacePtr _ = drawSurface - rawSurface <- liftIO $ peek rawSurfacePtr - pixelFormat <- liftIO $ peek $ Raw.surfaceFormat rawSurface - format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8) - SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface - let (w, h) = (fromIntegral rw, fromIntegral rh) + UserData{..} <- getAffection + -- AffectionData{..} <- get + -- let UserData{..} = userState + -- -- liftIO $ SDL.lockSurface drawSurface + -- pixels <- liftIO $ SDL.surfacePixels drawSurface + -- let SDL.Surface rawSurfacePtr _ = drawSurface + -- rawSurface <- liftIO $ peek rawSurfacePtr + -- pixelFormat <- liftIO $ peek $ Raw.surfaceFormat rawSurface + -- format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8) + -- SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface + -- let (w, h) = (fromIntegral rw, fromIntegral rh) drawRect foreground (nodeGraph M.! "over") (G.RGB 1 0 0) (Line 2) (G.GeglRectangle 10 10 500 500) -- liftIO $ G.gegl_node_blit -- (nodeGraph M.! "over" :: G.GeglNode) @@ -135,8 +136,8 @@ draw = do -- pixels -- (fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w) -- [G.GeglBlitDefault] - liftIO $ SDL.unlockSurface drawSurface - liftIO $ SDL.updateWindowSurface drawWindow + -- liftIO $ SDL.unlockSurface drawSurface + -- liftIO $ SDL.updateWindowSurface drawWindow update :: Double -> AffectionState (AffectionData UserData) IO () update sec = do diff --git a/examples/example03.hs b/examples/example03.hs index 3832d41..7b579d4 100644 --- a/examples/example03.hs +++ b/examples/example03.hs @@ -117,9 +117,9 @@ update sec = do { psParts = (Particle { particleLife = life , particlePosition = (fromIntegral x, fromIntegral y) - , particleRotation = 0 + , particleRotation = Rad 0 , particleVelocity = (vx, vy) - , particlePitchRate = 0 + , particlePitchRate = Rad 0 }) : (psParts $ partsys ud) } } diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index c03c124..bca87d0 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -13,6 +13,8 @@ module Affection.Types , RGBA(..) , DrawType(..) , DrawRequest(..) + , Angle(..) + , ConvertAngle(..) -- | Particle system , Particle(..) , ParticleSystem(..) @@ -126,13 +128,42 @@ data DrawType { lineWidth :: Int -- ^ Width of line in pixels } +-- | Type for defining angles +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. +class ConvertAngle a where + toRad :: a -> a -- Convert to 'Rad' + toDeg :: a -> a -- Convert to 'Deg' + +instance ConvertAngle Angle where + toRad (Deg x) = Rad $ x * pi / 180 + toRad x = x + + toDeg (Rad x) = Deg $ x * 180 / pi + 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 data Particle = Particle - { particleLife :: Double -- ^ Time to live in seconds - , particlePosition :: (Double, Double) -- ^ Position of particle on canvas - , particleRotation :: Double -- ^ Particle rotation - , particleVelocity :: (Int, Int) -- ^ particle velocity as vector of pixels per second - , particlePitchRate :: Double -- ^ Rotational velocity of particle + { particleLife :: Double + -- ^ Time to live in seconds + , particlePosition :: (Double, Double) + -- ^ Position of particle on canvas + , particleRotation :: Angle + -- ^ Particle rotation + , particleVelocity :: (Int, Int) + -- ^ particle velocity as vector of pixels per second + , particlePitchRate :: Angle + -- ^ Rotational velocity of particle in angle per second } deriving (Show, Eq) data ParticleSystem = ParticleSystem