From 99f2484f51ac79a93d88a608a8af1448b58839ca Mon Sep 17 00:00:00 2001 From: Mikolaj Konarski Date: Sun, 7 Aug 2022 15:54:50 +0200 Subject: [PATCH 1/5] Reformat Font.hs with stylish-haskell --- src/SDL/Font.hs | 44 +++++++++++++++++++++----------------------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/src/SDL/Font.hs b/src/SDL/Font.hs index 51a9bdf..ecb1b72 100644 --- a/src/SDL/Font.hs +++ b/src/SDL/Font.hs @@ -16,9 +16,7 @@ throwing an 'SDLException' in case it encounters an error. -} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric, LambdaCase, OverloadedStrings #-} module SDL.Font ( @@ -86,27 +84,27 @@ module SDL.Font , blendedWrapped ) where -import Control.Exception (throwIO) -import Control.Monad (unless) +import Control.Exception (throwIO) +import Control.Monad (unless) import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Bits ((.&.), (.|.)) -import Data.ByteString (ByteString) -import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackCString) -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8) -import Data.Text.Foreign (lengthWord16, unsafeCopyToPtr) -import Data.Word (Word8, Word16) -import Foreign.C.String (CString, withCString) -import Foreign.C.Types (CUShort, CInt) -import Foreign.Marshal.Alloc (allocaBytes, alloca) -import Foreign.Marshal.Utils (with, fromBool, toBool) -import Foreign.Ptr (Ptr, castPtr, nullPtr) -import Foreign.Storable (peek, pokeByteOff) -import GHC.Generics (Generic) -import SDL (Surface(..), SDLException(SDLCallFailed)) +import Data.Bits ((.&.), (.|.)) +import Data.ByteString (ByteString) +import Data.ByteString.Unsafe (unsafePackCString, unsafeUseAsCStringLen) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8) +import Data.Text.Foreign (lengthWord16, unsafeCopyToPtr) +import Data.Word (Word16, Word8) +import Foreign.C.String (CString, withCString) +import Foreign.C.Types (CInt, CUShort) +import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.Marshal.Utils (fromBool, toBool, with) +import Foreign.Ptr (Ptr, castPtr, nullPtr) +import Foreign.Storable (peek, pokeByteOff) +import GHC.Generics (Generic) +import SDL (SDLException (SDLCallFailed), Surface (..)) import SDL.Internal.Exception -import SDL.Raw.Filesystem (rwFromConstMem) -import SDL.Vect (V4(..)) +import SDL.Raw.Filesystem (rwFromConstMem) +import SDL.Vect (V4 (..)) import qualified SDL.Raw import qualified SDL.Raw.Font @@ -505,7 +503,7 @@ blendedGlyph (Font font) (V4 r g b a) ch = with (SDL.Raw.Color r g b a) $ \fg -> SDL.Raw.Font.renderGlyph_Blended font (fromChar ch) fg --- | Same as 'blended', but renders across multiple lines. +-- | Same as 'blended', but renders across multiple lines. -- Text is wrapped to multiple lines on line endings and on word boundaries -- if it extends beyond wrapLength in pixels. blendedWrapped :: MonadIO m => Font -> Color -> Int -> Text -> m SDL.Surface From c8ce8b3d79bb55002b9e08b4b99223b70ee58f2b Mon Sep 17 00:00:00 2001 From: Mikolaj Konarski Date: Sun, 7 Aug 2022 16:10:19 +0200 Subject: [PATCH 2/5] Take withCString from new Text --- sdl2-ttf.cabal | 2 +- src/SDL/Font.hs | 29 ++++++++++++++++++++++++----- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/sdl2-ttf.cabal b/sdl2-ttf.cabal index 2f20ab9..42736c1 100644 --- a/sdl2-ttf.cabal +++ b/sdl2-ttf.cabal @@ -45,7 +45,7 @@ library bytestring >= 0.10.4.0, sdl2 >= 2.2, template-haskell, - text >= 1.1.0.0, + text >= 1.1.0.0 && < 2 || >= 2.0.1, th-abstraction >= 0.4.0.0, transformers >= 0.4 diff --git a/src/SDL/Font.hs b/src/SDL/Font.hs index ecb1b72..6cd4c5a 100644 --- a/src/SDL/Font.hs +++ b/src/SDL/Font.hs @@ -16,7 +16,7 @@ throwing an 'SDLException' in case it encounters an error. -} -{-# LANGUAGE DeriveGeneric, LambdaCase, OverloadedStrings #-} +{-# LANGUAGE CPP, DeriveGeneric, LambdaCase, OverloadedStrings #-} module SDL.Font ( @@ -90,11 +90,11 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Bits ((.&.), (.|.)) import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafePackCString, unsafeUseAsCStringLen) -import Data.Text (Text) +import Data.Text (Text, unpack) import Data.Text.Encoding (decodeUtf8) import Data.Text.Foreign (lengthWord16, unsafeCopyToPtr) import Data.Word (Word16, Word8) -import Foreign.C.String (CString, withCString) +import Foreign.C.String (CString) import Foreign.C.Types (CInt, CUShort) import Foreign.Marshal.Alloc (alloca, allocaBytes) import Foreign.Marshal.Utils (fromBool, toBool, with) @@ -105,10 +105,29 @@ import SDL (SDLException (SDLCallFailed), Surface (..)) import SDL.Internal.Exception import SDL.Raw.Filesystem (rwFromConstMem) import SDL.Vect (V4 (..)) +import System.IO (utf8) +import qualified Data.Text.Foreign +import qualified Foreign.C.String +import qualified GHC.Foreign import qualified SDL.Raw import qualified SDL.Raw.Font +-- stolen from https://github.com/haskell-game/dear-imgui.hs/blob/main/src/DearImGui/Internal/Text.hs +#if MIN_VERSION_text(2,0,1) + +withCString :: Text -> (CString -> IO a) -> IO a +withCString = Data.Text.Foreign.withCString + +#else + +withCString :: Text -> (CString -> IO a) -> IO a +withCString t action = do + GHC.Foreign.withCString utf8 (unpack t) $ \textPtr -> + action textPtr + +#endif + -- | Gets the major, minor, patch versions of the linked @SDL2_ttf@ library. -- -- You may call this without initializing the library with 'initialize'. @@ -149,7 +168,7 @@ load :: MonadIO m => FilePath -> PointSize -> m Font load path pts = fmap Font . throwIfNull "SDL.Font.load" "TTF_OpenFont" . - liftIO . withCString path $ + liftIO . Foreign.C.String.withCString path $ flip SDL.Raw.Font.openFont $ fromIntegral pts -- | Same as 'load', but accepts a 'ByteString' containing a font instead. @@ -173,7 +192,7 @@ loadIndex :: MonadIO m => FilePath -> PointSize -> Index -> m Font loadIndex path pts i = fmap Font . throwIfNull "SDL.Font.loadIndex" "TTF_OpenFontIndex" . - liftIO . withCString path $ \cpath -> + liftIO . Foreign.C.String.withCString path $ \cpath -> SDL.Raw.Font.openFontIndex cpath (fromIntegral pts) (fromIntegral i) -- | Same as 'loadIndex', but accepts a 'ByteString' containing a font instead. From 09c688995fb6251f30eaed98429889c3ba7c4d9c Mon Sep 17 00:00:00 2001 From: Mikolaj Konarski Date: Sun, 7 Aug 2022 16:23:20 +0200 Subject: [PATCH 3/5] Switch to UTF8 calls using the just defined withCString --- src/SDL/Font.hs | 63 +++++++++++++++++++++---------------------------- 1 file changed, 27 insertions(+), 36 deletions(-) diff --git a/src/SDL/Font.hs b/src/SDL/Font.hs index 6cd4c5a..ef2865d 100644 --- a/src/SDL/Font.hs +++ b/src/SDL/Font.hs @@ -90,40 +90,42 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Bits ((.&.), (.|.)) import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafePackCString, unsafeUseAsCStringLen) -import Data.Text (Text, unpack) +import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) -import Data.Text.Foreign (lengthWord16, unsafeCopyToPtr) -import Data.Word (Word16, Word8) +import Data.Word (Word8) import Foreign.C.String (CString) -import Foreign.C.Types (CInt, CUShort) -import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.C.Types (CInt) +import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (fromBool, toBool, with) import Foreign.Ptr (Ptr, castPtr, nullPtr) -import Foreign.Storable (peek, pokeByteOff) +import Foreign.Storable (peek) import GHC.Generics (Generic) import SDL (SDLException (SDLCallFailed), Surface (..)) import SDL.Internal.Exception import SDL.Raw.Filesystem (rwFromConstMem) import SDL.Vect (V4 (..)) -import System.IO (utf8) -import qualified Data.Text.Foreign import qualified Foreign.C.String -import qualified GHC.Foreign import qualified SDL.Raw import qualified SDL.Raw.Font -- stolen from https://github.com/haskell-game/dear-imgui.hs/blob/main/src/DearImGui/Internal/Text.hs #if MIN_VERSION_text(2,0,1) +import qualified Data.Text.Foreign + withCString :: Text -> (CString -> IO a) -> IO a withCString = Data.Text.Foreign.withCString #else +import qualified Data.Text +import qualified GHC.Foreign +import qualified System.IO + withCString :: Text -> (CString -> IO a) -> IO a withCString t action = do - GHC.Foreign.withCString utf8 (unpack t) $ \textPtr -> + GHC.Foreign.withCString System.IO.utf8 (Data.Text.unpack t) $ \textPtr -> action textPtr #endif @@ -222,10 +224,10 @@ unmanaged p = Surface p Nothing solid :: MonadIO m => Font -> Color -> Text -> m SDL.Surface solid (Font font) (V4 r g b a) text = fmap unmanaged . - throwIfNull "SDL.Font.solid" "TTF_RenderUNICODE_Solid" . - liftIO . withText text $ \ptr -> + throwIfNull "SDL.Font.solid" "TTF_RenderUTF8_Solid" . + liftIO . withCString text $ \ptr -> with (SDL.Raw.Color r g b a) $ \fg -> - SDL.Raw.Font.renderUNICODE_Solid font (castPtr ptr) fg + SDL.Raw.Font.renderUTF8_Solid font (castPtr ptr) fg -- | Uses the /slow and nice, but with a solid box/ method. -- @@ -237,11 +239,11 @@ solid (Font font) (V4 r g b a) text = shaded :: MonadIO m => Font -> Color -> Color -> Text -> m SDL.Surface shaded (Font font) (V4 r g b a) (V4 r2 g2 b2 a2) text = fmap unmanaged . - throwIfNull "SDL.Font.shaded" "TTF_RenderUNICODE_Shaded" . - liftIO . withText text $ \ptr -> + throwIfNull "SDL.Font.shaded" "TTF_RenderUTF8_Shaded" . + liftIO . withCString text $ \ptr -> with (SDL.Raw.Color r g b a) $ \fg -> with (SDL.Raw.Color r2 g2 b2 a2) $ \bg -> - SDL.Raw.Font.renderUNICODE_Shaded font (castPtr ptr) fg bg + SDL.Raw.Font.renderUTF8_Shaded font (castPtr ptr) fg bg -- | The /slow slow slow, but ultra nice over another image/ method, 'blended' -- renders text at high quality. @@ -254,21 +256,10 @@ shaded (Font font) (V4 r g b a) (V4 r2 g2 b2 a2) text = blended :: MonadIO m => Font -> Color -> Text -> m SDL.Surface blended (Font font) (V4 r g b a) text = fmap unmanaged . - throwIfNull "SDL.Font.blended" "TTF_RenderUNICODE_Blended" . - liftIO . withText text $ \ptr -> + throwIfNull "SDL.Font.blended" "TTF_RenderUTF8_Blended" . + liftIO . withCString text $ \ptr -> with (SDL.Raw.Color r g b a) $ \fg -> - SDL.Raw.Font.renderUNICODE_Blended font (castPtr ptr) fg - --- Analogous to Data.Text.Foreign.useAsPtr, just appends a null-byte. --- FIXME: Is this even necessary? -withText :: Text -> (Ptr Word16 -> IO a) -> IO a -withText text act = - allocaBytes len $ \ptr -> do - unsafeCopyToPtr text ptr - pokeByteOff ptr (len - 2) (0 :: CUShort) - act ptr - where - len = 2*(lengthWord16 text + 1) + SDL.Raw.Font.renderUTF8_Blended font (castPtr ptr) fg -- Helper function for converting a bitmask into a list of values. fromMaskWith :: (Enum a, Bounded a) => (a -> CInt) -> CInt -> [a] @@ -481,10 +472,10 @@ glyphMetrics (Font font) ch = size :: MonadIO m => Font -> Text -> m (Int, Int) size (Font font) text = liftIO . - withText text $ \ptr -> + withCString text $ \ptr -> alloca $ \w -> alloca $ \h -> - SDL.Raw.Font.sizeUNICODE font (castPtr ptr) w h + SDL.Raw.Font.sizeUTF8 font (castPtr ptr) w h >>= \case 0 -> do w' <- fromIntegral <$> peek w @@ -492,7 +483,7 @@ size (Font font) text = return (w', h') _ -> do err <- getError - throwIO $ SDLCallFailed "SDL.Font.size" "TTF_SizeUNICODE" err + throwIO $ SDLCallFailed "SDL.Font.size" "TTF_SizeUTF8" err -- | Same as 'solid', but renders a single glyph instead. solidGlyph :: MonadIO m => Font -> Color -> Char -> m SDL.Surface @@ -528,10 +519,10 @@ blendedGlyph (Font font) (V4 r g b a) ch = blendedWrapped :: MonadIO m => Font -> Color -> Int -> Text -> m SDL.Surface blendedWrapped (Font font) (V4 r g b a) wrapLength text = fmap unmanaged . - throwIfNull "SDL.Font.blended" "TTF_RenderUNICODE_Blended_Wrapped" . - liftIO . withText text $ \ptr -> + throwIfNull "SDL.Font.blended" "TTF_RenderUTF8_Blended_Wrapped" . + liftIO . withCString text $ \ptr -> with (SDL.Raw.Color r g b a) $ \fg -> - SDL.Raw.Font.renderUNICODE_Blended_Wrapped font (castPtr ptr) fg $ fromIntegral wrapLength + SDL.Raw.Font.renderUTF8_Blended_Wrapped font (castPtr ptr) fg $ fromIntegral wrapLength -- | From a given 'Font' get the kerning size of two glyphs. getKerningSize :: MonadIO m => Font -> Index -> Index -> m Int From 5f36e53fc2f3efd407776270fdba3b2aeab1f0b5 Mon Sep 17 00:00:00 2001 From: Mikolaj Konarski Date: Sun, 7 Aug 2022 16:41:07 +0200 Subject: [PATCH 4/5] Revert "Actually, we will need text 2.1 that may or may not ship with GHC 9.4.*" This reverts commit d42d6542d454be807dc9d4946976015be1f82442. We don't depend on text 2.1 in the end, 2.0.1 is enough and, while not included in GHC 9.4 RC1, 2.0.1 can be taken from Hackage just fine, to satisfy the constraint in .cabal. --- sdl2-ttf.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sdl2-ttf.cabal b/sdl2-ttf.cabal index 42736c1..723582f 100644 --- a/sdl2-ttf.cabal +++ b/sdl2-ttf.cabal @@ -14,7 +14,7 @@ copyright: Copyright © 2013-2022 Ömer Sinan Ağacan, Siniša Biđin, Rongc category: Font, Foreign binding, Graphics build-type: Simple cabal-version: >=1.10 -tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 +tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 || ==9.4 source-repository head type: git From ee704c5cb13af31b561e03e33ed3cef0097e5f36 Mon Sep 17 00:00:00 2001 From: Mikolaj Konarski Date: Sun, 7 Aug 2022 17:12:36 +0200 Subject: [PATCH 5/5] Update links to SDL_ttf --- README.md | 2 +- sdl2-ttf.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 6f6578b..7b86b7c 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,7 @@ Haskell bindings for the True Type Font library for SDL. - libsdl -- sdl2-ttf +- sdl2-ttf Both the raw and the higher level bindings should allow you to use any aspect of the original SDL2_ttf library. Please report an issue if you encounter a bug diff --git a/sdl2-ttf.cabal b/sdl2-ttf.cabal index 723582f..dc6e090 100644 --- a/sdl2-ttf.cabal +++ b/sdl2-ttf.cabal @@ -1,7 +1,7 @@ name: sdl2-ttf version: 2.1.3 synopsis: Bindings to SDL2_ttf. -description: Haskell bindings to SDL2_ttf C++ library . +description: Haskell bindings to SDL2_ttf C++ library . bug-reports: https://github.com/haskell-game/sdl2-ttf/issues license: BSD3 license-file: LICENSE