{- | JSON font loader for bitmaps and SDFs Generator: https://evanw.github.io/font-texture-generator/ Usage (WebGL): https://evanw.github.io/font-texture-generator/example-webgl/ -} module Resource.Font.EvanW ( load , Container(..) , Character(..) , putLine , PutChar(..) ) where import RIO import Data.Aeson (FromJSON, eitherDecodeStrict') import Foreign qualified import Geomancy (Vec2, vec2, pattern WithVec2) import GHC.Stack (withFrozenCallStack) import RIO.HashMap qualified as HashMap import RIO.Text qualified as Text import Vulkan.NamedType ((:::)) import Engine.UI.Layout qualified as Layout import Resource.Source (Source) import Resource.Source qualified as Source -- * Loading newtype FontError = FontError Text deriving (Eq, Ord, Show, Generic) instance Exception FontError data Container = Container { name :: Text , size :: Float , bold :: Bool , italic :: Bool , width :: Float , height :: Float , characters :: HashMap Char Character } deriving (Eq, Ord, Show, Generic) data Character = Character { x :: Float , y :: Float , width :: Float , height :: Float , originX :: Float , originY :: Float , advance :: Float } deriving (Eq, Ord, Show, Generic) instance FromJSON Container instance FromJSON Character load :: ( MonadIO m , MonadReader env m , HasLogFunc env , HasCallStack ) => Source -> m Container load = withFrozenCallStack . Source.load \bytes -> case eitherDecodeStrict' bytes of Left err -> liftIO . throwIO . FontError $ Text.pack err Right res -> pure res -- * Typesetting data PutChar = PutChar { pcPos :: Vec2 , pcSize :: Vec2 , pcOffset :: Vec2 , pcScale :: Vec2 } deriving (Show) instance Foreign.Storable PutChar where alignment ~_ = 16 sizeOf ~_ = 32 -- 4 of pairs of floats peek ptr = PutChar <$> Foreign.peekElemOff (Foreign.castPtr ptr) 0 <*> Foreign.peekElemOff (Foreign.castPtr ptr) 1 <*> Foreign.peekElemOff (Foreign.castPtr ptr) 2 <*> Foreign.peekElemOff (Foreign.castPtr ptr) 3 poke ptr PutChar{..} = do Foreign.pokeElemOff (Foreign.castPtr ptr) 0 pcPos Foreign.pokeElemOff (Foreign.castPtr ptr) 1 pcSize Foreign.pokeElemOff (Foreign.castPtr ptr) 2 pcOffset Foreign.pokeElemOff (Foreign.castPtr ptr) 3 pcScale putLine :: "WH" ::: Vec2 -> "XY" ::: Vec2 -> "Alignment" ::: Layout.Alignment -> "Size" ::: Float -> "Font" ::: Container -> "Line" ::: [Char] -> ("scale" ::: Float, [PutChar]) putLine (WithVec2 cw ch) (WithVec2 cx cy) Layout.Alignment{..} targetSize font = (sizeScale,) . extract . foldl' step (0, 0, []) where Container { size = fontSize , width = atlasWidth , height = atlasHeight , characters } = font sizeScale = targetSize / fontSize extract (offX, _offY, bits) = do (WithVec2 w h, WithVec2 x y, (offset, scale)) <- bits let ax = case alignX of Layout.Begin -> -cw / 2 Layout.Middle -> -offX * sizeScale / 2 Layout.End -> cw / 2 - offX * sizeScale ay = case alignY of Layout.Begin -> -ch / 2 + targetSize * 1.3 Layout.Middle -> targetSize * 0.5 Layout.End -> ch / 2 - targetSize * 0.5 pure PutChar { pcPos = vec2 (cx + ax + x * sizeScale) (cy + ay + y * sizeScale) , pcSize = vec2 (w * sizeScale) (h * sizeScale) , pcOffset = offset , pcScale = scale } step (offX, offY, acc) ' ' = ( offX + fontSize / 2 , offY , acc ) step (offX, offY, acc) char = case HashMap.lookup char characters <|> HashMap.lookup '?' characters of Nothing -> (offX, offY, acc) Just Character{..} -> ( offX + advance , offY , ( vec2 width (-height) , vec2 ox oy , (uvOffset, uvScale) ) : acc ) where ox = offX + width / 2 - originX oy = offY + height / 2 - originY uvOffset = vec2 (x / atlasWidth) (y / atlasHeight) uvScale = vec2 (width / atlasWidth) (height / atlasHeight)