freetype-simple (empty) → 0.1.0.0

raw patch · 4 files changed

+170/−0 lines, 4 filesdep +basedep +boundingboxesdep +bytestringsetup-changed

Dependencies added: base, boundingboxes, bytestring, freetype2, linear

Files

• Graphics/Rendering/FreeType/Simple.hs +137/−0
• LICENSE +1/−0
• Setup.hs +2/−0
• freetype-simple.cabal +30/−0

@@ -0,0 +1,137 @@+{-# LANGUAGE RecordWildCards #-}+module Graphics.Rendering.FreeType.Simple where++import Control.Applicative+import Control.Monad+import Data.BoundingBox+import Data.ByteString.Internal+import Foreign+import Foreign.C+import Graphics.Rendering.FreeType.Internal+import Graphics.Rendering.FreeType.Internal.BBox as B+import Graphics.Rendering.FreeType.Internal.Bitmap+import Graphics.Rendering.FreeType.Internal.BitmapGlyph as BG+import Graphics.Rendering.FreeType.Internal.Face+import Graphics.Rendering.FreeType.Internal.Glyph+import qualified Graphics.Rendering.FreeType.Internal.GlyphSlot as GS+import Graphics.Rendering.FreeType.Internal.Library+import Graphics.Rendering.FreeType.Internal.PrimitiveTypes+import qualified Graphics.Rendering.FreeType.Internal.Vector as V+import Linear+import System.IO.Unsafe (unsafePerformIO)++data Font = Font+	{ fontFace :: FT_Face+	-- | Ascender in em.+	, fontAscender :: Float+	-- | Descender in em.+	, fontDescender :: Float+	-- | (x min, y min) (x max, y max) in em.+	, fontBBox :: Box V2 Float+	}++runFT :: IO CInt -> IO ()+runFT m = do+    r <- m+    unless (r == 0) $ error $ "FreeType2: " ++ show r++-- | Default FreeType FT_Library.+ftlib :: FT_Library+ftlib = unsafePerformIO $ alloca $ \p -> do+  runFT $ ft_Init_FreeType p+  peek p++-- | Create 'Font' from a given path.+readFont :: FilePath -> IO Font+readFont path = alloca $ \p -> do+	runFT $ withCString path $ \str -> ft_New_Face ftlib str 0 p+	face <- peek p+	b <- peek (bbox face)+	asc <- fromIntegral <$> peek (ascender face)+	desc <- fromIntegral <$> peek (descender face)+	u <- fromIntegral <$> peek (units_per_EM face)+	let box = pure ((/u).fromIntegral) <*> Box+		(V2 (xMin b) (yMin b))+		(V2 (xMax b) (yMax b))+	return $ Font face (asc/u) (desc/u) box++-- | Single line text rendering+textLine :: Font -> Float -> String -> IO (ForeignPtr Word8, V2 Int, Box V2 Int)+textLine Font{fontFace = face} size text = do+	let dpi = 72+	runFT $ ft_Set_Char_Size face 0 (floor $ size * 64) dpi dpi+	slot <- peek $ glyph face+	+	let text' = map fromEnum text+	let measure :: Ptr V.FT_Vector -> Ptr FT_BBox -> (Int, Ptr FT_Glyph, Int, [Box V2 Int]) -> Int -> IO (Int, Ptr FT_Glyph, Int, [Box V2 Int])+	    measure delta glyphBBox (prev, glyphs, penX, xs) ch = do+		glyphIx <- ft_Get_Char_Index face (fromIntegral ch)+		+		ft_Get_Kerning face (fromIntegral prev) glyphIx (fromIntegral ft_KERNING_DEFAULT) delta+		kx <- fromIntegral . V.x <$> peek delta+		+		runFT $ ft_Load_Glyph face glyphIx ft_LOAD_DEFAULT+		runFT $ ft_Get_Glyph slot glyphs+		+		dx <- fromIntegral . V.x <$> peek (GS.advance slot)+		glyph' <- peek glyphs+		ft_Glyph_Get_CBox glyph' ft_GLYPH_BBOX_UNSCALED glyphBBox+		bbox@FT_BBox{..} <- peek glyphBBox+		--putStrLn $ show bbox+		let (left, y) = (penX + kx, 0)+		let f = fromIntegral+		let box = Box (V2 (left + f xMin) (y + f yMin)) (V2 (left + f xMax) (y + f yMax))+		--putStrLn $ show box+		return (ch, advancePtr glyphs 1, penX+kx+dx, box:xs)+	+	let render :: Ptr FT_Glyph -> Ptr Word8 -> Int -> Box V2 Int -> Box V2 Int -> Int -> IO ()+	    render glyphs dst bmpW (Box bmin bmax) (Box gmin gmax) i = do+		let imgPtr = advancePtr glyphs i+		--poke pen $ V.FT_Vector (fromIntegral x + fromIntegral loff) (fromIntegral toff)+		--runFT $ ft_Glyph_To_Bitmap imgPtr ft_RENDER_MODE_NORMAL pen 1+		-- destroy old glyph+		runFT $ ft_Glyph_To_Bitmap imgPtr ft_RENDER_MODE_NORMAL nullPtr 1+		img <- peek imgPtr+		let im = BG.cast img+		--bl <- fromIntegral <$> peek (left im)+		--bt <- fromIntegral <$> peek (top im)+		bmp <- peek $ bitmap im+		--let bw = fromIntegral $ width bmp+		--let bh = fromIntegral $ rows bmp+		let image = buffer bmp+		+		let V2 (V2 xMin yMin) (V2 gxMin gyMin) = fmap (`shiftR` 6) <$> V2 bmin gmin+		let V2 (V2 xMax yMax) (V2 gxMax gyMax) = fmap ((`shiftR` 6) . (+63)) <$> V2 bmax gmax+		let V4 gl gt gw gh = V4 (-xMin+gxMin) (yMax-gyMax) (gxMax-gxMin) (gyMax-gyMin)+		--putStrLn $ show ("left", bl, "top", bt, "gl", gl, "gt", gt)+		--putStrLn $ show ("cols", bw, "rows", bh, "gw", gw, "gh", gh)+		+		forM_ [0..gh-1] $ \y -> do+			--putStrLn $ show ((y + gt) * bmpW + gl, (y * gw), gw)+			copyBytes (plusPtr dst $ (y + gt) * bmpW + gl) (plusPtr image (y * gw)) gw+		ft_Done_Glyph img+	+	alloca $ \ftVec -> do+		alloca $ \glyphBBox -> do+			allocaArray (length text) $ \glyphs -> do+				(_, _, textW, heads) <- foldM (measure ftVec glyphBBox) (0, glyphs, 0, []) text'+				+				let minimumBox = Box maxBound (V2 textW minBound)+				let bitmapBox@(Box (V2 l b) (V2 r t)) = foldl union minimumBox heads+				--putStrLn $ "BitBox: " ++ show (fmap (`div`64) bitmapBox)+				+				let bmpDim@(V2 w h) = (`shiftR` 6) <$> V2 (r - l + 63) (t - b + 63)+				--putStrLn $ unwords ["all:",show(w * h),"W",show w,"H",show h,show heads]+				+				let alignedW = ((w + 3) `div` 4) * 4+				fp <- mallocForeignPtrBytes (alignedW * h)+				withForeignPtr fp $ \image -> do+					memset image 0 (fromIntegral $ alignedW * h)+					zipWithM (render glyphs image alignedW bitmapBox) (reverse heads) [0..]+				return (fp, bmpDim, bitmapBox)++foreign import ccall unsafe "FT_Glyph_Get_CBox"+	ft_Glyph_Get_CBox :: FT_Glyph -> FT_UInt -> Ptr B.FT_BBox -> IO ()++--ft_GLYPH_BBOX_PIXELS = 3+ft_GLYPH_BBOX_UNSCALED = 0

@@ -0,0 +1,1 @@+CC0 Public Domain

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,30 @@+-- Initial freetype-simple.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                freetype-simple+version:             0.1.0.0+synopsis:            Single line text rendering for OpenGL ES+description:         Single line text rendering utility. See README.md for more information.+homepage:            https://github.com/capsjac/freetype-simple+license:             PublicDomain+license-file:        LICENSE+author:              capsjac <capsjac at gmail dot com>+maintainer:          capsjac <capsjac at gmail dot com>+-- copyright:           +category:            Graphics+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+  type:              git+  location:          https://github.com/capsjac/freetype-simple++library+  exposed-modules:     Graphics.Rendering.FreeType.Simple+  -- other-modules:       +  other-extensions:    RecordWildCards+  build-depends:       base >=4.7 && <4.8, boundingboxes >=0.2 && <0.3, bytestring >=0.10 && <0.11, linear >=1.13 && <1.14, freetype2 ==0.1.*+  -- hs-source-dirs:      +  --build-tools:         +  default-language:    Haskell2010