{- | 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, eitherDecodeFileStrict') import Foreign qualified import Geomancy (Vec2, vec2, pattern WithVec2) import RIO.HashMap qualified as HashMap import RIO.Text qualified as Text import Vulkan.NamedType ((:::)) import Engine.UI.Layout qualified as Layout -- * 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 :: HasLogFunc env => FilePath -> RIO env Container load fp = do logInfo $ "Loading font " <> fromString fp liftIO (eitherDecodeFileStrict' fp) >>= \case Left err -> throwM . 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)