From 9b03b9d2b386b503a6401fb4a54c26c505cd220b Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 24 Jan 2023 16:17:38 +1300 Subject: [PATCH] Fix compilation issues with restructure back to Typograffiti's original. --- src/Typograffiti.hs | 24 +++++++ src/Typograffiti/Atlas.hs | 79 ++++++++++++-------- src/Typograffiti/Cache.hs | 22 ++++-- src/Typograffiti/GL.hs | 8 +-- src/Typograffiti/Store.hs | 148 ++++++++++++-------------------------- typograffiti2.cabal | 124 +++++++++++--------------------- 6 files changed, 182 insertions(+), 223 deletions(-) diff --git a/src/Typograffiti.hs b/src/Typograffiti.hs index e69de29..e4f2566 100644 --- a/src/Typograffiti.hs +++ b/src/Typograffiti.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Typograffiti +-- Copyright: (c) 2018 Schell Scivally +-- License: MIT +-- Maintainer: Schell Scivally +-- +-- This module provides easy freetype2-based font rendering with a nice +-- Haskell interface. +module Typograffiti( + TypograffitiError(..), + allocAtlas, freeAtlas, stringTris, Atlas(..), GlyphMetrics(..), + makeDrawGlyphs, AllocatedRendering(..), Layout(..), + SpatialTransform(..), TextTransform(..), move, scale, rotate, color, alpha, + withFontStore, newFontStore, FontStore(..), Font(..), + makeDrawTextIndentedCached, makeDrawTextCached, + makeDrawAsciiIndentedCached, makeDrawAsciiCached, + makeDrawTextIndented, makeDrawTextIndented', makeDrawText, makeDrawText', + makeDrawAsciiIndented, makeDrawAsciiIndented', makeDrawAscii, makeDrawAscii' +) where + +import Typograffiti.Atlas +import Typograffiti.Cache +import Typograffiti.Store +import Typograffiti.Text diff --git a/src/Typograffiti/Atlas.hs b/src/Typograffiti/Atlas.hs index d6c266a..d2a1a75 100644 --- a/src/Typograffiti/Atlas.hs +++ b/src/Typograffiti/Atlas.hs @@ -14,6 +14,7 @@ module Typograffiti.Atlas where import Control.Monad import Control.Monad.Except (MonadError (..)) +import Control.Monad.Fail (MonadFail (..)) import Control.Monad.IO.Class import Data.Maybe (fromMaybe) import Data.IntMap (IntMap) @@ -23,14 +24,31 @@ import qualified Data.Vector.Unboxed as UV import Foreign.Marshal.Utils (with) import Graphics.GL.Core32 import Graphics.GL.Types +import FreeType.Core.Base import FreeType.Core.Types as BM import FreeType.Support.Bitmap as BM import FreeType.Support.Bitmap.Internal as BM import Linear +import Data.Int (Int32) +import Data.Text.Glyphize (GlyphInfo(..), GlyphPos(..)) +import Data.Word (Word32) + +import Foreign.Storable (Storable(..)) +import Foreign.Ptr (castPtr) +import Foreign.Marshal.Array (allocaArray, peekArray) +import Foreign.C.String (withCString) import Typograffiti.GL -import Typograffiti.Glyph -import Typograffiti.Utils + +data TypograffitiError = + TypograffitiErrorNoGlyphMetricsForChar Char + -- ^ The are no glyph metrics for this character. This probably means + -- the character has not been loaded into the atlas. + | TypograffitiErrorFreetype String String + -- ^ There was a problem while interacting with the freetype2 library. + | TypograffitiErrorGL String + -- ^ There was a problem while interacting with OpenGL. + deriving (Show, Eq) ------ --- Atlas @@ -49,6 +67,7 @@ data Atlas = Atlas { atlasFilePath :: FilePath } deriving (Show) +emptyAtlas :: GLuint -> Atlas emptyAtlas t = Atlas t 0 mempty "" data AtlasMeasure = AM { @@ -64,12 +83,15 @@ emptyAM = AM 0 (V2 1 1) 0 mempty spacing :: Int spacing = 1 -glyphRetriever font glyph = do - ft_Load_Glyph font (fromIntegral $ fromEnum glyph) FT.FT_LOAD_RENDER +type GlyphRetriever m = Word32 -> m (FT_Bitmap, FT_Glyph_Metrics) +glyphRetriever :: MonadIO m => FT_Face -> GlyphRetriever m +glyphRetriever font glyph = liftIO $ do + ft_Load_Glyph font (fromIntegral $ fromEnum glyph) FT_LOAD_RENDER font' <- peek font slot <- peek $ frGlyph font' return (gsrBitmap slot, gsrMetrics slot) +measure :: MonadIO m => GlyphRetriever m -> Int -> AtlasMeasure -> Word32 -> m AtlasMeasure measure cb maxw am@AM{..} glyph | Just _ <- IM.lookup (fromEnum glyph) amMap = return am | otherwise = do @@ -92,13 +114,14 @@ measure cb maxw am@AM{..} glyph } return am +texturize :: MonadIO m => GlyphRetriever m -> IntMap (V2 Int) -> Atlas -> Word32 -> m Atlas texturize cb xymap atlas@Atlas{..} glyph | Just pos@(V2 x y) <- IM.lookup (fromIntegral $ fromEnum glyph) xymap = do (bmp, metrics) <- cb glyph - glTexSubImage2D GL.GL_TEXTURE_2D 0 + glTexSubImage2D GL_TEXTURE_2D 0 (fromIntegral x) (fromIntegral y) (fromIntegral $ bWidth bmp) (fromIntegral $ bRows bmp) - GL.GL_RED GL.GL_UNSIGNED_BYTE + GL_RED GL_UNSIGNED_BYTE (castPtr $ bBuffer bmp) let vecwh = fromIntegral <$> V2 (bWidth bmp) (bRows bmp) canon = floor . (* 0.5) . (* 0.015625) . realToFrac . fromIntegral @@ -113,40 +136,38 @@ texturize cb xymap atlas@Atlas{..} glyph } return atlas { atlasMetrics = IM.insert (fromEnum glyph) mtrcs atlasMetrics } | otherwise = do - putStrLn ("Cound not find glyph " ++ show glyph) + liftIO $ putStrLn ("Cound not find glyph " ++ show glyph) return atlas -allocAtlas :: (Int32 -> IO (FT_Bitmap, FT_Glyph_Metrics)) -> [Int32] -> IO Atlas +allocAtlas :: (MonadIO m, MonadFail m) => GlyphRetriever m -> [Word32] -> m Atlas allocAtlas cb glyphs = do AM {..} <- foldM (measure cb 512) emptyAM glyphs let V2 w h = amWH xymap = amMap - [t] <- allocaArray 1 $ \ptr -> do - glGenTextures 1 ptr - peekArray 1 ptr - glActiveTexture 0 - glBindTexture GL.GL_TEXTURE_2D t + t <- allocAndActivateTex 0 - glPixelStorei GL.GL_UNPACK_ALIGNMENT 1 - withCString (replicate (w * h) $ toEnum 0) $ - glTexImage2D GL.GL_TEXTURE_2D 0 GL.GL_RED (fromIntegral w) (fromIntegral h) - 0 GL.GL_RED GL.GL_UNSIGNED_BYTE . castPtr + glPixelStorei GL_UNPACK_ALIGNMENT 1 + liftIO $ withCString (replicate (w * h) $ toEnum 0) $ + glTexImage2D GL_TEXTURE_2D 0 GL_RED (fromIntegral w) (fromIntegral h) + 0 GL_RED GL_UNSIGNED_BYTE . castPtr atlas <- foldM (texturize cb xymap) (emptyAtlas t) glyphs - glGenerateMipmap GL.GL_TEXTURE_2D - glTexParameteri GL.GL_TEXTURE_2D GL.GL_TEXTURE_WRAP_S GL.GL_REPEAT - glTexParameteri GL.GL_TEXTURE_2D GL.GL_TEXTURE_WRAP_T GL.GL_REPEAT - glTexParameteri GL.GL_TEXTURE_2D GL.GL_TEXTURE_MAG_FILTER GL.GL_LINEAR - glTexParameteri GL.GL_TEXTURE_2D GL.GL_TEXTURE_MIN_FILTER GL.GL_LINEAR - glBindTexture GL.GL_TEXTURE_2D 0 - glPixelStorei GL.GL_UNPACK_ALIGNMENT 4 + glGenerateMipmap GL_TEXTURE_2D + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR + glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR + glBindTexture GL_TEXTURE_2D 0 + glPixelStorei GL_UNPACK_ALIGNMENT 4 return atlas { atlasTextureSize = V2 w h } -freeAtlas a = with (atlasTexture a) $ \ptr -> glDeleteTextures 1 ptr +freeAtlas :: MonadIO m => Atlas -> m () +freeAtlas a = liftIO $ with (atlasTexture a) $ \ptr -> glDeleteTextures 1 ptr type Quads = (Float, Float, [(V2 Float, V2 Float)]) -makeCharQuad :: Atlas -> Quads -> (GlyphInfo, GlyphPos) -> IO Quads +makeCharQuad :: (MonadIO m, MonadError TypograffitiError m) => + Atlas -> Quads -> (GlyphInfo, GlyphPos) -> m Quads makeCharQuad Atlas {..} (penx, peny, mLast) (GlyphInfo {codepoint=glyph}, GlyphPos {..}) = do let iglyph = fromEnum glyph case IM.lookup iglyph atlasMetrics of @@ -172,9 +193,11 @@ makeCharQuad Atlas {..} (penx, peny, mLast) (GlyphInfo {codepoint=glyph}, GlyphP f' :: Int -> Float f' = fromIntegral -stringTris :: Atlas -> [(GlyphInfo, GlyphPos)] -> IO Quads +stringTris :: (MonadIO m, MonadError TypograffitiError m) => + Atlas -> [(GlyphInfo, GlyphPos)] -> m Quads stringTris atlas = foldM (makeCharQuad atlas) (0, 0, []) -stringTris' :: Atlas -> [(GlyphInfo, GlyphPos)] -> IO [(V2 Float, V2 Float)] +stringTris' :: (MonadIO m, MonadError TypograffitiError m) => + Atlas -> [(GlyphInfo, GlyphPos)] -> m [(V2 Float, V2 Float)] stringTris' atlas glyphs = do (_, _, ret) <- stringTris atlas glyphs return ret diff --git a/src/Typograffiti/Cache.hs b/src/Typograffiti/Cache.hs index e2385c8..34e1f78 100644 --- a/src/Typograffiti/Cache.hs +++ b/src/Typograffiti/Cache.hs @@ -18,6 +18,7 @@ module Typograffiti.Cache where import Control.Monad (foldM) import Control.Monad.Except (MonadError (..), liftEither, runExceptT) +import Control.Monad.Fail (MonadFail (..)) import Control.Monad.IO.Class (MonadIO (..)) import Data.Bifunctor (first) import Data.ByteString (ByteString) @@ -30,13 +31,16 @@ import qualified Data.Vector.Unboxed as UV import Foreign.Marshal.Array import Graphics.GL import Linear +import Data.Text.Glyphize (GlyphInfo(..), GlyphPos(..)) import Typograffiti.Atlas import Typograffiti.GL -import Typograffiti.Glyph -data AllocatedRendering = AllocatedRendering - { arDraw :: [TextTransform] -> V2 CInt -> IO () +class Layout t where + translate :: t -> V2 Float -> t + +data AllocatedRendering t = AllocatedRendering + { arDraw :: t -> V2 Int -> IO () -- ^ Draw the text with some transformation in some monad. , arRelease :: IO () -- ^ Release the allocated draw function in some monad. @@ -44,6 +48,17 @@ data AllocatedRendering = AllocatedRendering -- ^ The size (in pixels) of the drawn text. } +makeDrawGlyphs + :: ( MonadIO m + , MonadError TypograffitiError m + , MonadIO n + , MonadFail n + , MonadError TypograffitiError n + ) + => m (Atlas + -> [(GlyphInfo, GlyphPos)] + -> n (AllocatedRendering [TextTransform]) + ) makeDrawGlyphs = do let position = 0 uv = 1 @@ -182,7 +197,6 @@ alpha = instance Layout [TextTransform] where translate ts (V2 x y) = ts ++ [move x y] - liftGL :: ( MonadIO m , MonadError TypograffitiError m diff --git a/src/Typograffiti/GL.hs b/src/Typograffiti/GL.hs index 7c260e8..575e89c 100644 --- a/src/Typograffiti/GL.hs +++ b/src/Typograffiti/GL.hs @@ -23,6 +23,7 @@ import Graphics.GL.Core32 import Graphics.GL.Types import Linear import Linear.V (Finite, Size, dim, toV) +import Data.List (foldl') allocAndActivateTex :: (MonadIO m, MonadFail m) => GLenum -> m GLuint @@ -354,10 +355,9 @@ orthoProjection (V2 ww wh) = in ortho 0 hw hh 0 0 1 -boundingBox :: (Unbox a, Real a, Fractional a) => UV.Vector (V2 a) -> (V2 a, V2 a) -boundingBox vs - | UV.null vs = (0,0) - | otherwise = UV.foldl' f (br,tl) vs +boundingBox :: (Unbox a, Real a, Fractional a) => [V2 a] -> (V2 a, V2 a) +boundingBox [] = (0, 0) +boundingBox vs = foldl' f (br,tl) vs where mn a = min a . realToFrac mx a = max a . realToFrac f (a, b) c = (mn <$> a <*> c, mx <$> b <*> c) diff --git a/src/Typograffiti/Store.hs b/src/Typograffiti/Store.hs index bcdc015..a946c21 100644 --- a/src/Typograffiti/Store.hs +++ b/src/Typograffiti/Store.hs @@ -3,6 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} -- | -- Module: Typograffiti.Monad -- Copyright: (c) 2018 Schell Scivally @@ -10,120 +11,46 @@ -- Maintainer: Schell Scivally -- -- A storage context an ops for rendering text with multiple fonts --- and sizes, hiding the details of the Atlas and WordCache. +-- and sizes, hiding the details of the Atlas, Cache, and the Harfbuzz library. module Typograffiti.Store where import Control.Concurrent.STM (TMVar, atomically, newTMVar, putTMVar, readTMVar, takeTMVar) -import Control.Monad.Except (MonadError (..), liftEither) +import Control.Monad.Except (MonadError (..), liftEither, runExceptT, ExceptT (..)) import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Fail (MonadFail (..)) import Data.Map (Map) import qualified Data.Map as M import Data.Set (Set) import qualified Data.Set as S +import qualified Data.IntSet as IS import Linear - +import qualified Data.ByteString as B +import Data.Text.Glyphize (defaultBuffer, Buffer(..), shape, + GlyphInfo(..), GlyphPos(..)) +import qualified Data.Text.Glyphize as HB +import Data.Text.Lazy (Text, pack) +import FreeType.Core.Base import Typograffiti.Atlas import Typograffiti.Cache -import Typograffiti.Glyph - --- For font registration APIs -import Typograffiti.Utils -import FreeType.Support.Bitmap.Internal -import FreeType.Support.Outline.Internal -import FreeType.Support.Outline -import FreeType.Core.Types -import Data.Maybe (fromMaybe) -import System.IO - -data GlyphSize = CharSize Float Float Int Int - | PixelSize Int Int - deriving (Show, Eq, Ord) - -makeDrawTextIndented lib filepath index fontsize features sampletext indent = do - font <- ft_New_Face lib filepath index - case fontsize of - PixelSize w h -> ft_Set_Pixel_Sizes font (toEnum $ x2 w) (toEnum $ x2 h) - CharSize w h dpix dpiy -> ft_Set_Char_Size font (floor $ 26.6 * 2 * w) - (floor $ 26.6 * 2 * h) - (toEnum dpix) (toEnum dpiy) - - bytes <- B.readFile filepath - let font' = createFont $ createFace bytes $ toEnum $ fromEnum index - let glyphs = map (codepoint . fst) $ - shape font' defaultBuffer { text = sampletext } features - let glyphs' = map toEnum $ IS.toList $ IS.fromList $ map fromEnum glyphs - atlas <- allocAtlas (glyphRetriever font) glyphs' - ft_Done_Face font +import Typograffiti.Text (GlyphSize(..), drawLinesWrapper) - drawGlyphs <- makeDrawGlyphs - return $ drawLinesWrapper indent $ \string -> - drawGlyphs atlas $ shape font' defaultBuffer { text = string } features - where x2 = (*2) - -makeDrawTextIndented' a b c d e f = - ft_With_FreeType $ \ft -> makeDrawTextIndented ft a b c d e f - -makeDrawText a b c d e f = makeDrawTextIndented a b c d e f 4 -makeDrawText' a b c d e = ft_With_FreeType $ \ft -> makeDrawText ft a b c d e - --- Note: May glitch upon ligatures. -makeDrawAsciiIndented a b c d e f = - makeDrawTextIndented a b c d e (map toEnum [32..126]) f -makeDrawAsciiIndented' a b c d e = - ft_With_FreeType $ \ft -> makeDrawAsciiIndented ft a b c d e -makeDrawAscii a b c d e = makeDrawText a b c d e $ map toEnum [32..126] -makeDrawAscii' a b c d = ft_With_FreeType $ \ft -> makeDrawAscii ft a b c d - -drawLinesWrapper indent cb string = do - renderers <- mapM cb $ map processLine $ lines string - let drawLine ts wsz y renderer = do - arDraw renderer (move 0 y:ts) wsz - let V2 _ height = arSize renderer - return y + height - let draw ts wsz = do - foldM (drawLine ts wsz) 0 renderers - return () - let sizes = map arSize renderers - let size = V2 (max [x | V2 x _ <- sizes]) (sum [y | V2 _ y <- sizes]) - let release = do - forM renderers arRelease - return () - return AllocatedRendering { - arDraw = draw, - arRelease = release, - arSize = size - } - where - processLine "" = " " -- enforce nonempty - processLine cs = expandTabs cs - -- monospace tabshaping, good enough outside full line-layout. - expandTabs n cs = case break (== '\t') of - (pre, '\t':cs') -> let spaces = indent - ((length pre + n) `rem` indent) - in pre ++ replicate spaces ' ' ++ expandTabs (n + length pre + spaces) cs' - (tail, _) -> tail - --- Add cache of imported fonts ---- Key by filepath & index ---- Maps to Harfbuzz & FreeType fonts, ---- as well as a list of atlases associated with glyphsets & fontfeatures. - -data FontStore = FontStore { +data FontStore n = FontStore { fontMap :: TMVar (Map (FilePath, GlyphSize, Int) Font), - drawGlyphs :: Atlas -> [(GlyphInfo, GlyphPos)] -> IO AllocatedRendering + drawGlyphs :: Atlas -> [(GlyphInfo, GlyphPos)] -> n (AllocatedRendering [TextTransform]), lib :: FT_Library } data Font = Font { harfbuzz :: HB.Font, - freetype :: FT_Font, - atlases :: TMVar [(IS.IntSet, Atlas)], + freetype :: FT_Face, + atlases :: TMVar [(IS.IntSet, Atlas)] } makeDrawTextIndentedCached store filepath index fontsize features sampletext indent = do s <- liftIO $ atomically $ readTMVar $ fontMap store - font <- case M.lookup (filepath, fontsize, index) a of + font <- case M.lookup (filepath, fontsize, index) s of Nothing -> allocFont store filepath index fontsize Just font -> return font @@ -134,13 +61,13 @@ makeDrawTextIndentedCached store filepath index fontsize features sampletext ind a <- liftIO $ atomically $ readTMVar $ atlases font atlas <- case [a' | (gs, a') <- a, glyphset `IS.isSubsetOf` gs] of (atlas:_) -> return atlas - _ -> allocAtlas (atlases font) (freetype font) glyphset + _ -> allocAtlas' (atlases font) (freetype font) glyphset - return $ drawLinesWrapper indent $ \string -> - drawGlyphs store atlas $ shape font' defaultBuffer { text = string } features + return $ drawLinesWrapper indent $ \string -> drawGlyphs store atlas $ + shape (harfbuzz font) defaultBuffer { text = pack string } features allocFont FontStore {..} filepath index fontsize = do - font <- ft_New_Face lib filepath index + font <- ft_New_Face lib filepath $ toEnum index case fontsize of PixelSize w h -> ft_Set_Pixel_Sizes font (toEnum $ x2 w) (toEnum $ x2 h) CharSize w h dpix dpiy -> ft_Set_Char_Size font (floor $ 26.6 * 2 * w) @@ -148,27 +75,42 @@ allocFont FontStore {..} filepath index fontsize = do (toEnum dpix) (toEnum dpiy) bytes <- B.readFile filepath - let font' = createFont $ createFace bytes $ toEnum $ fromEnum index + let font' = HB.createFont $ HB.createFace bytes $ toEnum index atlases <- liftIO $ atomically $ newTMVar [] let ret = Font font' font atlases - liftIO $ atomically $ swapTMVar $ M.insert (filepath, fontsize, index) ret + + liftIO $ atomically $ do + map <- takeTMVar fontMap + putTMVar fontMap $ M.insert (filepath, fontsize, index) ret map return ret + where x2 = (*2) -allocAtlas atlases font glyphset = do +allocAtlas' :: (MonadIO m, MonadFail m) => + TMVar [(IS.IntSet, Atlas)] -> FT_Face -> IS.IntSet -> m Atlas +allocAtlas' atlases font glyphset = do let glyphs = map toEnum $ IS.toList glyphset atlas <- allocAtlas (glyphRetriever font) glyphs - liftIO $ atomically $ swapTMVar atlases $ ((glyphset, atlas):) + liftIO $ atomically $ do + a <- takeTMVar atlases + putTMVar atlases $ ((glyphset, atlas):a) return atlas -withFontStore cb = ft_With_FreeType $ \lib -> do - store <- liftIO $ atomically $ newTMVar M.empty +withFontStore :: (MonadIO n, MonadError TypograffitiError n, MonadFail n) => + (FontStore n -> ExceptT TypograffitiError IO a) -> + IO (Either TypograffitiError a) +withFontStore cb = ft_With_FreeType $ \lib -> runExceptT $ (newFontStore lib >>= cb) + +newFontStore :: (MonadIO m, MonadError TypograffitiError m, + MonadIO n, MonadError TypograffitiError n, MonadFail n) => FT_Library -> m (FontStore n) +newFontStore lib = do drawGlyphs <- makeDrawGlyphs + store <- liftIO $ atomically $ newTMVar M.empty - cb $ FontStore store drawGlyphs lib + return $ FontStore store drawGlyphs lib makeDrawTextCached a b c d e f = makeDrawTextIndentedCached a b c d e f 4 makeDrawAsciiIndentedCached a b c d e f = - makeDrawTextIndentedCached a b c d e (map toEnum [32..126]) f -makeDrawAsciiCached a b c d e = makeDrawTextCached a b c d e $ map toEnum [32..126] + makeDrawTextIndentedCached a b c d e (pack $ map toEnum [32..126]) f +makeDrawAsciiCached a b c d e = makeDrawTextCached a b c d e $ pack $ map toEnum [32..126] diff --git a/typograffiti2.cabal b/typograffiti2.cabal index 6d40a36..1450145 100644 --- a/typograffiti2.cabal +++ b/typograffiti2.cabal @@ -1,91 +1,47 @@ --- Initial typograffiti2.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - --- The name of the package. -name: typograffiti2 - --- The package version. See the Haskell package versioning policy (PVP) --- for standards guiding when and how versions should be incremented. --- https://wiki.haskell.org/Package_versioning_policy --- PVP summary: +-+------- breaking API changes --- | | +----- non-breaking API additions --- | | | +--- code changes with no API change -version: 0.1.0.0 - --- A short (one-line) description of the package. -synopsis: Just let me draw nice text already - --- A longer description of the package. --- description: - --- URL for the project homepage or repository. -homepage: https://argonaut-constellation.org/ - --- The license under which the package is released. -license: BSD3 - --- The file containing the license text. -license-file: LICENSE - --- The package author(s). -author: Adrian Cochrane - --- An email address to which users can send suggestions, bug reports, and --- patches. -maintainer: adrian@openwork.nz - --- A copyright notice. --- copyright: - -category: Graphics - -build-type: Simple - --- Extra files to be distributed with the package, such as examples or a --- README. -extra-source-files: CHANGELOG.md - --- Constraint on the version of Cabal needed to build this package. -cabal-version: >=1.10 - +cabal-version: 1.12 + +name: typograffiti +version: 0.2.0.0 +synopsis: Just let me draw nice text already +description: This is a text rendering library that uses OpenGL and freetype2 to render TTF font strings quickly. It is fast enough to render large chunks of text in real time. This library exists because text rendering is one of the biggest hurdles in Haskell graphics programming - and it shouldn't be! + Typograffiti includes an MTL style typeclass and a default monad transformer. It does not assume you are using any specific windowing solution. It does assume you are using OpenGL 3.3+. + Pull requests are very welcome :) + See https://github.com/schell/typograffiti/blob/master/app/Main.hs for an example. +category: Graphics +homepage: https://github.com/schell/typograffiti#readme +bug-reports: https://github.com/schell/typograffiti/issues +author: Schell Scivally +maintainer: schell@takt.com +copyright: 2018 Schell Scivally & others +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/schell/typograffiti library - -- Modules exported by the library. - exposed-modules: Graphics.Text.Font.Render - - -- Modules included in this library but not exported. - -- other-modules: - - -- LANGUAGE extensions used by modules in this package. - -- other-extensions: - - -- Other library packages from which modules are imported. - build-depends: base >=4.12 && <4.13, linear, containers, freetype2, gl, - vector, harfbuzz-pure, bytestring - - -- Directories containing source files. + exposed-modules: + Typograffiti + Typograffiti.Atlas + Typograffiti.Cache + Typograffiti.GL + Typograffiti.Store + Typograffiti.Text + build-depends: base >=4.12 && <4.13, linear>=1.20, containers >= 0.6, + freetype2 >= 0.2, gl >= 0.8, mtl >= 2.2, stm >= 2.5, text, + vector >= 0.12, harfbuzz-pure >= 0.0.7, bytestring >= 0.10 hs-source-dirs: src - - -- Base language which the package is written in. default-language: Haskell2010 -executable typograffiti2 - -- .hs or .lhs file containing the Main module. - main-is: Main.hs - - -- Modules included in this executable, other than Main. - -- other-modules: - - -- LANGUAGE extensions used by modules in this package. - -- other-extensions: - - -- Other library packages from which modules are imported. - build-depends: base >=4.12 && <4.13, typograffiti2, sdl2, text, gl - - -- Directories containing source files. - hs-source-dirs: app - - -- Base language which the package is written in. - default-language: Haskell2010 +--executable typograffiti +-- main-is: Main.hs +-- build-depends: base >=4.12 && <4.13, typograffiti, sdl2 >= 2.5.4, text, gl +-- hs-source-dirs: app +-- default-language: Haskell2010 -- 2.30.2