Compact.hs

module Graphics.MSDF.Atlas.Compact
  ( compact
  , lookupGlyph
  , Compact(..)
  , Box(..)
  , nullBox
  , moveBox
  , scaleBox
  ) where

import Data.Aeson.Types (FromJSON(..), ToJSON(..))
import Data.Vector.Storable qualified as Storable
import Data.Vector.Generic qualified as Vector
import Foreign (Storable(..))
import GHC.Generics (Generic)

import Graphics.MSDF.Atlas.Layout (AtlasType, Layout (..), Atlas (..))
import qualified Graphics.MSDF.Atlas.Layout as Atlas

data Compact = Compact
  { _atlasSize :: (Int, Int) -- ^ Atlas image size in pixels
  , _size :: Float -- ^ Font size in pixels
  , _type :: AtlasType
  , _yOrigin :: Atlas.YOrigin
  , glyphs :: Storable.Vector Box -- ^ Glyph boxes in the atlas UV space, normalized
  , planes :: Storable.Vector Box -- ^ Quad boxes in word space
  }
  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)

data Box = Box {x, y, w, h :: Float}
  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)

{-# INLINEABLE nullBox #-}
nullBox :: Box
nullBox = Box 0 0 0 0

{-# INLINEABLE moveBox #-}
moveBox :: Float -> Float -> Box -> Box
moveBox tx ty box@Box{x, y} = box {x = x + tx, y = y + ty}

{-# INLINEABLE scaleBox #-}
scaleBox :: Float -> Box -> Box
scaleBox s Box{x, y, w, h} = Box {x = x * s, y = y * s, w = w * s, h = h * s}

instance Storable Box where
  alignment ~_ = 16
  sizeOf ~_ = 16
  peek ptr = Box
    <$> peekByteOff ptr 0
    <*> peekByteOff ptr 4
    <*> peekByteOff ptr 8
    <*> peekByteOff ptr 12
  poke ptr Box{..} = do
    pokeByteOff ptr 0 x
    pokeByteOff ptr 4 y
    pokeByteOff ptr 8 w
    pokeByteOff ptr 12 h

compact :: Layout -> Compact
compact Layout{atlas=Atlas{..}, glyphs=aGlyphs} =
  Compact
    { _atlasSize = (width, height)
    , _size = size
    , _type = aType
    , _yOrigin = yOrigin
    , glyphs = Storable.convert as
    , planes = Storable.convert ps
    }
  where
    u = 1 / fromIntegral width
    v = 1 / fromIntegral height

    (as, ps) = Vector.unzip do
      Atlas.Glyph{planeBounds, atlasBounds} <- aGlyphs
      pure
        ( maybe nullBox atlasBox atlasBounds
        , maybe nullBox planeBox planeBounds
        )

    atlasBox Atlas.Bounds{..} = Box{..}
      where
        x = left * u
        y = (if yOrigin == Atlas.Top then top else bottom) * v
        w = abs (right - left) * u
        h = abs (top - bottom) * v

    planeBox Atlas.Bounds{..} = Box{..}
      where
        x = left * 0.5 + right * 0.5
        y = ySign (top * 0.5 + bottom * 0.5)
        w = abs $ right - left
        h = abs $ top - bottom
        ySign =
          if yOrigin == Atlas.Top then negate else id

lookupGlyph :: Int -> Compact -> Maybe (Box, Box)
lookupGlyph ix Compact{glyphs, planes} =
  (,) <$> Vector.indexM glyphs ix <*> Vector.indexM planes ix