packages feed

sdl2-gfx (empty) → 0.2

raw patch · 14 files changed

+1589/−0 lines, 14 filesdep +basedep +bytestringdep +lifted-basesetup-changed

Dependencies added: base, bytestring, lifted-base, linear, monad-control, sdl2, sdl2-gfx, template-haskell, text, transformers, vector

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Siniša Biđin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Example.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad        (when)+import Data.Vector.Storable (fromList)+import Foreign.C.Types      (CInt)+import Linear               (V2(..), V4(..))+import SDL                  (($=))++import qualified SDL+import qualified SDL.Framerate+import qualified SDL.Primitive++red :: SDL.Primitive.Color+red = V4 255 50 50 255++green :: SDL.Primitive.Color+green = V4 50 255 50 255++blue :: SDL.Primitive.Color+blue = V4 50 50 255 255++black :: SDL.Primitive.Color+black = V4 0 0 0 255++white :: SDL.Primitive.Color+white = V4 255 255 255 255++main :: IO ()+main = do++  SDL.initialize [SDL.InitVideo]+  w <- SDL.createWindow "sdl2-gfx-example" SDL.defaultWindow+  r <- SDL.createRenderer w (-1) SDL.defaultRenderer+  SDL.showWindow w++  let fps   = 60  -- How fast do we aim to render?+  let limit = 120 -- How many frames will we render?++  SDL.Framerate.with fps $ loopFor limit r++  SDL.destroyWindow w+  SDL.quit++loopFor :: CInt -> SDL.Renderer -> SDL.Framerate.Manager -> IO ()+loopFor limit r fpsm = loop'+  where+    loop' :: IO ()+    loop' = do++      -- How many frames have we drawn until now?+      frames <- fromIntegral `fmap` SDL.Framerate.count fpsm++      -- Clear the screen!+      SDL.rendererDrawColor r $= black+      SDL.clear r++      -- Run each of the functions from SDL.Primitives.+      -- For added chaos, move everything by framecount.+      SDL.Primitive.pixel r (V2 (100+frames) 100) green+      SDL.Primitive.line r (V2 10 10) (V2 (25+frames) (25+frames)) red+      SDL.Primitive.thickLine r (V2 10 15) (V2 (10+frames) 120) 3 white+      SDL.Primitive.smoothLine r (V2 100 frames) (V2 300 (20-frames)) white+      SDL.Primitive.horizontalLine r (V2 40 (350+frames)) (2*frames) blue+      SDL.Primitive.verticalLine r (V2 40 (350+frames)) (5*frames) green+      SDL.Primitive.rectangle r (V2 (75+frames) (90+frames)) (V2 (100+frames) (100+frames)) white+      SDL.Primitive.roundRectangle r (V2 110 300) (V2 (170+frames) (400+frames)) 10 white+      SDL.Primitive.fillRectangle r (V2 (175+frames) (190+frames)) (V2 (200+frames) (200+frames)) red+      SDL.Primitive.fillRoundRectangle r (V2 120 310) (V2 (160+frames) (390+frames)) 5 blue+      SDL.Primitive.arc r (V2 320 240) 100 0 (frames*360 `div` limit) red+      SDL.Primitive.circle r (V2 320 240) 80 white+      SDL.Primitive.smoothCircle r (V2 320 240) 70 white+      SDL.Primitive.fillCircle r (V2 320 240) 50 white+      SDL.Primitive.ellipse r (V2 500 200) 70 (10+frames) green+      SDL.Primitive.smoothEllipse r (V2 500 200) 60 (5+frames) white+      SDL.Primitive.fillEllipse r (V2 500 200) 40 frames blue+      SDL.Primitive.pie r (V2 640 500) 80 0 (frames*360 `div` limit) red+      SDL.Primitive.fillPie r (V2 640 400) 60 0 (frames*360 `div` limit) blue+      SDL.Primitive.triangle r (V2 700 10) (V2 750 10) (V2 750 60) red+      SDL.Primitive.smoothTriangle r (V2 700 5) (V2 740 5) (V2 740 70) green+      SDL.Primitive.fillTriangle r (V2 650 40) (V2 690 50) (V2 700 90) blue+      SDL.Primitive.polygon r (fromList [100, 220, 430, 317, 50]) (fromList [30, 70, 200, 300, 500]) green+      SDL.Primitive.smoothPolygon r (fromList $ map (+40) [100, 220, 430, 317, 50]) (fromList $ map (+40) [30, 70, 200, 300, 500]) blue+      SDL.Primitive.fillPolygon r (fromList $ map (+300) [100, 220, 430, 317, 50]) (fromList $ map (+400) [30, 70, 200, 300, 500]) $ V4 200 20 20 128+      SDL.Primitive.bezier r (fromList [70, 43, 23, 388, 239, 584, 444]) (fromList [546, 323, 110, 5, 483, 673, 332]) 5 $ V4 255 0 255 255++      SDL.present r++      SDL.Framerate.delay_ fpsm -- Delay to keep framerate constant.++      when (frames < limit) loop'
+ sdl2-gfx.cabal view
@@ -0,0 +1,75 @@+name:                sdl2-gfx+version:             0.2+synopsis:            Bindings to SDL2_gfx.+description:         Haskell bindings to SDL2_gfx.+license:             MIT+license-file:        LICENSE+author:              Siniša Biđin <sinisa@bidin.eu>+maintainer:          Siniša Biđin <sinisa@bidin.eu>+copyright:           Copyright © 2015 Siniša Biđin+category:            Graphics, Foreign+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/sbidin/sdl2-gfx.git++library+  ghc-options: -Wall++  exposed-modules:+    SDL.Primitive,+    SDL.Raw.Primitive,+    SDL.Framerate,+    SDL.Raw.Framerate,+    SDL.Rotozoom,+    SDL.Raw.Rotozoom,+    SDL.ImageFilter,+    SDL.Raw.ImageFilter++  other-modules:+    SDL.ExceptionHelper,+    SDL.Raw.Helper++  hs-source-dirs:+    src++  pkgconfig-depends:+    sdl2 >= 2.0.3,+    SDL2_gfx >= 1.0.1++  build-depends:+    base             >= 4.7 && < 5,+    bytestring,+    lifted-base      >= 0.2,+    linear           >= 1.10.1.2,+    monad-control    >= 1.0,+    sdl2             >= 2.0,+    template-haskell,+    text,+    transformers     >= 0.2,+    vector           >= 0.10.9.0++  default-language:+    Haskell2010++flag example+  description: Build the example executable+  default:     True++executable sdl2-gfx-example+  ghc-options: -Wall+  hs-source-dirs: example+  main-is: Example.hs+  default-language: Haskell2010++  if flag(example)+    build-depends:+      base     >= 4.7 && < 5,+      linear   >= 1.10.1.2,+      sdl2     >= 2.0,+      sdl2-gfx,+      vector   >= 0.10.9.0+  else+    buildable: False
+ src/SDL/ExceptionHelper.hs view
@@ -0,0 +1,21 @@+module SDL.ExceptionHelper where++import Control.Exception       (throwIO)+import Control.Monad           (when)+import Control.Monad.IO.Class  (MonadIO, liftIO)+import Data.ByteString         (packCString)+import Data.Text               (Text)+import Data.Text.Encoding      (decodeUtf8)+import SDL                     (SDLException(SDLCallFailed))+import SDL.Raw                 (getError)++throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m ()+throwIfNeg_ = throwIf_ (< 0)++throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m ()+throwIf_ f caller rawf act = do+  result <- act+  liftIO $ when (f result) $ do+    err <- decodeUtf8 <$> (packCString =<< getError)+    throwIO $ SDLCallFailed caller rawf err+  return ()
+ src/SDL/Framerate.hs view
@@ -0,0 +1,114 @@+{-|++Module      : SDL.Framerate+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Bindings to @SDL2_gfx@'s framerate management functionality. These functions+should allow you to set, manage and query a target application framerate.++-}+++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase       #-}++module SDL.Framerate+  ( Framerate+  , Manager(..)+  , with+  , manager+  , set+  , delay+  , delay_+  , minimum+  , maximum+  , get+  , count+  , destroyManager+  ) where++import Control.Exception.Lifted    (bracket)+import Control.Monad               (void)+import Control.Monad.IO.Class      (MonadIO, liftIO)+import Control.Monad.Trans.Control (MonadBaseControl)+import Foreign.Marshal.Alloc       (malloc, free)+import Foreign.Ptr                 (Ptr)+import Prelude              hiding (minimum, maximum)++import qualified SDL.Raw.Framerate++-- | A framerate manager, counting frames and keeping track of time delays+-- necessary to reach a certain target framerate.+newtype Manager = Manager (Ptr SDL.Raw.Framerate.Manager)+  deriving (Eq, Show)++-- | A certain number of frames per second.+type Framerate = Int++-- | Creates a new framerate 'Manager', sets a target 'Framerate' and frees the+-- 'Manager' after the inner computation ends.+--+-- This is the recommended way to create a 'Manager'.+with+  :: (MonadBaseControl IO m, MonadIO m) => Framerate -> (Manager -> m a) -> m a+with fps act =+  bracket manager destroyManager $ \m ->+    set m fps >> act m++-- | Create a new framerate 'Manager' using the default settings.+--+-- You have to take care to call 'destroyManager' yourself. It's recommended to+-- use 'with' instead.+manager :: MonadIO m => m Manager+manager =+  fmap Manager . liftIO $ do+    ptr <- malloc+    SDL.Raw.Framerate.init ptr+    return ptr++-- | The smallest allowed framerate.+minimum :: Framerate+minimum = SDL.Raw.Framerate.FPS_LOWER_LIMIT++-- | The largest allowed framerate.+maximum :: Framerate+maximum = SDL.Raw.Framerate.FPS_UPPER_LIMIT++-- | Set a target framerate and reset delay interpolation.+--+-- Note that the given framerate must be within the allowed range -- otherwise+-- the minimum or maximum allowed framerate is used instead.+set :: MonadIO m => Manager -> Framerate -> m ()+set (Manager ptr) = void . set' . min maximum . max minimum+  where+    set' = SDL.Raw.Framerate.setFramerate ptr . fromIntegral++-- | Get the currently set framerate.+get :: MonadIO m => Manager -> m Framerate+get (Manager ptr) = fromIntegral <$> SDL.Raw.Framerate.getFramerate ptr++-- | Returns the framecount. Each time 'delay' is called, a frame is counted.+count :: MonadIO m => Manager -> m Int+count (Manager ptr) = fromIntegral <$> SDL.Raw.Framerate.getFramecount ptr++-- | Generate and apply a delay in order to maintain a constant target+-- framerate.+--+-- This should be called once per rendering loop.+--+-- Delay will automatically be set to zero if the computer cannot keep up (if+-- rendering is too slow). Returns the number of milliseconds since the last+-- time 'delay' was called (possibly zero).+delay :: MonadIO m => Manager -> m Int+delay (Manager ptr) = fromIntegral <$> SDL.Raw.Framerate.framerateDelay ptr++-- | Same as 'delay', but doesn't return the time since it was last called.+delay_ :: MonadIO m => Manager -> m ()+delay_ = void . delay++-- | Frees a framerate manager. Make sure not to use it again after this action.+destroyManager :: MonadIO m => Manager -> m ()+destroyManager (Manager ptr) = liftIO $ free ptr
+ src/SDL/ImageFilter.hs view
@@ -0,0 +1,217 @@+{-|++Module      : SDL.ImageFilter+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Bindings to @SDL2_gfx@'s MMX image filter functionality.++-}++module SDL.ImageFilter+  (+  -- * Query MMX+    usingMMX+  , disableMMX+  , enableMMX++  -- * Vector operations+  , add+  , mean+  , sub+  , absDiff+  , mult+  , multNor+  , multDivBy2+  , multDivBy4+  , bitAnd+  , bitOr+  , div+  , bitNegation+  , addByte+  , addUInt+  , addByteToHalf+  , subByte+  , subUInt+  , shiftRight+  , shiftRightUInt+  , multByByte+  , shiftRightAndMultByByte+  , shiftLeftByte+  , shiftLeftUInt+  , shiftLeft+  , binarizeUsingThreshold+  , clipToRange+  , normalizeLinear+  ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Word              (Word8)+import Prelude         hiding (div)+import Foreign.C.Types        (CUChar, CUInt, CInt)+import Foreign.Ptr            (castPtr, Ptr)+import Foreign.Marshal.Alloc  (mallocBytes, finalizerFree)+import Foreign.ForeignPtr     (newForeignPtr)+import Data.Vector.Storable   (Vector)+import System.IO.Unsafe       (unsafePerformIO)++import qualified SDL.Raw.ImageFilter+import qualified Data.Vector.Storable as V++-- | Are we using MMX code?+usingMMX :: MonadIO m => m Bool+usingMMX = (==1) <$> SDL.Raw.ImageFilter.mmxDetect++-- | Disable MMX, use non-MMX code instead.+disableMMX :: MonadIO m => m ()+disableMMX = liftIO SDL.Raw.ImageFilter.mmxOff++-- | Use MMX code if available.+enableMMX :: MonadIO m => m ()+enableMMX = liftIO SDL.Raw.ImageFilter.mmxOn++{-# INLINE minLen #-}+minLen :: Integral a => Vector Word8 -> Vector Word8 -> a+minLen x = fromIntegral . min (V.length x) . V.length++mallocVector :: Int -> (Ptr CUChar -> IO a) -> IO (Vector Word8)+mallocVector len act = do+  p <- mallocBytes len+  _ <- act p -- TODO: Check for errors?+  f <- newForeignPtr finalizerFree $ castPtr p+  return $ V.unsafeFromForeignPtr0 f len++binary+  :: (Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt) ->+     (Vector Word8 -> Vector Word8 -> Vector Word8)+binary f x y =+  unsafePerformIO .+    V.unsafeWith x $ \x' ->+      V.unsafeWith y $ \y' ->+        mallocVector (minLen x y) $ \z' ->+          f (castPtr x') (castPtr y') z' (minLen x y)++add :: Vector Word8 -> Vector Word8 -> Vector Word8+add = binary SDL.Raw.ImageFilter.add++mean :: Vector Word8 -> Vector Word8 -> Vector Word8+mean = binary SDL.Raw.ImageFilter.mean++sub :: Vector Word8 -> Vector Word8 -> Vector Word8+sub = binary SDL.Raw.ImageFilter.sub++absDiff :: Vector Word8 -> Vector Word8 -> Vector Word8+absDiff = binary SDL.Raw.ImageFilter.absDiff++mult :: Vector Word8 -> Vector Word8 -> Vector Word8+mult = binary SDL.Raw.ImageFilter.mult++multNor :: Vector Word8 -> Vector Word8 -> Vector Word8+multNor = binary SDL.Raw.ImageFilter.multNor++multDivBy2 :: Vector Word8 -> Vector Word8 -> Vector Word8+multDivBy2 = binary SDL.Raw.ImageFilter.multDivBy2++multDivBy4 :: Vector Word8 -> Vector Word8 -> Vector Word8+multDivBy4 = binary SDL.Raw.ImageFilter.multDivBy4++bitAnd :: Vector Word8 -> Vector Word8 -> Vector Word8+bitAnd = binary SDL.Raw.ImageFilter.bitAnd++bitOr :: Vector Word8 -> Vector Word8 -> Vector Word8+bitOr = binary SDL.Raw.ImageFilter.bitOr++div :: Vector Word8 -> Vector Word8 -> Vector Word8+div = binary SDL.Raw.ImageFilter.div++{-# INLINE cuchar #-}+cuchar :: Word8 -> CUChar+cuchar = fromIntegral++bitNegation :: Vector Word8 -> Vector Word8+bitNegation x =+  unsafePerformIO .+    V.unsafeWith x $ \x' ->+      mallocVector (V.length x) $ \y' ->+        SDL.Raw.ImageFilter.bitNegation+          (castPtr x') y' (fromIntegral $ V.length x)++binaryByte+  :: (Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt) ->+     (Word8 -> Vector Word8 -> Vector Word8)+binaryByte f b x =+  unsafePerformIO .+    V.unsafeWith x $ \x' ->+      mallocVector (V.length x) $ \y' ->+        f (castPtr x') y' (fromIntegral $ V.length x) (cuchar b)++addByte :: Word8 -> Vector Word8 -> Vector Word8+addByte = binaryByte SDL.Raw.ImageFilter.addByte++addByteToHalf :: Word8 -> Vector Word8 -> Vector Word8+addByteToHalf = binaryByte SDL.Raw.ImageFilter.addByteToHalf++subByte :: Word8 -> Vector Word8 -> Vector Word8+subByte = binaryByte SDL.Raw.ImageFilter.subByte++shiftRight :: Word8 -> Vector Word8 -> Vector Word8+shiftRight = binaryByte SDL.Raw.ImageFilter.shiftRight++multByByte :: Word8 -> Vector Word8 -> Vector Word8+multByByte = binaryByte SDL.Raw.ImageFilter.multByByte++shiftLeftByte :: Word8 -> Vector Word8 -> Vector Word8+shiftLeftByte = binaryByte SDL.Raw.ImageFilter.shiftLeftByte++shiftRightUInt :: Word8 -> Vector Word8 -> Vector Word8+shiftRightUInt = binaryByte SDL.Raw.ImageFilter.shiftRightUInt++shiftLeftUInt :: Word8 -> Vector Word8 -> Vector Word8+shiftLeftUInt = binaryByte SDL.Raw.ImageFilter.shiftLeftUInt++shiftLeft :: Word8 -> Vector Word8 -> Vector Word8+shiftLeft = binaryByte SDL.Raw.ImageFilter.shiftLeft++binarizeUsingThreshold :: Word8 -> Vector Word8 -> Vector Word8+binarizeUsingThreshold = binaryByte SDL.Raw.ImageFilter.binarizeUsingThreshold++binaryUInt+  :: (Ptr CUChar -> Ptr CUChar -> CUInt -> CUInt -> IO CInt) ->+     (CUInt -> Vector Word8 -> Vector Word8)+binaryUInt f i x =+  unsafePerformIO .+    V.unsafeWith x $ \x' ->+      mallocVector (V.length x) $ \y' ->+        f (castPtr x') y' (fromIntegral $ V.length x) i++addUInt :: CUInt -> Vector Word8 -> Vector Word8+addUInt = binaryUInt SDL.Raw.ImageFilter.addUInt++subUInt :: CUInt -> Vector Word8 -> Vector Word8+subUInt = binaryUInt SDL.Raw.ImageFilter.subUInt++shiftRightAndMultByByte :: Word8 -> Word8 -> Vector Word8 -> Vector Word8+shiftRightAndMultByByte s m x =+  unsafePerformIO .+    V.unsafeWith x $ \x' ->+      mallocVector (V.length x) $ \y' ->+        SDL.Raw.ImageFilter.shiftRightAndMultByByte+          (castPtr x') y' (fromIntegral $ V.length x) (cuchar s) (cuchar m)++clipToRange :: Word8 -> Word8 -> Vector Word8 -> Vector Word8+clipToRange a b x =+  unsafePerformIO .+    V.unsafeWith x $ \x' ->+      mallocVector (V.length x) $ \y' ->+        SDL.Raw.ImageFilter.clipToRange+          (castPtr x') y' (fromIntegral $ V.length x) (cuchar a) (cuchar b)++normalizeLinear :: CInt -> CInt -> CInt -> CInt -> Vector Word8 -> Vector Word8+normalizeLinear cmin cmax nmin nmax x =+  unsafePerformIO .+    V.unsafeWith x $ \x' ->+      mallocVector (V.length x) $ \y' ->+        SDL.Raw.ImageFilter.normalizeLinear+          (castPtr x') y' (fromIntegral $ V.length x) cmin cmax nmin nmax
+ src/SDL/Primitive.hs view
@@ -0,0 +1,335 @@+{-|++Module      : SDL.Primitive+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Bindings to @SDL2_gfx@'s primitives drawing functionality. These functions+should allow you to render various simple shapes such as lines, ellipses or+polygons.++All of the monadic functions within this module are capable of throwing an+'SDL.Exception.SDLException' if they encounter an error.++-}++{-# LANGUAGE LambdaCase         #-}+{-# LANGUAGE OverloadedStrings  #-}++module SDL.Primitive+  (+  -- * Pixels+    Pos+  , Color+  , pixel++  -- * Lines+  , line+  , Length+  , horizontalLine+  , verticalLine+  , smoothLine+  , Width+  , thickLine++  -- * Triangles+  , triangle+  , smoothTriangle+  , fillTriangle++  -- * Rectangles+  , rectangle+  , Radius+  , roundRectangle+  , fillRectangle+  , fillRoundRectangle++  -- * Curves+  , Start+  , End+  , arc+  , circle+  , smoothCircle+  , fillCircle+  , ellipse+  , smoothEllipse+  , fillEllipse+  , pie+  , fillPie+  , Steps+  , bezier++  -- * Polygons+  , polygon+  , smoothPolygon+  , fillPolygon+  ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Int               (Int16)+import Data.Vector.Storable   (Vector, unsafeWith, length)+import Data.Word              (Word8)+import Foreign.C.Types        (CInt)+import Linear                 (V4(..), V2(..))+import Prelude         hiding (length)+import SDL.ExceptionHelper    (throwIfNeg_)+import SDL.Internal.Types     (Renderer(..))++import qualified SDL.Raw.Primitive++-- | A position as a two-dimensional vector.+type Pos = V2 CInt++-- | A color as an RGBA byte-vector.+type Color = V4 Word8++-- The SDL2_gfx API expects Int16, while SDL2 uses CInt. We could force Int16,+-- but that would cause issues for the end user always having to convert+-- between vector types in order to use both SDL2 and SDL2_gfx. I'm therefore+-- currently opting to accept CInt and convert to Int16, overflows be damned.+cint :: CInt -> Int16+cint = fromIntegral++-- | Renders a single pixel at a given position.+pixel :: MonadIO m => Renderer -> Pos -> Color -> m ()+pixel (Renderer p) (V2 x y) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.pixel" "pixelRGBA" $+    SDL.Raw.Primitive.pixel+      p (cint x) (cint y) r g b a++-- | Renders a line between two points.+line :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()+line (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.line" "lineRGBA" $+    SDL.Raw.Primitive.line+      p (cint x) (cint y) (cint u) (cint v) r g b a++-- | A width in pixels.+type Width = CInt++-- | Same as 'line', but the rendered line is of a given 'Width'.+thickLine :: MonadIO m => Renderer -> Pos -> Pos -> Width -> Color -> m ()+thickLine (Renderer p) (V2 x y) (V2 u v) w (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.thickLine" "thickLineRGBA" $+    SDL.Raw.Primitive.thickLine+      p (cint x) (cint y) (cint u) (cint v) (cint w) r g b a++-- | Renders an anti-aliased line between two points.+smoothLine :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()+smoothLine (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.smoothLine" "aalineRGBA" $+    SDL.Raw.Primitive.aaLine+      p (cint x) (cint y) (cint u) (cint v) r g b a++-- | A length in pixels.+type Length = CInt++-- | Renders a horizontal line of a certain 'Length', its left and starting+-- point corresponding to a given 'Pos'.+horizontalLine :: MonadIO m => Renderer -> Pos -> Length -> Color -> m ()+horizontalLine (Renderer p) (V2 x y) w (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.horizontalLine" "hlineRGBA" $+    SDL.Raw.Primitive.hline+      p (cint x) (cint $ x + w) (cint y) r g b a++-- | Renders a vertical line of a certain 'Length', its top and starting point+-- corresponding to a given 'Pos'.+verticalLine :: MonadIO m => Renderer -> Pos -> Length -> Color -> m ()+verticalLine (Renderer p) (V2 x y) h (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.verticalLine" "vlineRGBA" $+    SDL.Raw.Primitive.vline+      p (cint x) (cint y) (cint $ y + h) r g b a++-- | Renders a transparent rectangle spanning two points, bordered by a line of+-- a given 'Color'.+rectangle :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()+rectangle (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.rectangle" "rectangleRGBA" $+    SDL.Raw.Primitive.rectangle+      p (cint x) (cint y) (cint u) (cint v) r g b a++-- | A radius in pixels.+type Radius = CInt++-- | Same as 'rectangle', but the rectangle's corners are rounded.+--+-- Control the roundness using the 'Radius' argument, defining the radius of+-- the corner arcs.+roundRectangle :: MonadIO m => Renderer -> Pos -> Pos -> Radius -> Color -> m ()+roundRectangle (Renderer p) (V2 x y) (V2 u v) rad (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.roundRectangle" "roundedRectangleRGBA" $+    SDL.Raw.Primitive.roundedRectangle+      p (cint x) (cint y) (cint u) (cint v) (cint rad) r g b a++-- | Same as 'rectangle', but the rectangle is filled by the given 'Color'.+fillRectangle :: MonadIO m => Renderer -> Pos -> Pos -> Color -> m ()+fillRectangle (Renderer p) (V2 x y) (V2 u v) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.fillRectangle" "boxRGBA" $+    SDL.Raw.Primitive.box+      p (cint x) (cint y) (cint u) (cint v) r g b a++-- | Same as 'roundRectangle', but the rectangle is filled by the given 'Color'.+fillRoundRectangle :: MonadIO m => Renderer -> Pos -> Pos -> Radius -> Color -> m ()+fillRoundRectangle (Renderer p) (V2 x y) (V2 u v) rad (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.fillRoundRectangle" "roundedBoxRGBA" $+    SDL.Raw.Primitive.roundedBox+      p (cint x) (cint y) (cint u) (cint v) (cint rad) r g b a++-- | A starting position in degrees.+type Start = CInt++-- | An ending position in degrees.+type End = CInt++-- | Render an arc, its 'Pos' being its center.+--+-- The 'Start' and 'End' arguments define the starting and ending points of the+-- arc in degrees, zero degrees being south and increasing counterclockwise.+arc :: MonadIO m => Renderer -> Pos -> Radius -> Start -> End -> Color -> m ()+arc (Renderer p) (V2 x y) rad start end (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.arc" "arcRGBA" $+    SDL.Raw.Primitive.arc+      p (cint x) (cint y) (cint rad) (cint start) (cint end) r g b a++-- | Renders a transparent circle, bordered by a line of a given 'Color'.+circle :: MonadIO m => Renderer -> Pos -> Radius -> Color -> m ()+circle (Renderer p) (V2 x y) rad (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.circle" "circleRGBA" $+    SDL.Raw.Primitive.circle+      p (cint x) (cint y) (cint rad) r g b a++-- | Same as 'circle', but fills it with the given 'Color' instead.+fillCircle :: MonadIO m => Renderer -> Pos -> Radius -> Color -> m ()+fillCircle (Renderer p) (V2 x y) rad (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.filledCircle" "filledCircleRGBA" $+    SDL.Raw.Primitive.filledCircle+      p (cint x) (cint y) (cint rad) r g b a++-- | Same as 'circle', but the border is anti-aliased.+smoothCircle :: MonadIO m => Renderer -> Pos -> Radius -> Color -> m ()+smoothCircle (Renderer p) (V2 x y) rad (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.aaCircle" "aacircleRGBA" $+    SDL.Raw.Primitive.aaCircle+      p (cint x) (cint y) (cint rad) r g b a++-- | Renders a transparent ellipse, bordered by a line of a given 'Color'.+--+-- The 'Radius' arguments are the horizontal and vertical radius of the ellipse+-- respectively, in pixels.+ellipse :: MonadIO m => Renderer -> Pos -> Radius -> Radius -> Color -> m ()+ellipse (Renderer p) (V2 x y) rx ry (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.ellipse" "ellipseRGBA" $+    SDL.Raw.Primitive.ellipse+      p (cint x) (cint y) (cint rx) (cint ry) r g b a++-- | Same as 'ellipse', but makes the border anti-aliased.+smoothEllipse :: MonadIO m => Renderer -> Pos -> Radius -> Radius -> Color -> m ()+smoothEllipse (Renderer p) (V2 x y) rx ry (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.smoothEllipse" "aaellipseRGBA" $+    SDL.Raw.Primitive.aaEllipse+      p (cint x) (cint y) (cint rx) (cint ry) r g b a++-- | Same as 'ellipse', but fills it with the given 'Color' instead.+fillEllipse :: MonadIO m => Renderer -> Pos -> Radius -> Radius -> Color -> m ()+fillEllipse (Renderer p) (V2 x y) rx ry (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.fillEllipse" "filledEllipseRGBA" $+    SDL.Raw.Primitive.filledEllipse+      p (cint x) (cint y) (cint rx) (cint ry) r g b a++-- | Render a pie outline, its 'Pos' being its center.+--+-- The 'Start' and 'End' arguments define the starting and ending points of the+-- pie in degrees, zero degrees being east and increasing counterclockwise.+pie :: MonadIO m => Renderer -> Pos -> Radius -> Start -> End -> Color -> m ()+pie (Renderer p) (V2 x y) rad start end (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.pie" "pieRGBA" $+    SDL.Raw.Primitive.pie+      p (cint x) (cint y) (cint rad) (cint start) (cint end) r g b a++-- | Same as 'pie', but fills it with the given 'Color' instead.+fillPie :: MonadIO m => Renderer -> Pos -> Radius -> Start -> End -> Color -> m ()+fillPie (Renderer p) (V2 x y) rad start end (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.fillPie" "filledPieRGBA" $+    SDL.Raw.Primitive.filledPie+      p (cint x) (cint y) (cint rad) (cint start) (cint end) r g b a++-- | How many interpolation steps when rendering a bezier curve?+--+-- The higher this is, the smoother the curve and more resource-intensive the+-- render.+type Steps = CInt++-- | Renders a bezier curve of a given 'Color'.+--+-- The input vectors contain the bezier curve's point locations on the x and+-- y-axis, respectively. The input vectors need to be the same length, and+-- those lengths must be at least 3, otherwise 'bezier' might raise an+-- 'SDL.Exception.SDLException'. The same applies for the number of+-- interpolation 'Steps': it must be at least 2.+bezier :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Steps -> Color -> m ()+bezier (Renderer p) xs ys steps (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.bezier" "bezierRGBA" $+    liftIO .+      unsafeWith xs $ \xs' ->+        unsafeWith ys $ \ys' ->+          SDL.Raw.Primitive.bezier+            p xs' ys' (fromIntegral $ length xs) steps r g b a++-- | Render a transparent triangle, its edges being of a given 'Color'.+triangle :: MonadIO m => Renderer -> Pos -> Pos -> Pos -> Color -> m ()+triangle (Renderer p) (V2 x y) (V2 u v) (V2 t z) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.triangle" "trigonRGBA" $+    SDL.Raw.Primitive.trigon+      p (cint x) (cint y) (cint u) (cint v) (cint t) (cint z) r g b a++-- | Same as 'triangle', but the edges are anti-aliased.+smoothTriangle :: MonadIO m => Renderer -> Pos -> Pos -> Pos -> Color -> m ()+smoothTriangle (Renderer p) (V2 x y) (V2 u v) (V2 t z) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.smoothTriangle" "aatrigonRGBA" $+    SDL.Raw.Primitive.aaTrigon+      p (cint x) (cint y) (cint u) (cint v) (cint t) (cint z) r g b a++-- | Same as 'triangle', but the triangle is filled with the given 'Color'+-- instead.+fillTriangle :: MonadIO m => Renderer -> Pos -> Pos -> Pos -> Color -> m ()+fillTriangle (Renderer p) (V2 x y) (V2 u v) (V2 t z) (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.fillTriangle" "filledTrigonRGBA" $+    SDL.Raw.Primitive.filledTrigon+      p (cint x) (cint y) (cint u) (cint v) (cint t) (cint z) r g b a++-- | Render a transparent polygon, its edges of a given 'Color'.+--+-- The input vectors contain the points' locations on the x and y-axis,+-- respectively. The input vectors need to be the of the same length, and the+-- lengths must be at least 3, otherwise 'polygon' might raise an+-- 'SDL.Exception.SDLException'.+polygon :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Color -> m ()+polygon (Renderer p) xs ys (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.polygon" "polygonRGBA" $+    liftIO .+      unsafeWith xs $ \xs' ->+        unsafeWith ys $ \ys' ->+          SDL.Raw.Primitive.polygon+            p xs' ys' (fromIntegral $ length xs) r g b a++-- | Same as 'polygon', but the edges are drawn anti-aliased.+smoothPolygon :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Color -> m ()+smoothPolygon (Renderer p) xs ys (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.smoothPolygon" "aapolygonRGBA" $+    liftIO .+      unsafeWith xs $ \xs' ->+        unsafeWith ys $ \ys' ->+          SDL.Raw.Primitive.aaPolygon+            p xs' ys' (fromIntegral $ length xs) r g b a++-- | Same as 'polygon', but the polygon is filled with the given 'Color'.+fillPolygon :: MonadIO m => Renderer -> Vector Int16 -> Vector Int16 -> Color -> m ()+fillPolygon (Renderer p) xs ys (V4 r g b a) =+  throwIfNeg_ "SDL.Primitive.fillPolygon" "filledPolygonRGBA" $+    liftIO .+      unsafeWith xs $ \xs' ->+        unsafeWith ys $ \ys' ->+          SDL.Raw.Primitive.filledPolygon+            p xs' ys' (fromIntegral $ length xs) r g b a
+ src/SDL/Raw/Framerate.hsc view
@@ -0,0 +1,85 @@+{-|++Module      : SDL.Raw.Framerate+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Raw bindings to the @SDL2_gfx@ library, specifically the framerate management+functionality from @SDL2_framerate.h@.++-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module SDL.Raw.Framerate+  ( Manager(..)+  , init+  , framerateDelay+  , setFramerate+  , pattern FPS_DEFAULT+  , pattern FPS_LOWER_LIMIT+  , pattern FPS_UPPER_LIMIT+  , getFramerate+  , getFramecount+  ) where++#include "SDL2_framerate.h"++import Foreign.C.Types  (CFloat(..), CInt(..))+import Foreign.Ptr      (Ptr)+import Foreign.Storable (Storable(..))+import Data.Word        (Word32)+import Prelude   hiding (init)+import SDL.Raw.Helper   (liftF)++pattern FPS_DEFAULT     = (#const FPS_DEFAULT)+pattern FPS_LOWER_LIMIT = (#const FPS_LOWER_LIMIT)+pattern FPS_UPPER_LIMIT = (#const FPS_UPPER_LIMIT)++data Manager = Manager+  { frameCount :: Word32+  , rateTicks  :: CFloat+  , baseTicks  :: Word32+  , lastTicks  :: Word32+  , rate       :: Word32+  } deriving (Eq, Show, Read)++instance Storable Manager where+  alignment = sizeOf+  sizeOf _ = (#size FPSmanager)++  peek ptr =+    Manager+      <$> (#peek FPSmanager, framecount) ptr+      <*> (#peek FPSmanager, rateticks)  ptr+      <*> (#peek FPSmanager, baseticks)  ptr+      <*> (#peek FPSmanager, lastticks)  ptr+      <*> (#peek FPSmanager, rate)       ptr++  poke ptr (Manager {..}) = do+    (#poke FPSmanager, framecount) ptr frameCount+    (#poke FPSmanager, rateticks)  ptr rateTicks+    (#poke FPSmanager, baseticks)  ptr baseTicks+    (#poke FPSmanager, lastticks)  ptr lastTicks+    (#poke FPSmanager, rate)       ptr rate++liftF "init" "SDL_initFramerate"+  [t|Ptr Manager -> IO ()|]++liftF "getFramecount" "SDL_getFramecount"+  [t|Ptr Manager -> IO CInt|]++liftF "framerateDelay" "SDL_framerateDelay"+  [t|Ptr Manager -> IO Word32|]++liftF "getFramerate" "SDL_getFramerate"+  [t|Ptr Manager -> IO CInt|]++liftF "setFramerate" "SDL_setFramerate"+  [t|Ptr Manager -> Word32 -> IO CInt|]
+ src/SDL/Raw/Helper.hs view
@@ -0,0 +1,87 @@+{-|++Module      : SDL.Raw.Helper+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Exposes a way to automatically generate a foreign import alongside its lifted,+inlined MonadIO variant. Use this to simplify the package's SDL.Raw.* modules.++-}++{-# LANGUAGE BangPatterns    #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE TemplateHaskell #-}++module SDL.Raw.Helper (liftF) where++import Control.Monad           (replicateM)+import Control.Monad.IO.Class  (MonadIO, liftIO)+import Language.Haskell.TH++-- | Given a name @fname@, a name of a C function @cname@ and the desired+-- Haskell type @ftype@, this function generates:+--+-- * A foreign import of @cname@, named as @fname'@.+-- * An always-inline MonadIO version of @fname'@, named @fname@.+liftF :: String -> String -> Q Type -> Q [Dec]+liftF fname cname ftype = do+  let f' = mkName $ fname ++ "'" -- Direct binding.+  let f  = mkName fname          -- Lifted.+  t' <- ftype                    -- Type of direct binding.++  -- The generated function accepts n arguments.+  args <- replicateM (countArgs t') $ newName "x"++  -- If the function has no arguments, then we just liftIO it directly.+  -- However, this fails to typecheck without an explicit type signature.+  -- Therefore, we include one. TODO: Can we get rid of this?+  sigd <- case args of+            [] -> ((:[]) . SigD f) `fmap` liftType t'+            _  -> return []++  return $ concat+    [+      [ ForeignD $ ImportF CCall Safe cname f' t'+      , PragmaD $ InlineP f Inline FunLike AllPhases+      ]+    , sigd+    , [ FunD f+        [ Clause+            (map VarP args)+            (NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args])+            []+        ]+      ]+    ]++-- | How many arguments does a function of a given type take?+countArgs :: Type -> Int+countArgs = count 0+  where+    count !n = \case+      (AppT (AppT ArrowT _) t) -> count (n+1) t+      (ForallT _ _ t) -> count n t+      (SigT t _)      -> count n t+      _               -> n++-- | An expression where f is applied to n arguments.+applyTo :: Name -> [Exp] -> Exp+applyTo f [] = VarE f+applyTo f es = loop (tail es) . AppE (VarE f) $ head es+  where+    loop as e = foldl AppE e as++-- | Fuzzily speaking, converts a given IO type into a MonadIO m one.+liftType :: Type -> Q Type+liftType = \case+  AppT _ t -> do+    m <- newName "m"+    return $+      ForallT+        [PlainTV m]+        [AppT (ConT ''MonadIO) $ VarT m]+        (AppT (VarT m) t)+  t -> return t
+ src/SDL/Raw/ImageFilter.hsc view
@@ -0,0 +1,144 @@+{-|++Module      : SDL.Raw.ImageFilter+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Raw bindings to the @SDL2_gfx@ library, specifically the MMX image filter+functionality from @SDL2_imageFilter.h@.++-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-# LANGUAGE TemplateHaskell #-}++module SDL.Raw.ImageFilter+  ( mmxDetect+  , mmxOff+  , mmxOn+  , add+  , mean+  , sub+  , absDiff+  , mult+  , multNor+  , multDivBy2+  , multDivBy4+  , bitAnd+  , bitOr+  , div+  , bitNegation+  , addByte+  , addUInt+  , addByteToHalf+  , subByte+  , subUInt+  , shiftRight+  , shiftRightUInt+  , multByByte+  , shiftRightAndMultByByte+  , shiftLeftByte+  , shiftLeftUInt+  , shiftLeft+  , binarizeUsingThreshold+  , clipToRange+  , normalizeLinear+  ) where++import Foreign.C.Types (CUChar(..), CInt(..), CUInt(..))+import Foreign.Ptr     (Ptr)+import Prelude  hiding (div)+import SDL.Raw.Helper  (liftF)++liftF "mmxDetect" "SDL_imageFilterMMXdetect"+  [t|IO CInt|]++liftF "mmxOff" "SDL_imageFilterMMXoff"+  [t|IO ()|]++liftF "mmxOn" "SDL_imageFilterMMXon"+  [t|IO ()|]++liftF "add" "SDL_imageFilterAdd"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "mean" "SDL_imageFilterMean"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "sub" "SDL_imageFilterSub"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "absDiff" "SDL_imageFilterAbsDiff"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "mult" "SDL_imageFilterMult"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "multNor" "SDL_imageFilterMultNor"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "multDivBy2" "SDL_imageFilterMultDivby2"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "multDivBy4" "SDL_imageFilterMultDivby4"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "bitAnd" "SDL_imageFilterBitAnd"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "bitOr" "SDL_imageFilterBitOr"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "div" "SDL_imageFilterDiv"+  [t|Ptr CUChar -> Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "bitNegation" "SDL_imageFilterBitNegation"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> IO CInt|]++liftF "addByte" "SDL_imageFilterAddByte"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "addUInt" "SDL_imageFilterAddUint"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUInt -> IO CInt|]++liftF "addByteToHalf" "SDL_imageFilterAddByteToHalf"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "subByte" "SDL_imageFilterSubByte"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "subUInt" "SDL_imageFilterSubUint"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUInt -> IO CInt|]++liftF "shiftRight" "SDL_imageFilterShiftRight"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "shiftRightUInt" "SDL_imageFilterShiftRightUint"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "multByByte" "SDL_imageFilterMultByByte"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "shiftRightAndMultByByte" "SDL_imageFilterShiftRightAndMultByByte"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> CUChar -> IO CInt|]++liftF "shiftLeftByte" "SDL_imageFilterLeftByte"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "shiftLeftUInt" "SDL_imageFilterLeftUint"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "shiftLeft" "SDL_imageFilterShiftLeft"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "binarizeUsingThreshold" "SDL_imageFilterBinarizeUsingThreshold"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> IO CInt|]++liftF "clipToRange" "SDL_imageFilterClipToRange"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CUChar -> CUChar -> IO CInt|]++liftF "normalizeLinear" "SDL_imageFilterNormalizeLinear"+  [t|Ptr CUChar -> Ptr CUChar -> CUInt -> CInt -> CInt -> CInt -> CInt -> IO CInt|]
+ src/SDL/Raw/Primitive.hsc view
@@ -0,0 +1,178 @@+{-|++Module      : SDL.Raw.Primitive+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Raw bindings to the @SDL2_gfx@ library, specifically the primitives drawing+functionality from @SDL2_gfxPrimitives.h@.++-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-# LANGUAGE TemplateHaskell #-}++module SDL.Raw.Primitive+  ( X+  , Y+  , Rad+  , R+  , N+  , G+  , B+  , A+  , pixel+  , L+  , hline+  , vline+  , line+  , aaLine+  , W+  , thickLine+  , bezier+  , rectangle+  , roundedRectangle+  , box+  , roundedBox+  , circle+  , aaCircle+  , filledCircle+  , Deg+  , arc+  , ellipse+  , aaEllipse+  , filledEllipse+  , pie+  , filledPie+  , trigon+  , aaTrigon+  , filledTrigon+  , polygon+  , aaPolygon+  , filledPolygon+  , texturedPolygon+  ) where++import Data.Int                (Int16)+import Data.Word               (Word8)+import Foreign.C.Types         (CInt(..))+import Foreign.Ptr             (Ptr)+import SDL.Raw                 (Renderer, Surface)+import SDL.Raw.Helper          (liftF)++-- | The position of something on the x-axis.+type X = Int16++-- | Same as 'X', but for the y-axis.+type Y = Int16++-- | The red color component.+type R = Word8++-- | The green color component.+type G = Word8++-- | The blue color component.+type B = Word8++-- | The alpha color component.+type A = Word8++liftF "pixel" "pixelRGBA"+  [t|Renderer -> X -> Y -> R -> G -> B -> A -> IO CInt|]++-- | A length.+type L = Int16++liftF "hline" "hlineRGBA"+  [t|Renderer -> X -> Y -> L -> R -> G -> B -> A -> IO CInt|]++liftF "vline" "vlineRGBA"+  [t|Renderer -> X -> Y -> L -> R -> G -> B -> A -> IO CInt|]++liftF "rectangle" "rectangleRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> R -> G -> B -> A -> IO CInt|]++-- | A radius.+type Rad = Int16++liftF "roundedRectangle" "roundedRectangleRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> Rad -> R -> G -> B -> A -> IO CInt|]++liftF "box" "boxRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> R -> G -> B -> A -> IO CInt|]++liftF "roundedBox" "roundedBoxRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> Rad -> R -> G -> B -> A -> IO CInt|]++liftF "line" "lineRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> R -> G -> B -> A -> IO CInt|]++liftF "aaLine" "aalineRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> R -> G -> B -> A -> IO CInt|]++-- | A width.+type W = Int16++liftF "thickLine" "thickLineRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> W -> R -> G -> B -> A -> IO CInt|]++liftF "circle" "circleRGBA"+  [t|Renderer -> X -> Y -> Rad -> R -> G -> B -> A -> IO CInt|]++-- | Degrees.+type Deg = Int16++liftF "arc" "arcRGBA"+  [t|Renderer -> X -> Y -> Rad -> Deg -> Deg -> R -> G -> B -> A -> IO CInt|]++liftF "aaCircle" "aacircleRGBA"+  [t|Renderer -> X -> Y -> Rad -> R -> G -> B -> A -> IO CInt|]++liftF "filledCircle" "filledCircleRGBA"+  [t|Renderer -> X -> Y -> Rad -> R -> G -> B -> A -> IO CInt|]++liftF "ellipse" "ellipseRGBA"+  [t|Renderer -> X -> Y -> Rad -> Rad -> R -> G -> B -> A -> IO CInt|]++liftF "aaEllipse" "aaellipseRGBA"+  [t|Renderer -> X -> Y -> Rad -> Rad -> R -> G -> B -> A -> IO CInt|]++liftF "filledEllipse" "filledEllipseRGBA"+  [t|Renderer -> X -> Y -> Rad -> Rad -> R -> G -> B -> A -> IO CInt|]++liftF "pie" "pieRGBA"+  [t|Renderer -> X -> Y -> Rad -> Deg -> Deg -> R -> G -> B -> A -> IO CInt|]++liftF "filledPie" "filledPieRGBA"+  [t|Renderer -> X -> Y -> Rad -> Deg -> Deg -> R -> G -> B -> A -> IO CInt|]++liftF "trigon" "trigonRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> X -> Y -> R -> G -> B -> A -> IO CInt|]++liftF "aaTrigon" "aatrigonRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> X -> Y -> R -> G -> B -> A -> IO CInt|]++liftF "filledTrigon" "filledTrigonRGBA"+  [t|Renderer -> X -> Y -> X -> Y -> X -> Y -> R -> G -> B -> A -> IO CInt|]++-- | How many of a certain thing, e.g. how many points, or steps.+type N = CInt++liftF "polygon" "polygonRGBA"+  [t|Renderer -> Ptr X -> Ptr Y -> N -> R -> G -> B -> A -> IO CInt|]++liftF "aaPolygon" "aapolygonRGBA"+  [t|Renderer -> Ptr X -> Ptr Y -> N -> R -> G -> B -> A -> IO CInt|]++liftF "filledPolygon" "filledPolygonRGBA"+  [t|Renderer -> Ptr X -> Ptr Y -> N -> R -> G -> B -> A -> IO CInt|]++liftF "texturedPolygon" "texturedPolygonRGBA"+  [t|Renderer -> Ptr X -> Ptr Y -> N -> Ptr Surface -> X -> Y -> R -> G -> B -> A -> IO CInt|]++liftF "bezier" "bezierRGBA"+  [t|Renderer -> Ptr X -> Ptr Y -> N -> N -> R -> G -> B -> A -> IO CInt|]
+ src/SDL/Raw/Rotozoom.hsc view
@@ -0,0 +1,64 @@+{-|++Module      : SDL.Raw.Rotozoom+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Raw bindings to the @SDL2_gfx@ library, specifically the surface rotation and+zoom functionality from @SDL2_rotozoom.h@.++-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}++module SDL.Raw.Rotozoom+  ( pattern SMOOTHING_ON+  , pattern SMOOTHING_OFF+  , rotozoom+  , rotozoomXY+  , rotozoomSize+  , rotozoomSizeXY+  , zoom+  , zoomSize+  , shrink+  , rotate90+  ) where++#include "SDL2_rotozoom.h"++import Foreign.C.Types (CDouble(..), CInt(..))+import Foreign.Ptr     (Ptr)+import SDL.Raw.Helper  (liftF)+import SDL.Raw.Types   (Surface(..))++pattern SMOOTHING_OFF = (#const SMOOTHING_OFF)+pattern SMOOTHING_ON  = (#const SMOOTHING_ON)++liftF "rotozoom" "rotozoomSurface"+  [t|Ptr Surface -> CDouble -> CDouble -> CInt -> IO (Ptr Surface)|]++liftF "rotozoomXY" "rotozoomSurfaceXY"+  [t|Ptr Surface -> CDouble -> CDouble -> CDouble -> CInt -> IO (Ptr Surface)|]++liftF "rotozoomSize" "rotozoomSize"+  [t|CInt -> CInt -> CDouble -> CDouble -> Ptr CInt -> Ptr CInt -> IO ()|]++liftF "rotozoomSizeXY" "rotozoomSizeXY"+  [t|CInt -> CInt -> CDouble -> CDouble -> CDouble -> Ptr CInt -> Ptr CInt -> IO ()|]++liftF "zoom" "zoomSurface"+  [t|Ptr Surface -> CDouble -> CDouble -> CInt -> IO (Ptr Surface)|]++liftF "zoomSize" "zoomSize"+  [t|CInt -> CInt -> CDouble -> CDouble -> Ptr CInt -> Ptr CInt -> IO ()|]++liftF "shrink" "shrinkSurface"+  [t|Ptr Surface -> CInt -> CInt -> IO (Ptr Surface)|]++liftF "rotate90" "rotateSurface90Degrees"+  [t|Ptr Surface -> CInt -> IO (Ptr Surface)|]
+ src/SDL/Rotozoom.hs view
@@ -0,0 +1,155 @@+{-|++Module      : SDL.Rotozoom+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Maintainer  : sinisa@bidin.eu+Stability   : experimental++Bindings to @SDL2_gfx@'s surface rotation and zoom functionality.++-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase    #-}++module SDL.Rotozoom+  ( Angle+  , Zoom+  , Smooth(..)+  , rotozoom+  , rotozoomXY+  , Size+  , rotozoomSize+  , rotozoomSizeXY+  , zoom+  , zoomXY+  , zoomSize+  , zoomSizeXY+  , shrink+  , rotate90+  ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Foreign.C.Types        (CInt)+import Foreign.Marshal.Alloc  (alloca)+import Foreign.Ptr            (Ptr)+import Foreign.Storable       (peek)+import Linear                 (V2(..))+import GHC.Generics           (Generic)+import SDL                    (Surface(..))++import qualified SDL.Raw+import qualified SDL.Raw.Rotozoom++-- | Desired rotation in degrees.+type Angle = Double++-- | A dimension scaling factor.+type Zoom = Double++-- | Whether resulting 'Surface's are anti-aliased or not.+data Smooth = Smooth | Rough+  deriving (Eq, Enum, Ord, Bounded, Generic, Read, Show)++smoothToCInt :: Smooth -> CInt+smoothToCInt = \case+  Smooth -> SDL.Raw.Rotozoom.SMOOTHING_ON+  Rough  -> SDL.Raw.Rotozoom.SMOOTHING_OFF++-- | A helper for unmanaged 'Surface's, since it is not exposed by SDL itself.+unmanaged :: Ptr SDL.Raw.Surface -> Surface+unmanaged p = Surface p Nothing++-- | Rotates and zooms a 32 or 8-bit 'Surface'.+--+-- If the 'Surface' isn't 8-bit or 32-bit RGBA/ABGR, it will be converted into+-- 32-bit RGBA.+rotozoom :: MonadIO m => Surface -> Angle -> Zoom -> Smooth -> m Surface+rotozoom (Surface p _) a z s =+  unmanaged <$>+    SDL.Raw.Rotozoom.rotozoom p (realToFrac a) (realToFrac z) (smoothToCInt s)++-- | Same as 'rotozoom', but applies different horizontal and vertical scaling+-- factors.+--+-- The 'Zoom' arguments are the horizontal and vertical zoom, respectively.+rotozoomXY :: MonadIO m => Surface -> Angle -> Zoom -> Zoom -> Smooth -> m Surface+rotozoomXY (Surface p _) a zx zy s =+  unmanaged <$>+    SDL.Raw.Rotozoom.rotozoomXY+      p (realToFrac a) (realToFrac zx) (realToFrac zy) (smoothToCInt s)++-- | A surface size, packing width and height.+type Size = V2 CInt++-- | Given the 'Size' of an input 'Surface', returns the 'Size' of a 'Surface'+-- resulting from a 'rotozoom' call.+rotozoomSize :: MonadIO m => Size -> Angle -> Zoom -> m Size+rotozoomSize (V2 w h) a z =+  liftIO .+    alloca $ \w' ->+      alloca $ \h' -> do+        SDL.Raw.Rotozoom.rotozoomSize w h (realToFrac a) (realToFrac z) w' h'+        V2 <$> peek w' <*> peek h'++-- | Same as 'rotozoomSize', but for different horizontal and vertical scaling+-- factors.+rotozoomSizeXY :: MonadIO m => Size -> Angle -> Zoom -> Zoom -> m Size+rotozoomSizeXY (V2 w h) a zx zy =+  liftIO .+    alloca $ \w' ->+      alloca $ \h' -> do+        SDL.Raw.Rotozoom.rotozoomSizeXY+          w h (realToFrac a) (realToFrac zx) (realToFrac zy) w' h'+        V2 <$> peek w' <*> peek h'++{-# INLINE zoom #-}+-- | Same as 'rotozoom', but only performs the zoom.+--+-- If a 'Zoom' factor is negative, it flips the image on both axes.+zoom :: MonadIO m => Surface -> Zoom -> Smooth -> m Surface+zoom surface z = zoomXY surface z z++-- | Same as 'zoom', but applies different horizontal and vertical scaling+-- factors.+--+-- If a 'Zoom' factor is negative, it flips the image on its corresponding+-- axis.+zoomXY :: MonadIO m => Surface -> Zoom -> Zoom -> Smooth -> m Surface+zoomXY (Surface p _) zx zy s =+  unmanaged <$>+    SDL.Raw.Rotozoom.zoom p (realToFrac zx) (realToFrac zy) (smoothToCInt s)++{-# INLINE zoomSize #-}+-- | Calculates the 'Size' of a resulting 'Surface' for a 'zoom' call.+zoomSize :: MonadIO m => Size -> Zoom -> m Size+zoomSize size z = zoomSizeXY size z z++-- | Same as 'zoomSize', but for different horizontal and vertical scaling+-- factors.+zoomSizeXY :: MonadIO m => Size -> Angle -> Zoom -> m Size+zoomSizeXY (V2 w h) zx zy =+  liftIO .+    alloca $ \w' ->+      alloca $ \h' -> do+        SDL.Raw.Rotozoom.zoomSize w h (realToFrac zx) (realToFrac zy) w' h'+        V2 <$> peek w' <*> peek h'++-- | Shrink a surface by an integer ratio.+--+-- The two 'CInt' arguments are the horizontal and vertical shrinking ratios: 2+-- halves a dimension, 5 makes it a fifth of its original size etc.+--+-- The resulting 'Surface' is anti-aliased and, if the input wasn't 8-bit or+-- 32-bit, converted to a 32-bit RGBA format.+shrink :: MonadIO m => Surface -> CInt -> CInt -> m Surface+shrink (Surface p _) rx ry = unmanaged <$> SDL.Raw.Rotozoom.shrink p rx ry++-- | Given a number of clockwise rotations to perform, rotates 'Surface' in+-- increments of 90 degrees.+--+-- Since no interpolation is done, this is faster than 'rotozoomer'.+rotate90 :: MonadIO m => Surface -> Int -> m Surface+rotate90 (Surface p _) =+  fmap unmanaged . SDL.Raw.Rotozoom.rotate90 p . fromIntegral . (`rem` 4)