{- |
  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 Geomancy.Layout qualified as Layout
import Geomancy.Layout.Alignment (Alignment)
import Geomancy.Layout.Box (Box(..))
import Geomancy.Layout.Box qualified as Box
import GHC.Stack (withFrozenCallStack)
import RIO.HashMap qualified as HashMap
import RIO.Text qualified as Text
import Vulkan.NamedType ((:::))

import Resource.Source (Source)
import Resource.Source qualified as Source

-- * Loading

newtype FontError = FontError Text
  deriving (FontError -> FontError -> Bool
(FontError -> FontError -> Bool)
-> (FontError -> FontError -> Bool) -> Eq FontError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontError -> FontError -> Bool
== :: FontError -> FontError -> Bool
$c/= :: FontError -> FontError -> Bool
/= :: FontError -> FontError -> Bool
Eq, Eq FontError
Eq FontError
-> (FontError -> FontError -> Ordering)
-> (FontError -> FontError -> Bool)
-> (FontError -> FontError -> Bool)
-> (FontError -> FontError -> Bool)
-> (FontError -> FontError -> Bool)
-> (FontError -> FontError -> FontError)
-> (FontError -> FontError -> FontError)
-> Ord FontError
FontError -> FontError -> Bool
FontError -> FontError -> Ordering
FontError -> FontError -> FontError
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 :: FontError -> FontError -> Ordering
compare :: FontError -> FontError -> Ordering
$c< :: FontError -> FontError -> Bool
< :: FontError -> FontError -> Bool
$c<= :: FontError -> FontError -> Bool
<= :: FontError -> FontError -> Bool
$c> :: FontError -> FontError -> Bool
> :: FontError -> FontError -> Bool
$c>= :: FontError -> FontError -> Bool
>= :: FontError -> FontError -> Bool
$cmax :: FontError -> FontError -> FontError
max :: FontError -> FontError -> FontError
$cmin :: FontError -> FontError -> FontError
min :: FontError -> FontError -> FontError
Ord, Int -> FontError -> ShowS
[FontError] -> ShowS
FontError -> String
(Int -> FontError -> ShowS)
-> (FontError -> String)
-> ([FontError] -> ShowS)
-> Show FontError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontError -> ShowS
showsPrec :: Int -> FontError -> ShowS
$cshow :: FontError -> String
show :: FontError -> String
$cshowList :: [FontError] -> ShowS
showList :: [FontError] -> ShowS
Show, (forall x. FontError -> Rep FontError x)
-> (forall x. Rep FontError x -> FontError) -> Generic FontError
forall x. Rep FontError x -> FontError
forall x. FontError -> Rep FontError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FontError -> Rep FontError x
from :: forall x. FontError -> Rep FontError x
$cto :: forall x. Rep FontError x -> FontError
to :: forall x. Rep FontError x -> FontError
Generic)

instance Exception FontError

data Container = Container
  { Container -> Text
name       :: Text
  , Container -> Float
size       :: Float
  , Container -> Bool
bold       :: Bool
  , Container -> Bool
italic     :: Bool
  , Container -> Float
width      :: Float
  , Container -> Float
height     :: Float
  , Container -> HashMap Char Character
characters :: HashMap Char Character
  }
  deriving (Container -> Container -> Bool
(Container -> Container -> Bool)
-> (Container -> Container -> Bool) -> Eq Container
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Container -> Container -> Bool
== :: Container -> Container -> Bool
$c/= :: Container -> Container -> Bool
/= :: Container -> Container -> Bool
Eq, Eq Container
Eq Container
-> (Container -> Container -> Ordering)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Bool)
-> (Container -> Container -> Container)
-> (Container -> Container -> Container)
-> Ord Container
Container -> Container -> Bool
Container -> Container -> Ordering
Container -> Container -> Container
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 :: Container -> Container -> Ordering
compare :: Container -> Container -> Ordering
$c< :: Container -> Container -> Bool
< :: Container -> Container -> Bool
$c<= :: Container -> Container -> Bool
<= :: Container -> Container -> Bool
$c> :: Container -> Container -> Bool
> :: Container -> Container -> Bool
$c>= :: Container -> Container -> Bool
>= :: Container -> Container -> Bool
$cmax :: Container -> Container -> Container
max :: Container -> Container -> Container
$cmin :: Container -> Container -> Container
min :: Container -> Container -> Container
Ord, Int -> Container -> ShowS
[Container] -> ShowS
Container -> String
(Int -> Container -> ShowS)
-> (Container -> String)
-> ([Container] -> ShowS)
-> Show Container
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Container -> ShowS
showsPrec :: Int -> Container -> ShowS
$cshow :: Container -> String
show :: Container -> String
$cshowList :: [Container] -> ShowS
showList :: [Container] -> ShowS
Show, (forall x. Container -> Rep Container x)
-> (forall x. Rep Container x -> Container) -> Generic Container
forall x. Rep Container x -> Container
forall x. Container -> Rep Container x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Container -> Rep Container x
from :: forall x. Container -> Rep Container x
$cto :: forall x. Rep Container x -> Container
to :: forall x. Rep Container x -> Container
Generic)

