EvanW.hs

{- |
  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)