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
  { Compact -> (Int, Int)
_atlasSize :: (Int, Int) -- ^ Atlas image size in pixels
  , Compact -> Float
_size :: Float -- ^ Font size in pixels
  , Compact -> AtlasType
_type :: AtlasType
  , Compact -> YOrigin
_yOrigin :: Atlas.YOrigin
  , Compact -> Vector Box
glyphs :: Storable.Vector Box -- ^ Glyph boxes in the atlas UV space, normalized
  , Compact -> Vector Box
planes :: Storable.Vector Box -- ^ Quad boxes in word space
  }
  deriving (Compact -> Compact -> Bool
(Compact -> Compact -> Bool)
-> (Compact -> Compact -> Bool) -> Eq Compact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Compact -> Compact -> Bool
== :: Compact -> Compact -> Bool
$c/= :: Compact -> Compact -> Bool
/= :: Compact -> Compact -> Bool
Eq, Eq Compact
Eq Compact =>
(Compact -> Compact -> Ordering)
-> (Compact -> Compact -> Bool)
-> (Compact -> Compact -> Bool)
-> (Compact -> Compact -> Bool)
-> (Compact -> Compact -> Bool)
-> (Compact -> Compact -> Compact)
-> (Compact -> Compact -> Compact)
-> Ord Compact
Compact -> Compact -> Bool
Compact -> Compact -> Ordering
Compact -> Compact -> Compact
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Compact -> Compact -> Ordering
compare :: Compact -> Compact -> Ordering
$c< :: Compact -> Compact -> Bool
< :: Compact -> Compact -> Bool
$c<= :: Compact -> Compact -> Bool
<= :: Compact -> Compact -> Bool
$c> :: Compact -> Compact -> Bool
> :: Compact -> Compact -> Bool
$c>= :: Compact -> Compact -> Bool
>= :: Compact -> Compact -> Bool
$cmax :: Compact -> Compact -> Compact
max :: Compact -> Compact -> Compact
$cmin :: Compact -> Compact -> Compact
min :: Compact -> Compact -> Compact
Ord, Int -> Compact -> ShowS
[Compact] -> ShowS
Compact -> String
(Int -> Compact -> ShowS)
-> (Compact -> String) -> ([Compact] -> ShowS) -> Show Compact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Compact -> ShowS
showsPrec :: Int -> Compact -> ShowS
$cshow :: Compact -> String
show :: Compact -> String
$cshowList :: [Compact] -> ShowS
showList :: [Compact] -> ShowS
Show, (forall x. Compact -> Rep Compact x)
-> (forall x. Rep Compact x -> Compact) -> Generic Compact
forall x. Rep Compact x -> Compact
forall x. Compact -> Rep Compact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Compact -> Rep Compact x
from :: forall x. Compact -> Rep Compact x
$cto :: forall x. Rep Compact x -> Compact
to :: forall x. Rep Compact x -> Compact
Generic, Maybe Compact
Value -> Parser [Compact]
Value -> Parser Compact
(Value -> Parser Compact)
-> (Value -> Parser [Compact]) -> Maybe Compact -> FromJSON Compact
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Compact
parseJSON :: Value -> Parser Compact
$cparseJSONList :: Value -> Parser [Compact]
parseJSONList :: Value -> Parser [Compact]
$comittedField :: Maybe Compact
omittedField :: Maybe Compact
FromJSON, [Compact] -> Value
[Compact] -> Encoding
Compact -> Bool
Compact -> Value
Compact -> Encoding
(Compact -> Value)
-> (Compact -> Encoding)
-> ([Compact] -> Value)
-> ([Compact] -> Encoding)
-> (Compact -> Bool)
-> ToJSON Compact
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Compact -> Value
toJSON :: Compact -> Value
$ctoEncoding :: Compact -> Encoding
toEncoding :: Compact -> Encoding
$ctoJSONList :: [Compact] -> Value
toJSONList :: [Compact] -> Value
$ctoEncodingList :: [Compact] -> Encoding
toEncodingList :: [Compact] -> Encoding
$comitField :: Compact -> Bool
omitField :: Compact -> Bool
ToJSON)