data Character = Character
  { Character -> Float
x       :: Float
  , Character -> Float
y       :: Float
  , Character -> Float
width   :: Float
  , Character -> Float
height  :: Float
  , Character -> Float
originX :: Float
  , Character -> Float
originY :: Float
  , Character -> Float
advance :: Float
  }
  deriving (Character -> Character -> Bool
(Character -> Character -> Bool)
-> (Character -> Character -> Bool) -> Eq Character
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Character -> Character -> Bool
== :: Character -> Character -> Bool
$c/= :: Character -> Character -> Bool
/= :: Character -> Character -> Bool
Eq, Eq Character
Eq Character
-> (Character -> Character -> Ordering)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Bool)
-> (Character -> Character -> Character)
-> (Character -> Character -> Character)
-> Ord Character
Character -> Character -> Bool
Character -> Character -> Ordering
Character -> Character -> Character
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 :: Character -> Character -> Ordering
compare :: Character -> Character -> Ordering
$c< :: Character -> Character -> Bool
< :: Character -> Character -> Bool
$c<= :: Character -> Character -> Bool
<= :: Character -> Character -> Bool
$c> :: Character -> Character -> Bool
> :: Character -> Character -> Bool
$c>= :: Character -> Character -> Bool
>= :: Character -> Character -> Bool
$cmax :: Character -> Character -> Character
max :: Character -> Character -> Character
$cmin :: Character -> Character -> Character
min :: Character -> Character -> Character
Ord, Int -> Character -> ShowS
[Character] -> ShowS
Character -> String
(Int -> Character -> ShowS)
-> (Character -> String)
-> ([Character] -> ShowS)
-> Show Character
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Character -> ShowS
showsPrec :: Int -> Character -> ShowS
$cshow :: Character -> String
show :: Character -> String
$cshowList :: [Character] -> ShowS
showList :: [Character] -> ShowS
Show, (forall x. Character -> Rep Character x)
-> (forall x. Rep Character x -> Character) -> Generic Character
forall x. Rep Character x -> Character
forall x. Character -> Rep Character x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Character -> Rep Character x
from :: forall x. Character -> Rep Character x
$cto :: forall x. Rep Character x -> Character
to :: forall x. Rep Character x -> Character
Generic)

instance FromJSON Container
instance FromJSON Character

load
  :: ( MonadIO m
     , MonadReader env m
     , HasLogFunc env
     , HasCallStack
     )
  => Source -> m Container
load :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Source -> m Container
load =
  (HasCallStack => Source -> m Container) -> Source -> m Container
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Source -> m Container) -> Source -> m Container)
-> (HasCallStack => Source -> m Container) -> Source -> m Container
forall a b. (a -> b) -> a -> b
$
    (ByteString -> m Container) -> Source -> m Container
forall a (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, Typeable a,
 HasCallStack) =>
(ByteString -> m a) -> Source -> m a
Source.load \ByteString
bytes ->
      case ByteString -> Either String Container
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
bytes of
        Left String
err ->
          IO Container -> m Container
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Container -> m Container)
-> (Text -> IO Container) -> Text -> m Container
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontError -> IO Container
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FontError -> IO Container)
-> (Text -> FontError) -> Text -> IO Container
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FontError
FontError (Text -> m Container) -> Text -> m Container
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
err
        Right Container
res ->
          Container -> m Container
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Container
res

-- * Typesetting

