packages feed

sdl2 2.5.3.1 → 2.5.3.2

raw patch · 21 files changed

+166/−57 lines, 21 filesdep ~textdep ~transformers

Dependency ranges changed: text, transformers

Files

ChangeLog.md view
@@ -1,3 +1,13 @@+2.5.3.2+=======++* Added high-level binding for `setWindowIcon`.+* Raised `text` upper bound to 2.0.+* Fixed and optimized even polling for SDL 2.0.20.+* `copyExF` and related are under a package flag now.+  Turn on `recent-ish` if you have at least 2.0.10.+* Removed misleading result type from `updateTexture`.+ 2.5.3.1 =======
cbits/sdlhelper.c view
@@ -1,5 +1,16 @@ #include <string.h>+#include <stdlib.h> #include "sdlhelper.h"++int SDLHelper_GetEventBufferSize() { return 64; }+SDL_Event *SDLHelper_GetEventBuffer() {+  static SDL_Event *buffer = NULL;+  if(buffer == NULL) {+    /* leak an inconsequental amount of memory */+    buffer = calloc(SDLHelper_GetEventBufferSize(), sizeof(SDL_Event));+  }+  return buffer;+}  void SDLHelper_JoystickGetDeviceGUID (int device_index, SDL_JoystickGUID *guid) {
examples/EventWatch.hs view
@@ -14,6 +14,8 @@  import SDL +import Control.Monad (void)+ main :: IO () main = do   initializeAll@@ -28,8 +30,8 @@     , windowInitialSize     = V2 800 600     , windowVisible         = True   }-  renderer <- createRenderer window (-1) defaultRenderer-  addEventWatch $ \ev ->+  _renderer <- createRenderer window (-1) defaultRenderer+  void . addEventWatch $ \ev ->     case eventPayload ev of       WindowSizeChangedEvent sizeChangeData ->         putStrLn $ "eventWatch windowSizeChanged: " ++ show sizeChangeData
examples/UserEvents.hs view
@@ -1,6 +1,7 @@ module UserEvents where  import Control.Concurrent (myThreadId)+import Control.Monad (void) import Data.Maybe (Maybe(Nothing)) import Data.Word (Word32) import qualified Data.Text as Text@@ -26,7 +27,7 @@   case registeredEvent of     Nothing -> putStrLn "Fatal error: unable to register timer events."     Just registeredTimerEvent -> do-      addTimer 1000 $ mkTimerCb registeredTimerEvent+      void . addTimer 1000 $ mkTimerCb registeredTimerEvent       putStrLn "press q at any time to quit"       appLoop registeredTimerEvent @@ -40,7 +41,7 @@   return $ Reschedule interval  appLoop :: RegisteredEventType TimerEvent -> IO ()-appLoop (RegisteredEventType pushTimerEvent getTimerEvent) = waitEvent >>= go+appLoop (RegisteredEventType _pushTimerEvent getTimerEvent) = waitEvent >>= go   where   go :: Event -> IO ()   go ev =
examples/lazyfoo/Lesson02.hs view
@@ -2,6 +2,7 @@ module Lazyfoo.Lesson02 (main) where  import Control.Concurrent (threadDelay)+import Control.Monad (void) import Foreign.C.Types import SDL.Vect import qualified SDL@@ -20,7 +21,7 @@    helloWorld <- getDataFileName "examples/lazyfoo/hello_world.bmp" >>= SDL.loadBMP -  SDL.surfaceBlit helloWorld Nothing screenSurface Nothing+  void $ SDL.surfaceBlit helloWorld Nothing screenSurface Nothing   SDL.updateWindowSurface window    threadDelay 2000000
examples/lazyfoo/Lesson03.hs view
@@ -27,7 +27,7 @@       events <- SDL.pollEvents       let quit = elem SDL.QuitEvent $ map SDL.eventPayload events -      SDL.surfaceBlit xOut Nothing screenSurface Nothing+      void $ SDL.surfaceBlit xOut Nothing screenSurface Nothing       SDL.updateWindowSurface window        unless quit loop
examples/lazyfoo/Lesson04.hs view
@@ -56,7 +56,7 @@                            _ -> mempty)                     events -      SDL.surfaceBlit currentSurface Nothing screenSurface Nothing+      void $ SDL.surfaceBlit currentSurface Nothing screenSurface Nothing       SDL.updateWindowSurface window        unless quit (loop currentSurface)
examples/twinklebear/Lesson05.hs view
@@ -59,9 +59,12 @@   renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer    spriteSheet <- getDataFileName "examples/twinklebear/spritesheet.bmp" >>= loadTexture renderer-  let [spriteOne, spriteTwo, spriteThree, spriteFour] =-        [ SDL.Rectangle (P (V2 (x * spriteWidth) (y * spriteHeight))) (V2 spriteWidth spriteHeight)-          | x <- [0..1], y <- [0..1] ]++  let mkSprite x y = SDL.Rectangle (P (V2 (x * spriteWidth) (y * spriteHeight))) (V2 spriteWidth spriteHeight)+      spriteOne   = mkSprite 0 0+      spriteTwo   = mkSprite 0 1+      spriteThree = mkSprite 1 0+      spriteFour  = mkSprite 1 1    let loop spriteRect = do         events <- SDL.pollEvents
include/sdlhelper.h view
@@ -4,6 +4,8 @@ #include <stddef.h> #include "SDL.h" +int SDLHelper_GetEventBufferSize(void);+SDL_Event *SDLHelper_GetEventBuffer(void); void SDLHelper_JoystickGetDeviceGUID (int device_index, SDL_JoystickGUID *guid); void SDLHelper_JoystickGetGUID (SDL_Joystick *joystick, SDL_JoystickGUID *guid); void SDLHelper_JoystickGetGUIDFromString (const char *pchGUID, SDL_JoystickGUID *guid);
sdl2.cabal view
@@ -1,5 +1,5 @@ name:                sdl2-version:             2.5.3.1+version:             2.5.3.2 synopsis:            Both high- and low-level bindings to the SDL library (version 2.0.6+). description:   This package contains bindings to the SDL 2 library, in both high- and@@ -45,18 +45,25 @@ flag examples   description:       Build examples (except opengl-example)   default:           False+  manual:            True  flag opengl-example   description:       Build opengl-example   default:           False+  manual:            True  flag no-linear   description:       Do not depend on 'linear' library   default:           False   manual:            True +flag recent-ish+  description:       Use features from a more recent libsdl2 release.+  default:           True+  manual:            False+ library-  -- ghc-options: -Wall+  -- ghc-options: -Wall -Werror    exposed-modules:     SDL@@ -120,15 +127,21 @@   extra-libraries:     SDL2 -  pkgconfig-depends:-    sdl2 >= 2.0.6+  if flag(recent-ish)+    cpp-options:+      -DRECENT_ISH+    pkgconfig-depends:+      sdl2 >= 2.0.10+  else+    pkgconfig-depends:+      sdl2 >= 2.0.6    build-depends:     base >= 4.7 && < 5,     bytestring >= 0.10.4.0 && < 0.12,     exceptions >= 0.4 && < 0.11,     StateVar >= 1.1.0.0 && < 1.3,-    text >= 1.1.0.0 && < 1.3,+    text >= 1.1.0.0 && < 2.1,     transformers >= 0.2 && < 0.6,     vector >= 0.10.9.0 && < 0.13 @@ -137,6 +150,9 @@   else     build-depends:       linear >= 1.10.1.2 && < 1.22++  if impl(ghc >= 8.6)+    default-extensions: NoStarIsType    default-language:     Haskell2010
src/SDL/Audio.hs view
@@ -98,6 +98,12 @@ import Data.Traversable (Traversable) #endif +#if MIN_VERSION_base(4,12,0)+import Data.Kind (Type)+#else+# define Type *+#endif+ {-  $audioDevice@@ -213,7 +219,7 @@   audioFormatStorable FloatingBEAudio = Dict   audioFormatStorable FloatingNativeAudio = Dict -data Dict :: Constraint -> * where+data Dict :: Constraint -> Type where   Dict :: c => Dict c  -- |
src/SDL/Event.hs view
@@ -683,9 +683,9 @@ convertRaw (Raw.ControllerAxisEvent _ ts a b c) =   return (Event ts (ControllerAxisEvent (ControllerAxisEventData a b c))) convertRaw (Raw.ControllerButtonEvent t ts a b _) =-  return (Event ts +  return (Event ts            (ControllerButtonEvent-             (ControllerButtonEventData a +             (ControllerButtonEventData a                                         (fromNumber $ fromIntegral b)                                         (fromNumber t)))) convertRaw (Raw.ControllerDeviceEvent t ts a) =@@ -754,9 +754,9 @@     if n == 0       then return Nothing       else alloca $ \e -> do-             n <- Raw.pollEvent e+             n' <- Raw.pollEvent e              -- Checking 0 again doesn't hurt and it's good to be safe.-             if n == 0+             if n' == 0                then return Nothing                else fmap Just (peek e >>= convertRaw) @@ -765,11 +765,20 @@ -- Like 'pollEvent' this function should only be called in the OS thread which -- set the video mode. pollEvents :: MonadIO m => m [Event]-pollEvents =-  do e <- pollEvent-     case e of-       Nothing -> return []-       Just e' -> (e' :) <$> pollEvents+pollEvents = liftIO $ do+  Raw.pumpEvents+  peepAllEvents >>= mapM convertRaw where+    peepAllEvents = do+      numPeeped <- Raw.peepEvents+        Raw.eventBuffer+        Raw.eventBufferSize+        Raw.SDL_GETEVENT+        Raw.SDL_FIRSTEVENT+        Raw.SDL_LASTEVENT+      peeped <- peekArray (fromIntegral numPeeped) Raw.eventBuffer+      if numPeeped == Raw.eventBufferSize -- are there more events to peep?+        then (peeped ++) <$> peepAllEvents+        else return peeped  -- | Run a monadic computation, accumulating over all known 'Event's. --@@ -862,7 +871,7 @@               0 -> return $ EventPushFiltered               _ -> EventPushFailure <$> getError -        getEv (Event ts (UserEvent (UserEventData typ mWin code d1 d2))) =+        getEv (Event ts (UserEvent (UserEventData _typ mWin code d1 d2))) =           registeredEventDataToEvent (RegisteredEventData mWin code d1 d2) ts         getEv _ = return Nothing @@ -911,6 +920,6 @@  -- | Checks raw Windows for null references. getWindowFromID :: MonadIO m => Word32 -> m (Maybe Window)-getWindowFromID id = do-  rawWindow <- Raw.getWindowFromID id+getWindowFromID windowId = do+  rawWindow <- Raw.getWindowFromID windowId   return $ if rawWindow == nullPtr then Nothing else Just $ Window rawWindow
src/SDL/Hint.hs view
@@ -141,7 +141,7 @@ -- the 'HasSetter' interface is fairly relaxed - if a hint cannot be set, the -- failure will be silently discarded. For more feedback and control when setting -- hints, see 'setHintWithPriority'.-data Hint :: * -> * where+data Hint v where   HintAccelerometerAsJoystick :: Hint AccelerometerJoystickOptions   HintFramebufferAcceleration :: Hint FramebufferAccelerationOptions   HintMacCTRLClick :: Hint MacCTRLClickOptions
src/SDL/Input/Keyboard/Codes.hs view
@@ -3,6 +3,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ {-|  An enumeration of scancodes and keycodes, allowing you to pattern match on keyboard keys.
src/SDL/Input/Mouse.hs view
@@ -258,20 +258,32 @@  -- | Create a cursor using the specified bitmap data and mask (in MSB format). --+-- Use binary literals to set the masks: --+-- @+-- box8x8 =+--   [ 0b11111111+--   , 0b10000001+--   , 0b10000001+--   , 0b10000001+--   , 0b10000001+--   , 0b10000001+--   , 0b10000001+--   , 0b11111111+--   ]+-- @ createCursor :: MonadIO m-             => V.Vector Bool -- ^ Whether this part of the cursor is black. Use 'False' for white and 'True' for black.-             -> V.Vector Bool -- ^ Whether or not pixels are visible. Use 'True' for visible and 'False' for transparent.+             => V.Vector Word8 -- ^ Whether this part of the cursor is black. Use 'False' for white and 'True' for black.+             -> V.Vector Word8 -- ^ Whether or not pixels are visible. Use 'True' for visible and 'False' for transparent.              -> V2 CInt -- ^ The width and height of the cursor.              -> Point V2 CInt -- ^ The X- and Y-axis location of the upper left corner of the cursor relative to the actual mouse position              -> m Cursor createCursor dta msk (V2 w h) (P (V2 hx hy)) =     liftIO . fmap Cursor $         throwIfNull "SDL.Input.Mouse.createCursor" "SDL_createCursor" $-            V.unsafeWith (V.map (bool 0 1) dta) $ \unsafeDta ->-            V.unsafeWith (V.map (bool 0 1) msk) $ \unsafeMsk ->+            V.unsafeWith dta $ \unsafeDta ->+            V.unsafeWith msk $ \unsafeMsk ->                 Raw.createCursor unsafeDta unsafeMsk w h hx hy-  -- | Free a cursor created with 'createCursor', 'createColorCusor' and 'createSystemCursor'. --
src/SDL/Raw/Enum.hsc view
@@ -1,5 +1,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PatternSynonyms #-}++{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+ module SDL.Raw.Enum (   -- * Enumerations
src/SDL/Raw/Event.hs view
@@ -112,7 +112,9 @@   gameControllerNameForIndex,   gameControllerOpen,   gameControllerUpdate,-  isGameController+  isGameController,+  eventBuffer,+  eventBufferSize ) where  import Control.Monad.IO.Class@@ -234,6 +236,9 @@ foreign import ccall "SDL.h SDL_GameControllerOpen" gameControllerOpenFFI :: CInt -> IO GameController foreign import ccall "SDL.h SDL_GameControllerUpdate" gameControllerUpdateFFI :: IO () foreign import ccall "SDL.h SDL_IsGameController" isGameControllerFFI :: CInt -> IO Bool++foreign import ccall "sdlhelper.c SDLHelper_GetEventBufferSize" eventBufferSize :: CInt+foreign import ccall "sdlhelper.c SDLHelper_GetEventBuffer"  eventBuffer :: Ptr Event  addEventWatch :: MonadIO m => EventFilter -> Ptr () -> m () addEventWatch v1 v2 = liftIO $ addEventWatchFFI v1 v2
src/SDL/Raw/Types.hsc view
@@ -1,4 +1,6 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+ module SDL.Raw.Types (   -- * Type Aliases   -- ** Function Types@@ -66,9 +68,11 @@   Palette(..),   PixelFormat(..),   Point(..),-  FPoint(..),   Rect(..),+#ifdef RECENT_ISH+  FPoint(..),   FRect(..),+#endif   RendererInfo(..),   RWops(..),   Surface(..),@@ -1334,22 +1338,6 @@     (#poke SDL_Point, x) ptr x     (#poke SDL_Point, y) ptr y -data FPoint = FPoint-  { fPointX :: !CFloat-  , fPointY :: !CFloat-  } deriving (Eq, Show, Typeable)--instance Storable FPoint where-  sizeOf _ = (#size SDL_FPoint)-  alignment = sizeOf-  peek ptr = do-    x <- (#peek SDL_FPoint, x) ptr-    y <- (#peek SDL_FPoint, y) ptr-    return $! FPoint x y-  poke ptr (FPoint x y) = do-    (#poke SDL_FPoint, x) ptr x-    (#poke SDL_FPoint, y) ptr y- data Rect = Rect   { rectX :: !CInt   , rectY :: !CInt@@ -1372,6 +1360,24 @@     (#poke SDL_Rect, w) ptr w     (#poke SDL_Rect, h) ptr h +#ifdef RECENT_ISH++data FPoint = FPoint+  { fPointX :: !CFloat+  , fPointY :: !CFloat+  } deriving (Eq, Show, Typeable)++instance Storable FPoint where+  sizeOf _ = (#size SDL_FPoint)+  alignment = sizeOf+  peek ptr = do+    x <- (#peek SDL_FPoint, x) ptr+    y <- (#peek SDL_FPoint, y) ptr+    return $! FPoint x y+  poke ptr (FPoint x y) = do+    (#poke SDL_FPoint, x) ptr x+    (#poke SDL_FPoint, y) ptr y+ data FRect = FRect   { fRectX :: !CFloat   , fRectY :: !CFloat@@ -1393,6 +1399,8 @@     (#poke SDL_FRect, y) ptr y     (#poke SDL_FRect, w) ptr w     (#poke SDL_FRect, h) ptr h++#endif  data RendererInfo = RendererInfo   { rendererInfoName :: !CString
src/SDL/Raw/Video.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module SDL.Raw.Video (   -- * Display and Window Management   createWindow,@@ -106,7 +108,9 @@   renderClear,   renderCopy,   renderCopyEx,+#ifdef RECENT_ISH   renderCopyExF,+#endif   renderDrawLine,   renderDrawLines,   renderDrawPoint,@@ -324,7 +328,9 @@ foreign import ccall "SDL.h SDL_RenderClear" renderClearFFI :: Renderer -> IO CInt foreign import ccall "SDL.h SDL_RenderCopy" renderCopyFFI :: Renderer -> Texture -> Ptr Rect -> Ptr Rect -> IO CInt foreign import ccall "SDL.h SDL_RenderCopyEx" renderCopyExFFI :: Renderer -> Texture -> Ptr Rect -> Ptr Rect -> CDouble -> Ptr Point -> RendererFlip -> IO CInt+#ifdef RECENT_ISH foreign import ccall "SDL.h SDL_RenderCopyExF" renderCopyExFFFI :: Renderer -> Texture -> Ptr Rect -> Ptr FRect -> CDouble -> Ptr FPoint -> RendererFlip -> IO CInt+#endif foreign import ccall "SDL.h SDL_RenderDrawLine" renderDrawLineFFI :: Renderer -> CInt -> CInt -> CInt -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderDrawLines" renderDrawLinesFFI :: Renderer -> Ptr Point -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderDrawPoint" renderDrawPointFFI :: Renderer -> CInt -> CInt -> IO CInt@@ -835,9 +841,11 @@ renderCopyEx v1 v2 v3 v4 v5 v6 v7 = liftIO $ renderCopyExFFI v1 v2 v3 v4 v5 v6 v7 {-# INLINE renderCopyEx #-} +#ifdef RECENT_ISH renderCopyExF :: MonadIO m => Renderer -> Texture -> Ptr Rect -> Ptr FRect -> CDouble -> Ptr FPoint -> RendererFlip -> m CInt renderCopyExF v1 v2 v3 v4 v5 v6 v7 = liftIO $ renderCopyExFFFI v1 v2 v3 v4 v5 v6 v7 {-# INLINE renderCopyExF #-}+#endif  renderDrawLine :: MonadIO m => Renderer -> CInt -> CInt -> CInt -> CInt -> m CInt renderDrawLine v1 v2 v3 v4 v5 = liftIO $ renderDrawLineFFI v1 v2 v3 v4 v5
src/SDL/Video.hs view
@@ -33,6 +33,7 @@   , setWindowMode   , getWindowAbsolutePosition   , getWindowBordersSize+  , setWindowIcon   , setWindowPosition   , windowTitle   , windowData@@ -81,7 +82,7 @@ import Data.Bits import Data.Data (Data) import Data.Foldable-import Data.Maybe (isJust, fromMaybe)+import Data.Maybe (fromMaybe) import Data.Monoid (First(..)) import Data.Text (Text) import Data.Typeable@@ -295,6 +296,11 @@       Maximized -> Raw.setWindowFullscreen w 0 <* Raw.maximizeWindow w       Minimized -> Raw.minimizeWindow w >> return 0       Windowed -> Raw.setWindowFullscreen w 0 <* Raw.restoreWindow w++-- | Set the icon for a window.+setWindowIcon :: MonadIO m => Window -> Surface -> m ()+setWindowIcon (Window win) (Surface sfc _) =+  Raw.setWindowIcon win sfc  -- | Set the position of the window. setWindowPosition :: MonadIO m => Window -> WindowPosition -> m ()
src/SDL/Video/Renderer.hs view
@@ -23,7 +23,9 @@   , clear   , copy   , copyEx+#ifdef RECENT_ISH   , copyExF+#endif   , drawLine   , drawLines   , drawPoint@@ -120,7 +122,6 @@   ) where  import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Exception (catch, throw, SomeException, uninterruptibleMask_) import Data.Bits import Data.Data (Data) import Data.Foldable@@ -223,14 +224,13 @@               -> Maybe (Rectangle CInt) -- ^ The area to update, Nothing for entire texture               -> BS.ByteString -- ^ The raw pixel data               -> CInt -- ^ The number of bytes in a row of pixel data, including padding between lines-              -> m Texture-updateTexture tex@(Texture t) rect pixels pitch = do+              -> m ()+updateTexture (Texture t) rect pixels pitch = do   liftIO $ throwIfNeg_ "SDL.Video.updateTexture" "SDL_UpdateTexture" $     maybeWith with rect $ \rectPtr ->       let (pixelForeign, _, _) = BSI.toForeignPtr pixels       in withForeignPtr pixelForeign $ \pixelsPtr ->         Raw.updateTexture t (castPtr rectPtr) (castPtr pixelsPtr) pitch-  return tex  -- | Destroy the specified texture. --@@ -765,6 +765,7 @@                       V2 x y -> (if x then Raw.SDL_FLIP_HORIZONTAL else 0) .|.                                (if y then Raw.SDL_FLIP_VERTICAL else 0)) +#ifdef RECENT_ISH -- | Copy a portion of the texture to the current rendering target, optionally rotating it by angle around the given center and also flipping it top-bottom and/or left-right. copyExF :: MonadIO m        => Renderer -- ^ The rendering context@@ -785,6 +786,7 @@                    (case flips of                       V2 x y -> (if x then Raw.SDL_FLIP_HORIZONTAL else 0) .|.                                (if y then Raw.SDL_FLIP_VERTICAL else 0))+#endif  -- | Draw a line on the current rendering target. --