diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,13 @@ +2.5.4.0 +======= + +* Added missing floating point variants of render functions. +* Fixed `createCursor` masks. +* Adapted `createCursorFrom` helper from LambdaHack[1]. +* Added `pkgconfig` flag (enabled by default) to make its use optional. + +[1]: https://github.com/LambdaHack/LambdaHack/blob/7ed94b4b6c75fc46afeef01d8ac476c4598fb822/engine-src/Game/LambdaHack/Client/UI/Frontend/Sdl.hs#L421-L455 + 2.5.3.3 ======= diff --git a/sdl2.cabal b/sdl2.cabal --- a/sdl2.cabal +++ b/sdl2.cabal @@ -1,5 +1,5 @@ name: sdl2 -version: 2.5.3.3 +version: 2.5.4.0 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 @@ -61,6 +61,11 @@ description: Use features from a more recent libsdl2 release. default: True manual: False + +flag pkgconfig + description: Use pkgconfig to sort out SDL2 dependency + default: True + manual: True library -- ghc-options: -Wall -Werror @@ -130,11 +135,13 @@ if flag(recent-ish) cpp-options: -DRECENT_ISH - pkgconfig-depends: - sdl2 >= 2.0.10 + if flag(pkgconfig) + pkgconfig-depends: + sdl2 >= 2.0.10 else - pkgconfig-depends: - sdl2 >= 2.0.6 + if flag(pkgconfig) + pkgconfig-depends: + sdl2 >= 2.0.6 build-depends: base >= 4.7 && < 5, diff --git a/src/SDL/Input/Mouse.hs b/src/SDL/Input/Mouse.hs --- a/src/SDL/Input/Mouse.hs +++ b/src/SDL/Input/Mouse.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} module SDL.Input.Mouse ( -- * Relative Mouse Mode @@ -35,6 +34,7 @@ , SystemCursor(..) , activeCursor , createCursor + , createCursorFrom , freeCursor , createColorCursor , createSystemCursor @@ -45,6 +45,7 @@ import Data.Bits import Data.Bool import Data.Data (Data) +import Data.List (nub) import Data.StateVar import Data.Typeable import Data.Word @@ -257,21 +258,86 @@ setCursor = Raw.setCursor . unwrapCursor -- | Create a cursor using the specified bitmap data and mask (in MSB format). --- --- 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 +{- | Create a cursor from a bit art painting of it. + +The number of columns must be a multiple of 8. + +Symbols used: @ @ (space) - transparent, @.@ - visible black, @#@ (or anything else) - visible white. + +A minimal cursor template: +@ +source8x8 :: [[Char]] +source8x8 = + [ " " + , " " + , " " + , " " + , " " + , " " + , " " + , " " + ] +@ +-} +createCursorFrom :: MonadIO m + => Point V2 CInt -- ^ The X- and Y-axis location of the upper left corner of the cursor relative to the actual mouse position + -> [[Char]] + -> m Cursor +createCursorFrom point source = do + createCursor color mask (V2 w h) point + where + h = fromIntegral (length source) + w = case nub $ map length source of + [okay] -> + fromIntegral okay + mismatch -> + error $ "Inconsistent row widths: " <> show mismatch + + color = packBools colorBits + mask = packBools maskBits + (colorBits, maskBits) = unzip $ map charToBool $ concat source + + packBools = V.fromList . boolListToWord8List + + charToBool ' ' = (False, False) -- transparent + charToBool '.' = (True, True) -- visible black + charToBool _ = (True, False) -- visible white + + boolListToWord8List xs = + case xs of + b1 : b2 : b3 : b4 : b5 : b6 : b7 : b8 : rest -> + let + packed = + i b1 128 + + i b2 64 + + i b3 32 + + i b4 16 + + i b5 8 + + i b6 4 + + i b7 2 + + i b8 1 + in + packed : boolListToWord8List rest + [] -> + [] + _leftovers -> + error "The number of columns must be a multiple of 8." + where + i True multiple = multiple + i False _ = 0 -- | Free a cursor created with 'createCursor', 'createColorCusor' and 'createSystemCursor'. -- diff --git a/src/SDL/Raw/Video.hs b/src/SDL/Raw/Video.hs --- a/src/SDL/Raw/Video.hs +++ b/src/SDL/Raw/Video.hs @@ -108,9 +108,6 @@ renderClear, renderCopy, renderCopyEx, -#ifdef RECENT_ISH - renderCopyExF, -#endif renderDrawLine, renderDrawLines, renderDrawPoint, @@ -120,6 +117,18 @@ renderFillRect, renderFillRectEx, renderFillRects, +#ifdef RECENT_ISH + renderCopyF, + renderCopyExF, + renderDrawLineF, + renderDrawLinesF, + renderDrawPointF, + renderDrawPointsF, + renderDrawRectF, + renderDrawRectsF, + renderFillRectF, + renderFillRectsF, +#endif renderGetClipRect, renderGetLogicalSize, renderGetScale, @@ -328,9 +337,6 @@ 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 @@ -338,6 +344,18 @@ foreign import ccall "SDL.h SDL_RenderDrawRect" renderDrawRectFFI :: Renderer -> Ptr Rect -> IO CInt foreign import ccall "SDL.h SDL_RenderDrawRects" renderDrawRectsFFI :: Renderer -> Ptr Rect -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderFillRect" renderFillRectFFI :: Renderer -> Ptr Rect -> IO CInt +#ifdef RECENT_ISH +foreign import ccall "SDL.h SDL_RenderCopyF" renderCopyFFFI :: Renderer -> Texture -> Ptr Rect -> Ptr FRect -> IO CInt +foreign import ccall "SDL.h SDL_RenderCopyExF" renderCopyExFFFI :: Renderer -> Texture -> Ptr Rect -> Ptr FRect -> CDouble -> Ptr FPoint -> RendererFlip -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawLineF" renderDrawLineFFFI :: Renderer -> CFloat -> CFloat -> CFloat -> CFloat -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawLinesF" renderDrawLinesFFFI :: Renderer -> Ptr FPoint -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawPointF" renderDrawPointFFFI :: Renderer -> CFloat -> CFloat -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawPointsF" renderDrawPointsFFFI :: Renderer -> Ptr FPoint -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawRectF" renderDrawRectFFFI :: Renderer -> Ptr FRect -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawRectsF" renderDrawRectsFFFI :: Renderer -> Ptr FRect -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderFillRectF" renderFillRectFFFI :: Renderer -> Ptr FRect -> IO CInt +foreign import ccall "SDL.h SDL_RenderFillRectsF" renderFillRectsFFFI :: Renderer -> Ptr FRect -> CInt -> IO CInt +#endif foreign import ccall "sqlhelper.c SDLHelper_RenderFillRectEx" renderFillRectExFFI :: Renderer -> CInt -> CInt -> CInt -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderFillRects" renderFillRectsFFI :: Renderer -> Ptr Rect -> CInt -> IO CInt foreign import ccall "SDL.h SDL_RenderGetClipRect" renderGetClipRectFFI :: Renderer -> Ptr Rect -> IO () @@ -841,12 +859,6 @@ 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 {-# INLINE renderDrawLine #-} @@ -882,6 +894,51 @@ renderFillRects :: MonadIO m => Renderer -> Ptr Rect -> CInt -> m CInt renderFillRects v1 v2 v3 = liftIO $ renderFillRectsFFI v1 v2 v3 {-# INLINE renderFillRects #-} + +#ifdef RECENT_ISH + +renderCopyF :: MonadIO m => Renderer -> Texture -> Ptr Rect -> Ptr FRect -> m CInt +renderCopyF v1 v2 v3 v4 = liftIO $ renderCopyFFFI v1 v2 v3 v4 +{-# INLINE renderCopyF #-} + +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 #-} + +renderDrawLineF :: MonadIO m => Renderer -> CFloat -> CFloat -> CFloat -> CFloat -> m CInt +renderDrawLineF v1 v2 v3 v4 v5 = liftIO $ renderDrawLineFFFI v1 v2 v3 v4 v5 +{-# INLINE renderDrawLineF #-} + +renderDrawLinesF :: MonadIO m => Renderer -> Ptr FPoint -> CInt -> m CInt +renderDrawLinesF v1 v2 v3 = liftIO $ renderDrawLinesFFFI v1 v2 v3 +{-# INLINE renderDrawLinesF #-} + +renderDrawPointF :: MonadIO m => Renderer -> CFloat -> CFloat -> m CInt +renderDrawPointF v1 v2 v3 = liftIO $ renderDrawPointFFFI v1 v2 v3 +{-# INLINE renderDrawPointF #-} + +renderDrawPointsF :: MonadIO m => Renderer -> Ptr FPoint -> CInt -> m CInt +renderDrawPointsF v1 v2 v3 = liftIO $ renderDrawPointsFFFI v1 v2 v3 +{-# INLINE renderDrawPointsF #-} + +renderDrawRectF :: MonadIO m => Renderer -> Ptr FRect -> m CInt +renderDrawRectF v1 v2 = liftIO $ renderDrawRectFFFI v1 v2 +{-# INLINE renderDrawRectF #-} + +renderDrawRectsF :: MonadIO m => Renderer -> Ptr FRect -> CInt -> m CInt +renderDrawRectsF v1 v2 v3 = liftIO $ renderDrawRectsFFFI v1 v2 v3 +{-# INLINE renderDrawRectsF #-} + +renderFillRectF :: MonadIO m => Renderer -> Ptr FRect -> m CInt +renderFillRectF v1 v2 = liftIO $ renderFillRectFFFI v1 v2 +{-# INLINE renderFillRectF #-} + +renderFillRectsF :: MonadIO m => Renderer -> Ptr FRect -> CInt -> m CInt +renderFillRectsF v1 v2 v3 = liftIO $ renderFillRectsFFFI v1 v2 v3 +{-# INLINE renderFillRectsF #-} + +#endif + renderGetClipRect :: MonadIO m => Renderer -> Ptr Rect -> m () renderGetClipRect v1 v2 = liftIO $ renderGetClipRectFFI v1 v2 diff --git a/src/SDL/Video/Renderer.hs b/src/SDL/Video/Renderer.hs --- a/src/SDL/Video/Renderer.hs +++ b/src/SDL/Video/Renderer.hs @@ -23,9 +23,6 @@ , clear , copy , copyEx -#ifdef RECENT_ISH - , copyExF -#endif , drawLine , drawLines , drawPoint @@ -34,6 +31,18 @@ , drawRects , fillRect , fillRects +#ifdef RECENT_ISH + , copyF + , copyExF + , drawLineF + , drawLinesF + , drawPointF + , drawPointsF + , drawRectF + , drawRectsF + , fillRectF + , fillRectsF +#endif , present -- * 'Renderer' State @@ -650,6 +659,94 @@ (castPtr rp) (fromIntegral (SV.length rects)) +#ifdef RECENT_ISH + +-- | Copy a portion of the texture to the current rendering target. +copyF :: MonadIO m => Renderer -> Texture -> Maybe (Rectangle CInt) -> Maybe (Rectangle CFloat) -> m () +copyF (Renderer r) (Texture t) srcRect dstRect = liftIO $ + throwIfNeg_ "SDL.Video.copyF" "SDL_RenderCopyF" $ + maybeWith with srcRect $ \src -> + maybeWith with dstRect $ \dst -> + Raw.renderCopyF r t (castPtr src) (castPtr dst) + +-- | 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 + -> Texture -- ^ The source texture + -> Maybe (Rectangle CInt) -- ^ The source rectangle to copy, or 'Nothing' for the whole texture + -> Maybe (Rectangle CFloat) -- ^ The destination rectangle to copy to, or 'Nothing' for the whole rendering target. The texture will be stretched to fill the given rectangle. + -> CDouble -- ^ The angle of rotation in degrees. The rotation will be performed clockwise. + -> Maybe (Point V2 CFloat) -- ^ The point indicating the center of the rotation, or 'Nothing' to rotate around the center of the destination rectangle + -> V2 Bool -- ^ Whether to flip the texture on the X and/or Y axis + -> m () +copyExF (Renderer r) (Texture t) srcRect dstRect theta center flips = + liftIO $ + throwIfNeg_ "SDL.Video.copyExF" "SDL_RenderCopyExF" $ + maybeWith with srcRect $ \src -> + maybeWith with dstRect $ \dst -> + maybeWith with center $ \c -> + Raw.renderCopyExF r t (castPtr src) (castPtr dst) theta (castPtr c) + (case flips of + V2 x y -> (if x then Raw.SDL_FLIP_HORIZONTAL else 0) .|. + (if y then Raw.SDL_FLIP_VERTICAL else 0)) + +-- | Draw a line between two points on the current rendering target. +drawLineF :: MonadIO m => Renderer -> Point V2 CFloat -> Point V2 CFloat -> m () +drawLineF (Renderer r) (P (V2 x y)) (P (V2 x' y')) = liftIO $ + throwIfNeg_ "SDL.Video.drawLineF" "SDL_RenderDrawLineF" $ + Raw.renderDrawLineF r x y x' y' + +-- | Draw a series of connected lines on the current rendering target. +drawLinesF :: MonadIO m => Renderer -> SV.Vector (Point V2 CFloat) -> m () +drawLinesF (Renderer r) points = liftIO $ + throwIfNeg_ "SDL.Video.drawLinesF" "SDL_RenderDrawLinesF" $ + SV.unsafeWith points $ \p -> + Raw.renderDrawLinesF r (castPtr p) (fromIntegral (SV.length points)) + +-- | Draw a point on the current rendering target. +drawPointF :: MonadIO m => Renderer -> Point V2 CFloat -> m () +drawPointF (Renderer r) (P (V2 x y)) = liftIO $ + throwIfNeg_ "SDL.Video.drawPointF" "SDL_RenderDrawPointF" $ + Raw.renderDrawPointF r x y + +-- | Draw a collection of points on the current rendering target. +drawPointsF :: MonadIO m => Renderer -> SV.Vector (Point V2 CFloat) -> m () +drawPointsF (Renderer r) points = liftIO $ + throwIfNeg_ "SDL.Video.drawPointsF" "SDL_RenderDrawPointsF" $ + SV.unsafeWith points $ \p -> + Raw.renderDrawPointsF r (castPtr p) (fromIntegral (SV.length points)) + +-- | Draw the outline of a rectangle on the current rendering target. +drawRectF :: MonadIO m => Renderer -> Rectangle CFloat -> m () +drawRectF (Renderer r) rect = liftIO $ + throwIfNeg_ "SDL.Video.drawRectF" "SDL_RenderDrawRectF" $ + with rect $ \rectPtr -> + Raw.renderDrawRectF r (castPtr rectPtr) + +-- | Draw a series of rectangle outlines on the current rendering target. +drawRectsF :: MonadIO m => Renderer -> SV.Vector (Rectangle CFloat) -> m () +drawRectsF (Renderer r) rects = liftIO $ + throwIfNeg_ "SDL.Video.drawRectsF" "SDL_RenderDrawRectsF" $ + SV.unsafeWith rects $ \rp -> + Raw.renderDrawRectsF r (castPtr rp) (fromIntegral (SV.length rects)) + +-- | Draw a filled rectangle on the current rendering target. +fillRectF :: MonadIO m => Renderer -> Rectangle CFloat -> m () +fillRectF (Renderer r) rect = liftIO $ + throwIfNeg_ "SDL.Video.fillRectF" "SDL_RenderFillRectF" $ + with rect $ \rectPtr -> + Raw.renderFillRectF r (castPtr rectPtr) + +-- | Draw a series of filled rectangles on the current rendering target. +fillRectsF :: MonadIO m => Renderer -> SV.Vector (Rectangle CFloat) -> m () +fillRectsF (Renderer r) rects = liftIO $ + throwIfNeg_ "SDL.Video.fillRectsF" "SDL_RenderFillRectsF" $ + SV.unsafeWith rects $ \rp -> + Raw.renderFillRectsF r (castPtr rp) (fromIntegral (SV.length rects)) + +#endif + + -- | Clear the current rendering target with the drawing color. -- -- See @@ for C documentation. @@ -764,29 +861,6 @@ (case flips of 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 - -> Texture -- ^ The source texture - -> Maybe (Rectangle CInt) -- ^ The source rectangle to copy, or 'Nothing' for the whole texture - -> Maybe (Rectangle CFloat) -- ^ The destination rectangle to copy to, or 'Nothing' for the whole rendering target. The texture will be stretched to fill the given rectangle. - -> CDouble -- ^ The angle of rotation in degrees. The rotation will be performed clockwise. - -> Maybe (Point V2 CFloat) -- ^ The point indicating the center of the rotation, or 'Nothing' to rotate around the center of the destination rectangle - -> V2 Bool -- ^ Whether to flip the texture on the X and/or Y axis - -> m () -copyExF (Renderer r) (Texture t) srcRect dstRect theta center flips = - liftIO $ - throwIfNeg_ "SDL.Video.copyExF" "SDL_RenderCopyExF" $ - maybeWith with srcRect $ \src -> - maybeWith with dstRect $ \dst -> - maybeWith with center $ \c -> - Raw.renderCopyExF r t (castPtr src) (castPtr dst) theta (castPtr c) - (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. --