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 2f20ab9..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 @@ -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 @@ -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 51a9bdf..ef2865d 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 CPP, DeriveGeneric, LambdaCase, OverloadedStrings #-} module SDL.Font ( @@ -86,31 +84,52 @@ 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.Word (Word8) +import Foreign.C.String (CString) +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) +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 Foreign.C.String 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 System.IO.utf8 (Data.Text.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'. @@ -151,7 +170,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. @@ -175,7 +194,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. @@ -205,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. -- @@ -220,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. @@ -237,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] @@ -464,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 @@ -475,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 @@ -505,16 +513,16 @@ 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 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