data PutChar = PutChar
  { PutChar -> Vec2
pcPos    :: Vec2
  , PutChar -> Vec2
pcSize   :: Vec2
  , PutChar -> Vec2
pcOffset :: Vec2
  , PutChar -> Vec2
pcScale  :: Vec2
  } deriving (Int -> PutChar -> ShowS
[PutChar] -> ShowS
PutChar -> String
(Int -> PutChar -> ShowS)
-> (PutChar -> String) -> ([PutChar] -> ShowS) -> Show PutChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PutChar -> ShowS
showsPrec :: Int -> PutChar -> ShowS
$cshow :: PutChar -> String
show :: PutChar -> String
$cshowList :: [PutChar] -> ShowS
showList :: [PutChar] -> ShowS
Show)

instance Foreign.Storable PutChar where
  alignment :: PutChar -> Int
alignment ~PutChar
_ = Int
16

  sizeOf :: PutChar -> Int
sizeOf ~PutChar
_ = Int
32 -- 4 of pairs of floats

  peek :: Ptr PutChar -> IO PutChar
peek Ptr PutChar
ptr = Vec2 -> Vec2 -> Vec2 -> Vec2 -> PutChar
PutChar
    (Vec2 -> Vec2 -> Vec2 -> Vec2 -> PutChar)
-> IO Vec2 -> IO (Vec2 -> Vec2 -> Vec2 -> PutChar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vec2 -> Int -> IO Vec2
forall a. Storable a => Ptr a -> Int -> IO a
Foreign.peekElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
0
    IO (Vec2 -> Vec2 -> Vec2 -> PutChar)
-> IO Vec2 -> IO (Vec2 -> Vec2 -> PutChar)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Vec2 -> Int -> IO Vec2
forall a. Storable a => Ptr a -> Int -> IO a
Foreign.peekElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
1
    IO (Vec2 -> Vec2 -> PutChar) -> IO Vec2 -> IO (Vec2 -> PutChar)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Vec2 -> Int -> IO Vec2
forall a. Storable a => Ptr a -> Int -> IO a
Foreign.peekElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
2
    IO (Vec2 -> PutChar) -> IO Vec2 -> IO PutChar
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Vec2 -> Int -> IO Vec2
forall a. Storable a => Ptr a -> Int -> IO a
Foreign.peekElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
3

  poke :: Ptr PutChar -> PutChar -> IO ()
poke Ptr PutChar
ptr PutChar{Vec2
$sel:pcPos:PutChar :: PutChar -> Vec2
$sel:pcSize:PutChar :: PutChar -> Vec2
$sel:pcOffset:PutChar :: PutChar -> Vec2
$sel:pcScale:PutChar :: PutChar -> Vec2
pcPos :: Vec2
pcSize :: Vec2
pcOffset :: Vec2
pcScale :: Vec2
..} = do
    Ptr Vec2 -> Int -> Vec2 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
Foreign.pokeElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
0 Vec2
pcPos
    Ptr Vec2 -> Int -> Vec2 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
Foreign.pokeElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
1 Vec2
pcSize
    Ptr Vec2 -> Int -> Vec2 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
Foreign.pokeElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
2 Vec2
pcOffset
    Ptr Vec2 -> Int -> Vec2 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
Foreign.pokeElemOff (Ptr PutChar -> Ptr Vec2
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr PutChar
ptr) Int
3 Vec2
pcScale

putLine
  :: "WH"        ::: Vec2
  -> "XY"        ::: Vec2
  -> "Alignment" ::: Alignment
  -> "Size"      ::: Float
  -> "Font"      ::: Container
  -> "Line"      ::: [Char]
  -> ("scale" ::: Float, [PutChar])
putLine :: Vec2
-> Vec2
-> Vec2
-> Float
-> Container
-> String
-> (Float, [PutChar])
putLine Vec2
bs Vec2
bp Vec2
a Float
targetSize Container
font =
  (Float
sizeScale,) ([PutChar] -> (Float, [PutChar]))
-> (String -> [PutChar]) -> String -> (Float, [PutChar])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, [(Vec2, Vec2, (Vec2, Vec2))]) -> [PutChar]
extract ((Float, [(Vec2, Vec2, (Vec2, Vec2))]) -> [PutChar])
-> (String -> (Float, [(Vec2, Vec2, (Vec2, Vec2))]))
-> String
-> [PutChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, [(Vec2, Vec2, (Vec2, Vec2))])
 -> Char -> (Float, [(Vec2, Vec2, (Vec2, Vec2))]))
-> (Float, [(Vec2, Vec2, (Vec2, Vec2))])
-> String
-> (Float, [(Vec2, Vec2, (Vec2, Vec2))])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Float, [(Vec2, Vec2, (Vec2, Vec2))])
-> Char -> (Float, [(Vec2, Vec2, (Vec2, Vec2))])
step (Float
0, [])
  where
    parent :: Box
