ktx-font (empty) → 0.1.0.0

raw patch · 6 files changed

+560/−0 lines, 6 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, containers, kb-text-shape, ktx-codec, msdf-atlas, text, vector, zstd

Files

CHANGELOG.md +11/−0
LICENSE +26/−0
README.md +62/−0
ktx-font.cabal +73/−0
src/Codec/Ktx2/Font.hs +222/−0
src/Codec/Ktx2/Font/Shaping.hs +166/−0

+ CHANGELOG.md view

@@ -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.

+ LICENSE view

@@ -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.

+ README.md view

@@ -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.

+ ktx-font.cabal view

@@ -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

+ src/Codec/Ktx2/Font.hs view

@@ -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+  }

+ src/Codec/Ktx2/Font/Shaping.hs view

@@ -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+      }