diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `ktx-font` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## 0.1.0.0 - 2025-12-30 + +Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright 2025 IC Rainbow + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,62 @@ +# ktx-font + +A KTX2 format containing a font atlas texture, enriched with: +- [kb-text-shape](https://hackage.haskell.org/package/kb-text-shape) font shaping data. +- [msdf-astlas](https://hackage.haskell.org/package/msdf-astlas) compacted atlas. + +The package also has a module to run the shaping using stacks of those font bundles. + +## The pipeline + +Typically you'd just use your rendering engine's utilities to do this. + +To implement one, you have to address the three points in the font lifecycle: + +## Preparing the font bundle + +This part is the slowest one, as it takes care to distill and optimize the data for faster use later. + +1. Generate an atlas with [msdf-atlas-gen](https://github.com/Chlumsky/msdf-atlas-gen) +2. [Transcode](https://gitlab.com/dpwiz/msdf-atlas/-/blob/main/test/regenerate.sh) into KTX file. +3. Preprocess and inject the extras as texture attributes. + +## Loading + +Since all the data are already preprocessed you only have to move it to the appropriate places on CPU/GPU. + +For each font file: +* Load the texture like the usual (with [ktx-codec](https://hackage.haskell.org/package/ktx-codec)). +* Load font and atlas data from the same file/bytestring. + +For each combination of fonts (font stack: +* Create a shaping context from a bunch of loaded fonts. + +## Using + +1. Run `Codec.Ktx2.Font.Shaping.shape` on your text. +2. Iterate over the result and convert the UV and world boxes to the data you use for rendering. + * Since the shaping library does the font picking for you, you may have to look up the associated font data from the context, like texture id. + +NB: Due to font format and design shenanigans you have to use a sane "font size" metric that is shared for all the fonts in the stack. +Typically that would be "cap height", and `msdf-atlas` takes care of converting "em" units into that. + +For more details on the problem see: +- https://tonsky.me/blog/font-size/ +- https://tonsky.me/blog/centering/ + +## Demo + +The repo has a demo of using the shaping results in a Gloss (Brillo) context. + +![sorry for the swearing, i was that mad making all this](./demo/screenshot.png) + +- Green line: baseline, on which every font sits. +- Blue line: capital letter height, which is used for alignment. Every font rendered to have this one equal. +- Cyan circles: innermost (tiny) - cursor position. Then, "font size", then "line size". +- Red box: the bounding box for all glyph box. +- Yellow line: the initial cursor position (at 0,0) shifted to match the aligned box. + +The glyphs have black boxes because the atlas is transcoded as having the single channel swizzled as `rrr1`. +This allows to see the glyph boxes against the grey background. + +The `msdf-atlas-gen` is typically used to produce distance fields, but Gloss can't render them. diff --git a/ktx-font.cabal b/ktx-font.cabal new file mode 100644 --- /dev/null +++ b/ktx-font.cabal @@ -0,0 +1,73 @@ +cabal-version: 2.2 + +-- This file has been generated from package.yaml by hpack version 0.39.1. +-- +-- see: https://github.com/sol/hpack + +name: ktx-font +version: 0.1.0.0 +synopsis: GPU-ready rasterized fonts +category: Graphics +author: IC Rainbow +maintainer: aenor.realm@gmail.com +copyright: 2026 IC Rainbow +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md +extra-doc-files: + CHANGELOG.md + +source-repository head + type: git + location: https://gitlab.com/dpwiz/ktx + +flag executables + manual: True + default: False + +library + exposed-modules: + Codec.Ktx2.Font + Codec.Ktx2.Font.Shaping + other-modules: + Paths_ktx_font + autogen-modules: + Paths_ktx_font + hs-source-dirs: + src + default-extensions: + BlockArguments + DeriveGeneric + DeriveTraversable + DerivingStrategies + DerivingVia + DuplicateRecordFields + ImplicitParams + ImportQualifiedPost + LambdaCase + NamedFieldPuns + NoFieldSelectors + OverloadedRecordDot + OverloadedStrings + PatternSynonyms + RankNTypes + RecordWildCards + StrictData + TupleSections + TypeApplications + ViewPatterns + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + aeson + , base >=4.11 && <5 + , bytestring + , containers + , kb-text-shape + , ktx-codec >=0.1 + , msdf-atlas + , text + , vector + , zstd + default-language: Haskell2010 diff --git a/src/Codec/Ktx2/Font.hs b/src/Codec/Ktx2/Font.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Ktx2/Font.hs @@ -0,0 +1,222 @@ +module Codec.Ktx2.Font + ( -- * KTX font bundles + Bundle(..) + , loadBundle + , loadBundleBytes + , loadBundleFile + , freeBundle + , bundleFont + -- * Shaping context + , StackContext(..) + , createStackContext + , pushBundleFont + , destroyStackContext + -- ** Associated data utilities + , lookupAtlas + , lookupBundled + , mapWithBundle + , mapBundled + -- * Format internals + , pattern KTX_KEY_atlas + , pattern KTX_KEY_kbts + , pattern KTX_KEY_kbts_version + , kbtsVersion + ) where + +import Codec.Compression.Zstd qualified as Zstd +import Codec.Ktx.KeyValue qualified as KVD +import Codec.Ktx2 qualified as Ktx2 +import Codec.Ktx2.Read qualified as Ktx2 +import Codec.Ktx2.Write qualified as Ktx2 +import Control.Concurrent (MVar, newMVar, takeMVar) +import Control.Exception (bracket) +import Control.Monad +import Data.Aeson (encode, eitherDecodeFileStrict, eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.ByteString qualified as ByteString +import Data.Foldable (toList) +import Data.IntMap (IntMap) +import Data.IntMap qualified as IntMap +import Data.Map qualified as Map +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Traversable (for) +import Data.Vector.Generic qualified as Vector +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) +import GHC.Generics (Generic, Generic1) +import Graphics.MSDF.Atlas.Compact (Compact, compact) +import Graphics.MSDF.Atlas.Compact qualified as Compact +import KB.Text.Shape qualified as TextShape +import KB.Text.Shape.FFI.Enums qualified as KBTS +import KB.Text.Shape.FFI.Handles (Font(..), intHandle) +import KB.Text.Shape.Font (FontData(..), createFont, destroyFont, withFontData) +import KB.Text.Shape.Font qualified as Font + +pattern KTX_KEY_atlas :: Text +pattern KTX_KEY_atlas = "msdf-atlas" + +pattern KTX_KEY_kbts :: Text +pattern KTX_KEY_kbts = "kbts-blob" + +pattern KTX_KEY_kbts_version :: Text +pattern KTX_KEY_kbts_version = "kbts-version" + +kbtsVersion :: Text +kbtsVersion = Text.pack $ show KBTS.VERSION_CURRENT <> "," <> show KBTS.BLOB_VERSION_CURRENT + +bundleFont + :: FilePath -- ^ Source font (ttf etc) + -> FilePath -- ^ Atlas JSON + -> FilePath -- ^ KTX2 texture + -> FilePath -- ^ Output + -> IO () +bundleFont pathTtf pathJson pathKtx2 pathKtxf = do + layout <- eitherDecodeFileStrict pathJson >>= either fail pure + + ttfData <- ByteString.readFile pathTtf + kbtsData <- Font.extractBlob ttfData 0 + + font <- createFont kbtsData 0 + capsScale <- withFontData font $ pure . Font.emToCaps + destroyFont font + + sourceKtx <- Ktx2.fromFile pathKtx2 + let + atlas = capScalePlanes capsScale $ compact layout + atlasData = ByteString.toStrict $ encode atlas + kvd = + KVD.insertBytes KTX_KEY_atlas (Zstd.compress 19 atlasData) $ + KVD.insertBytes KTX_KEY_kbts (Zstd.compress 19 kbtsData) $ + KVD.insertText KTX_KEY_kbts_version kbtsVersion $ + KVD.setWriterWith ("ktx-font 0.1.0.0 / " <>) sourceKtx.kvd + Ktx2.toFile pathKtxf sourceKtx{Ktx2.kvd} + +-- | Rescale planes to caps height instead of ems. +capScalePlanes :: Float -> Compact -> Compact +capScalePlanes capsScale a = a + { Compact._size = a._size + , Compact.planes = Vector.map (Compact.scaleBox capsScale) a.planes + } + +{- | Put already-loaded font to context. + +The context will NOT keep a fontData reference. +-} +pushBundleFont :: TextShape.Context -> Bundle -> IO Int +pushBundleFont ctx Bundle{fontData} = + withFontData fontData $ TextShape.pushFont ctx + +data Bundle = Bundle + { fontData :: FontData -- ^ The bundle holds the font memory too. + , atlas :: Compact -- ^ Glyph atlas data for the texture. + } + deriving (Eq) + +loadBundleFile :: FilePath -> IO Bundle +loadBundleFile fontFile = + bracket (Ktx2.open fontFile) Ktx2.close loadBundle + +loadBundleBytes :: ByteString -> IO Bundle +loadBundleBytes bytes = + Ktx2.bytes bytes >>= loadBundle + +-- | Load bundle data from already opened KTX2 reader context +loadBundle :: Ktx2.ReadChunk a => Ktx2.Context a -> IO Bundle +loadBundle ktx = do + kvd <- Ktx2.keyValueData ktx + let + bundled = (,,) + <$> (Map.lookup KTX_KEY_atlas kvd >>= KVD.fromValue) + <*> (Map.lookup KTX_KEY_kbts kvd >>= KVD.fromValue) + <*> (Map.lookup KTX_KEY_kbts_version kvd >>= KVD.fromValue) + + (mtsdfZstd, kbtsZstd, kbtsVer) <- + case bundled of + Nothing -> + error "Missing KTXF metadata" + Just compressed -> + pure compressed + + unless (kbtsVer == kbtsVersion) $ + error $ "KBTS blob version mismatch: " <> show kbtsVer <> ", expected " <> show kbtsVersion + + atlas <- + case Zstd.decompress mtsdfZstd of + Zstd.Decompress json -> + either error pure $ eitherDecodeStrict json + Zstd.Skip -> + error "Empty atlas data" + Zstd.Error err -> + error $ "Atlas decompression error: " <> err + + fontData <- + case Zstd.decompress kbtsZstd of + Zstd.Decompress fontData -> + createFont fontData 0 + Zstd.Skip -> + error $ "Empty font data" + Zstd.Error err -> + error $ "Font decompression error: " <> err + + pure Bundle{..} + +freeBundle :: Bundle -> IO () +freeBundle Bundle{fontData} = destroyFont fontData + +-- * Shaping contexts + +data StackContext a = StackContext + { shapeContext :: MVar TextShape.Context + , bundled :: IntMap a + , atlases :: IntMap Compact -- XXX: Font.Handle ~ Ptr Font.Handle ~ Int + } + deriving stock (Functor, Foldable, Traversable, Generic, Generic1) + +{- | Create shaping context and push fonts from all the bundles. +-} +createStackContext :: Foldable t => t Bundle -> IO (StackContext ()) +createStackContext bundles = do + ctx <- TextShape.createContext + locals <- for (toList bundles) \Bundle{..} -> + withFontData fontData \font -> do + _refs <- TextShape.pushFont ctx font + pure (intHandle font, atlas) + let atlases = IntMap.fromList locals + let bundled = IntMap.map (const ()) atlases + shapeContext <- newMVar ctx + pure StackContext{..} + +{- | Update font annotations with the bundle collection annotated with update functions. + +This may be used to attach more information, e.g. after all fonts were assigned texture slots. + +The update collection should be a superset of what was initially bundled. +Otherwise you may see missing things downstream. +-} +mapWithBundle :: Foldable t => t (Bundle, Maybe a -> b) -> StackContext a -> StackContext b +mapWithBundle bundles StackContext{bundled = old, ..} = StackContext{bundled = new, ..} + where + new = IntMap.fromList do + (Bundle{fontData=Font.FontData{fontData}}, f) <- toList bundles + let key = intHandle $ unsafeForeignPtrToPtr fontData + pure (key, f $ IntMap.lookup key old) + +{- | Destroy shaping context. + +NB: Does NOT free the fonts as they may be shared with other stacks. Use `freeBundle` for that. +-} +destroyStackContext :: StackContext a -> IO () +destroyStackContext StackContext{shapeContext} = takeMVar shapeContext >>= TextShape.destroyContext + +{-# INLINE lookupBundled #-} +lookupBundled :: Font -> StackContext a -> Maybe a +lookupBundled font StackContext{..} = IntMap.lookup (intHandle font) bundled + +{-# INLINE lookupAtlas #-} +lookupAtlas :: Font -> StackContext a -> Maybe Compact +lookupAtlas font StackContext{atlases} = IntMap.lookup (intHandle font) atlases + +mapBundled :: (a -> b) -> StackContext a -> StackContext b +mapBundled f ctx@StackContext{bundled} = ctx + { bundled = IntMap.map f bundled + } diff --git a/src/Codec/Ktx2/Font/Shaping.hs b/src/Codec/Ktx2/Font/Shaping.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Ktx2/Font/Shaping.hs @@ -0,0 +1,166 @@ +module Codec.Ktx2.Font.Shaping + ( -- * Input + shapeText + , shape + , TextShape.text_ + , TextShape.char_ + , withFont_ + , shapeWith + , Cursor(..) + , initialCursorUp + , initialCursorDown + -- * Output + , PlacedRun + , PlacedGlyph(..) + -- * Re-exports + , KBTS.Font + , Atlas.Compact(..) + , Atlas.Box(..) + ) where + +import Codec.Ktx2.Font qualified as Font +import Control.Concurrent (withMVar) +import Data.List (mapAccumL) +import Data.Text (Text) +import Data.Text qualified as Text +import Graphics.MSDF.Atlas.Compact qualified as Atlas +import KB.Text.Shape qualified as TextShape +import KB.Text.Shape.FFI.Handles qualified as Handles +import KB.Text.Shape.Font qualified as KBTS + +{- | Perform text segmentation and shaping on a block of text +-} +shapeText :: Cursor -> Font.StackContext a -> Text -> IO [PlacedRun] +shapeText cur ctx t = + if Text.null t then + pure [] + else + shape cur ctx (TextShape.text_ t) + +{- | Perform text segmentation and shaping. + +Feed data using functions like 'TextShape.text_'. + +The next step would be converting the resulting glyph "runs" into API specific data. + +The atlas texture coordinates are normalized to 0..1 range. + +The glyph "model" coordinates are normallized to fonts' "capital height". +Multiply by font size to match your projection settings. +-} +shape + :: Cursor + -> Font.StackContext a + -> ((?shapeContext :: Handles.ShapeContext) => IO ()) + -> IO [PlacedRun] +shape cur ctx action = snd <$> shapeWith (collectRun ctx) cur ctx action + +{- | Run shaping and process results using a custom accumulator function +-} +shapeWith + :: (acc -> (TextShape.Run, [TextShape.Glyph]) -> (acc, placed)) -- ^ Results-collecting function + -> acc -- initial accumulator + -> Font.StackContext a -- ^ shaping context with + -> ((?shapeContext :: Handles.ShapeContext) => IO ()) + -> IO (acc, [placed]) +shapeWith collectFun cur Font.StackContext{shapeContext} action = + withMVar shapeContext \kbts -> + mapAccumL collectFun cur <$> TextShape.run kbts action + +withFont_ :: (?shapeContext :: Handles.ShapeContext) => Font.Bundle -> IO () -> IO () +withFont_ Font.Bundle{fontData} action = + KBTS.withFontData fontData \font -> + TextShape.withFont_ font action + +data Cursor = Cursor + { curX, curY :: Float + , lineHeight :: Float -- ^ Space between the baselines, as a multiple of the font size. + , ySign :: Float -- ^ Should match atlas yOrigin and screen direction. + } + deriving (Eq, Show) + +initialCursorUp + :: Float -- ^ Line height multiplier. + -> Cursor +initialCursorUp = initialCursor (-1) + +initialCursorDown + :: Float -- ^ Line height multiplier. + -> Cursor +initialCursorDown = initialCursor 1 + +initialCursor + :: Float -- ^ Y axis signum + -> Float -- ^ Line height multiplier. + -> Cursor +initialCursor ySign lineHeight = Cursor + { curX = 0 + , curY = 0 + , lineHeight + , ySign + } + +-- | Text runs with uniform direction and script. +type PlacedRun = + ( (KBTS.Font, Maybe Atlas.Compact) + , [PlacedGlyph] + ) + +data PlacedGlyph = PlacedGlyph + { codepoint :: Char -- ^ Unicode codepoint associated with the glyph. Mostly for debugging. + , glyphId :: Int -- ^ Glyph ID in font and atlas. You can use this to look up the glyph boxes from GPU if you upload the glyph data as arrays. + , glyph :: Atlas.Box -- ^ Glyph box on screen. The size and offsets are normalized so you can run the shaping once, then transform the whole block as you need. + , plane :: Atlas.Box -- ^ Glyph box in atlas. The size is normalized to UV of the texure. + } + deriving (Eq, Show) + +collectRun :: Font.StackContext a -> Cursor -> (TextShape.Run, [TextShape.Glyph]) -> (Cursor, PlacedRun) +collectRun ctx cur (TextShape.Run{font}, glyphs) = placeRun <$> mapAccumL (place fontUnitScale atlas_) cur glyphs + where + fontUnitScale = capHeightScale font + atlas_ = Font.lookupAtlas font ctx + + placeRun :: [(Char, Int, Maybe (Atlas.Box, Atlas.Box))] -> PlacedRun + placeRun placed = + ( (font, atlas_) + , do + (codepoint, glyphId, Just (glyph, plane)) <- placed + pure PlacedGlyph{codepoint, glyphId, glyph, plane} + ) + +-- | Normalize font metrics using "cap height" +capHeightScale :: KBTS.Font -> Float +capHeightScale font = case KBTS.capHeight font of + 0 -> error "capHeight not set" + n -> 1 / n + +-- -- | Normalize font metrics using "units per em" +-- emScale :: KBTS.Font -> Float +-- emScale font = 1 / KBTS.unitsPerEm font + +place :: Float -> Maybe Atlas.Compact -> Cursor -> TextShape.Glyph -> (Cursor, (Char, Int, Maybe (Atlas.Box, Atlas.Box))) +place fontUnitScale atlas_ cur@Cursor{..} glyph@TextShape.Glyph{codepoint, offsetX, offsetY, id=glyphId} = + ( nextCur + , (codepoint, fromIntegral glyphId, if codepoint == '\n' then Nothing else params_) + ) + where + nextCur = advance fontUnitScale cur glyph + + params_ = atlas_ >>= Atlas.lookupGlyph (fromIntegral glyphId) >>= pure . fmap placeGlyph + placeGlyph = + Atlas.moveBox + (curX + fromIntegral offsetX * fontUnitScale) + (curY + fromIntegral offsetY * fontUnitScale * ySign) + +advance :: Float -> Cursor -> TextShape.Glyph -> Cursor +advance fontUnitScale cur@Cursor{..} TextShape.Glyph{advanceX, advanceY, codepoint} = + if codepoint == '\n' then + cur + { curX = 0 + , curY = curY + lineHeight * ySign + } + else + cur + { curX = curX + fromIntegral advanceX * fontUnitScale + , curY = curY + fromIntegral advanceY * fontUnitScale * ySign + }