data Box = Box {Box -> Float
x, Box -> Float
y, Box -> Float
w, Box -> Float
h :: Float}
  deriving (Box -> Box -> Bool
(Box -> Box -> Bool) -> (Box -> Box -> Bool) -> Eq Box
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Box -> Box -> Bool
== :: Box -> Box -> Bool
$c/= :: Box -> Box -> Bool
/= :: Box -> Box -> Bool
Eq, Eq Box
Eq Box =>
(Box -> Box -> Ordering)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Bool)
-> (Box -> Box -> Box)
-> (Box -> Box -> Box)
-> Ord Box
Box -> Box -> Bool
Box -> Box -> Ordering
Box -> Box -> Box
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Box -> Box -> Ordering
compare :: Box -> Box -> Ordering
$c< :: Box -> Box -> Bool
< :: Box -> Box -> Bool
$c<= :: Box -> Box -> Bool
<= :: Box -> Box -> Bool
$c> :: Box -> Box -> Bool
> :: Box -> Box -> Bool
$c>= :: Box -> Box -> Bool
>= :: Box -> Box -> Bool
$cmax :: Box -> Box -> Box
max :: Box -> Box -> Box
$cmin :: Box -> Box -> Box
min :: Box -> Box -> Box
Ord, Int -> Box -> ShowS
[Box] -> ShowS
Box -> String
(Int -> Box -> ShowS)
-> (Box -> String) -> ([Box] -> ShowS) -> Show Box
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Box -> ShowS
showsPrec :: Int -> Box -> ShowS
$cshow :: Box -> String
show :: Box -> String
$cshowList :: [Box] -> ShowS
showList :: [Box] -> ShowS
Show, (forall x. Box -> Rep Box x)
-> (forall x. Rep Box x -> Box) -> Generic Box
forall x. Rep Box x -> Box
forall x. Box -> Rep Box x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Box -> Rep Box x
from :: forall x. Box -> Rep Box x
$cto :: forall x. Rep Box x -> Box
to :: forall x. Rep Box x -> Box
Generic, Maybe Box
Value -> Parser [Box]
Value -> Parser Box
(Value -> Parser Box)
-> (Value -> Parser [Box]) -> Maybe Box -> FromJSON Box
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Box
parseJSON :: Value -> Parser Box
$cparseJSONList :: Value -> Parser [Box]
parseJSONList :: Value -> Parser [Box]
$comittedField :: Maybe Box
omittedField :: Maybe Box
FromJSON, [Box] -> Value
[Box] -> Encoding
Box -> Bool
Box -> Value
Box -> Encoding
(Box -> Value)
-> (Box -> Encoding)
-> ([Box] -> Value)
-> ([Box] -> Encoding)
-> (Box -> Bool)
-> ToJSON Box
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Box -> Value
toJSON :: Box -> Value
$ctoEncoding :: Box -> Encoding
toEncoding :: Box -> Encoding
$ctoJSONList :: [Box] -> Value
toJSONList :: [Box] -> Value
$ctoEncodingList :: [Box] -> Encoding
toEncodingList :: [Box] -> Encoding
$comitField :: Box -> Bool
omitField :: Box -> Bool
ToJSON)

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

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

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

instance Storable Box where
  alignment :: Box -> Int
alignment ~Box
_ = Int
16
  sizeOf :: Box -> Int
sizeOf ~Box
_ = Int
16
  peek :: Ptr Box -> IO Box
peek Ptr Box
ptr = Float -> Float -> Float -> Float -> Box
Box
    (Float -> Float -> Float -> Float -> Box)
-> IO Float -> IO (Float -> Float -> Float -> Box)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Box -> Int -> IO Float
forall b. Ptr b -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Box
ptr Int
0
    IO (Float -> Float -> Float -> Box)
-> IO Float -> IO (Float -> Float -> Box)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Box -> Int -> IO Float
forall b. Ptr b -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Box
ptr Int
4
    IO (Float -> Float -> Box) -> IO Float -> IO (Float -> Box)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Box -> Int -> IO Float
forall b. Ptr b -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Box
ptr Int
8
    IO (Float -> Box) -> IO Float -> IO Box
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Box -> Int -> IO Float
forall b. Ptr b -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Box
ptr Int
12
  poke :: Ptr Box -> Box -> IO ()
poke Ptr Box
ptr Box{Float
x :: Box -> Float
y :: Box -> Float
w :: Box -> Float
h :: Box -> Float
x :: Float
y :: Float
w :: Float
h :: Float
..} = do
    Ptr Box -> Int -> Float -> IO ()
forall b. Ptr b -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Box
ptr Int
0 Float
x
    Ptr Box -> Int -> Float -> IO ()
forall b. Ptr b -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Box
ptr Int
4 Float
y
    Ptr Box -> Int -> Float -> IO ()
forall b. Ptr b -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Box
ptr Int
8 Float
w
    Ptr Box -> Int -> Float -> IO ()
forall b. Ptr b -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Box
ptr Int
12 Float
h

