Compact.hs

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

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

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

data Compact = Compact
  { _atlasSize :: (Int, Int) -- ^ Atlas image size in pixels
  , _size :: Float -- ^ Font size in pixels
  , _type :: AtlasType
  , _yOrigin :: Atlas.YOrigin
  , _distanceLower :: Float -- ^ SDF range lower bound, in pixels
  , _distanceRange :: Float -- ^ SDF range in pixels
  , 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
    , _distanceLower = fromMaybe 0 $ (\r m -> m - 0.5 * r) <$> distanceRange <*> distanceRangeMiddle
    , _distanceRange = fromMaybe 0 distanceRange
    , 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