parent = Box
      { position :: Vec2
position = Vec2
bp
      , size :: Vec2
size = Vec2
bs
      }

    Container
      { $sel:size:Container :: Container -> Float
size   = Float
fontSize
      , $sel:width:Container :: Container -> Float
width  = Float
atlasWidth
      , $sel:height:Container :: Container -> Float
height = Float
atlasHeight
      , HashMap Char Character
$sel:characters:Container :: Container -> HashMap Char Character
characters :: HashMap Char Character
characters
      } = Container
font

    sizeScale :: Float
sizeScale = Float
targetSize Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
fontSize
    baseline :: Float
baseline = Float
0.7125

    extract :: (Float, [(Vec2, Vec2, (Vec2, Vec2))]) -> [PutChar]
extract (Float
offX, [(Vec2, Vec2, (Vec2, Vec2))]
bits) =
      Box -> WithTRBL [PutChar] -> [PutChar]
forall r. Box -> WithTRBL r -> r
Box.withTRBL (Vec2 -> Vec2 -> Box -> Box
Layout.placeSize Vec2
a (Float -> Float -> Vec2
vec2 (Float
offX Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale) Float
targetSize) Box
parent) \Float
t Float
_r Float
_b Float
l -> do
        (WithVec2 Float
w Float
h, WithVec2 Float
x Float
y, (Vec2
pcOffset, Vec2
pcScale)) <- [(Vec2, Vec2, (Vec2, Vec2))]
bits
        let
          pcPos :: Vec2
pcPos =
            Float -> Float -> Vec2
vec2
              (Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale)
              (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
baseline Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
targetSize)

          pcSize :: Vec2
pcSize =
            Float -> Float -> Vec2
vec2
              (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale)
              (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale)

        PutChar -> [PutChar]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure PutChar{Vec2
$sel:pcPos:PutChar :: Vec2
$sel:pcSize:PutChar :: Vec2
$sel:pcOffset:PutChar :: Vec2
$sel:pcScale:PutChar :: Vec2
pcOffset :: Vec2
pcScale :: Vec2
pcPos :: Vec2
pcSize :: Vec2
..}

    step :: (Float, [(Vec2, Vec2, (Vec2, Vec2))])
-> Char -> (Float, [(Vec2, Vec2, (Vec2, Vec2))])
step (Float
offX, [(Vec2, Vec2, (Vec2, Vec2))]
acc) = \case
      Char
' ' ->
        ( Float
offX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
fontSize Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        , [(Vec2, Vec2, (Vec2, Vec2))]
acc
        )

      Char
char ->
        case Char -> HashMap Char Character -> Maybe Character
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Char
char HashMap Char Character
characters of
          Maybe Character
Nothing ->
            ( Float
offX
            , [(Vec2, Vec2, (Vec2, Vec2))]
acc
            )
          Just Character{Float
$sel:x:Character :: Character -> Float
$sel:y:Character :: Character -> Float
$sel:width:Character :: Character -> Float
$sel:height:Character :: Character -> Float
$sel:originX:Character :: Character -> Float
$sel:originY:Character :: Character -> Float
$sel:advance:Character :: Character -> Float
x :: Float
y :: Float
width :: Float
height :: Float
originX :: Float
originY :: Float
advance :: Float
..} ->
            ( Float
offX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
advance
            , ( Float -> Float -> Vec2
vec2 Float
width (-Float
height)
              , Float -> Float -> Vec2
vec2 Float
ox Float
oy
              , (Vec2
uvOffset, Vec2
uvScale)
              ) (Vec2, Vec2, (Vec2, Vec2))
-> [(Vec2, Vec2, (Vec2, Vec2))] -> [(Vec2, Vec2, (Vec2, Vec2))]
forall a. a -> [a] -> [a]
: [(Vec2, Vec2, (Vec2, Vec2))]
acc
            )
            where
              ox :: Float
ox = Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
originX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
offX
              oy :: Float
oy = Float
height Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
originY

              uvOffset :: Vec2
uvOffset = Float -> Float -> Vec2
vec2 (Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
atlasWidth) (Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
atlasHeight)
              uvScale :: Vec2
uvScale  = Float -> Float -> Vec2
vec2 (Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
atlasWidth) (Float
height Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
atlasHeight)