compact :: Layout -> Compact
compact :: Layout -> Compact
compact Layout{atlas :: Layout -> Atlas
atlas=Atlas{Float
Int
Maybe Float
YOrigin
AtlasType
aType :: AtlasType
distanceRange :: Maybe Float
distanceRangeMiddle :: Maybe Float
size :: Float
width :: Int
height :: Int
yOrigin :: YOrigin
yOrigin :: Atlas -> YOrigin
height :: Atlas -> Int
width :: Atlas -> Int
size :: Atlas -> Float
distanceRangeMiddle :: Atlas -> Maybe Float
distanceRange :: Atlas -> Maybe Float
aType :: Atlas -> AtlasType
..}, glyphs :: Layout -> Vector Glyph
glyphs=Vector Glyph
aGlyphs} =
  Compact
    { _atlasSize :: (Int, Int)
_atlasSize = (Int
width, Int
height)
    , _size :: Float
_size = Float
size
    , _type :: AtlasType
_type = AtlasType
aType
    , _yOrigin :: YOrigin
_yOrigin = YOrigin
yOrigin
    , glyphs :: Vector Box
glyphs = Vector Box -> Vector Box
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Storable.convert Vector Box
as
    , planes :: Vector Box
planes = Vector Box -> Vector Box
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Storable.convert Vector Box
ps
    }
  where
    u :: Float
u = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width
    v :: Float
v = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height

    (Vector Box
as, Vector Box
ps) = Vector (Box, Box) -> (Vector Box, Vector Box)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v (a, b) -> (v a, v b)
Vector.unzip do
      Atlas.Glyph{Maybe Bounds
planeBounds :: Maybe Bounds
planeBounds :: Glyph -> Maybe Bounds
planeBounds, Maybe Bounds
atlasBounds :: Maybe Bounds
atlasBounds :: Glyph -> Maybe Bounds
atlasBounds} <- Vector Glyph
aGlyphs
      (Box, Box) -> Vector (Box, Box)
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Box -> (Bounds -> Box) -> Maybe Bounds -> Box
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Box
nullBox Bounds -> Box
atlasBox Maybe Bounds
atlasBounds
        , Box -> (Bounds -> Box) -> Maybe Bounds -> Box
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Box
nullBox Bounds -> Box
planeBox Maybe Bounds
planeBounds
        )

    atlasBox :: Bounds -> Box
atlasBox Atlas.Bounds{Float
left :: Float
top :: Float
right :: Float
bottom :: Float
bottom :: Bounds -> Float
right :: Bounds -> Float
top :: Bounds -> Float
left :: Bounds -> Float
..} = Box{Float
x :: Float
y :: Float
w :: Float
h :: Float
x :: Float
y :: Float
w :: Float
h :: Float
..}
      where
        x :: Float
x = Float
left Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u
        y :: Float
y = (if YOrigin
yOrigin YOrigin -> YOrigin -> Bool
forall a. Eq a => a -> a -> Bool
== YOrigin
Atlas.Top then Float
top else Float
bottom) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v
        w :: Float
w = Float -> Float
forall a. Num a => a -> a
abs (Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
left) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u
        h :: Float
h = Float -> Float
forall a. Num a => a -> a
abs (Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
bottom) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v

    planeBox :: Bounds -> Box
planeBox Atlas.Bounds{Float
bottom :: Bounds -> Float
right :: Bounds -> Float
top :: Bounds -> Float
left :: Bounds -> Float
left :: Float
top :: Float
right :: Float
bottom :: Float
..} = Box{Float
x :: Float
y :: Float
w :: Float
h :: Float
x :: Float
y :: Float
w :: Float
h :: Float
..}
      where
        x :: Float
x = Float
left Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
        y :: Float
y = Float -> Float
ySign (Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
bottom Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5)
        w :: Float
w = Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
left
        h :: Float
h = Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
bottom
        ySign :: Float -> Float
ySign =
          if YOrigin
yOrigin YOrigin -> YOrigin -> Bool
forall a. Eq a => a -> a -> Bool
== YOrigin
Atlas.Top then Float -> Float
forall a. Num a => a -> a
negate else Float -> Float
forall a. a -> a
id

lookupGlyph :: Int -> Compact -> Maybe (Box, Box)
lookupGlyph :: Int -> Compact -> Maybe (Box, Box)
lookupGlyph Int
ix Compact{Vector Box
glyphs :: Compact -> Vector Box
glyphs :: Vector Box
glyphs, Vector Box
planes :: Compact -> Vector Box
planes :: Vector Box
planes} =
  (,) (Box -> Box -> (Box, Box))
-> Maybe Box -> Maybe (Box -> (Box, Box))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Box -> Int -> Maybe Box
forall (v :: * -> *) a (m :: * -> *).
(HasCallStack, Vector v a, Monad m) =>
v a -> Int -> m a
Vector.indexM Vector Box
glyphs Int
ix Maybe (Box -> (Box, Box)) -> Maybe Box -> Maybe (Box, Box)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector Box -> Int -> Maybe Box
forall (v :: * -> *) a (m :: * -> *).
(HasCallStack, Vector v a, Monad m) =>
v a -> Int -> m a
Vector.indexM Vector Box
planes Int
ix