{- |
  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 (FontError -> FontError -> Bool
(FontError -> FontError -> Bool)
-> (FontError -> FontError -> Bool) -> Eq FontError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontError -> FontError -> Bool
$c/= :: FontError -> FontError -> Bool
== :: FontError -> FontError -> Bool
$c== :: 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
min :: FontError -> FontError -> FontError
$cmin :: FontError -> FontError -> FontError
max :: FontError -> FontError -> FontError
$cmax :: FontError -> FontError -> FontError
>= :: FontError -> FontError -> Bool
$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
compare :: FontError -> FontError -> Ordering
$ccompare :: FontError -> FontError -> Ordering
$cp1Ord :: Eq 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
showList :: [FontError] -> ShowS
$cshowList :: [FontError] -> ShowS
show :: FontError -> String
$cshow :: FontError -> String
showsPrec :: Int -> FontError -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep FontError x -> FontError
$cfrom :: forall x. FontError -> Rep FontError x
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
/= :: Container -> Container -> Bool
$c/= :: Container -> Container -> Bool
== :: Container -> Container -> Bool
$c== :: 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
min :: Container -> Container -> Container
$cmin :: Container -> Container -> Container
max :: Container -> Container -> Container
$cmax :: Container -> Container -> Container
>= :: Container -> Container -> Bool
$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
compare :: Container -> Container -> Ordering
$ccompare :: Container -> Container -> Ordering
$cp1Ord :: Eq 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
showList :: [Container] -> ShowS
$cshowList :: [Container] -> ShowS
show :: Container -> String
$cshow :: Container -> String
showsPrec :: Int -> Container -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Container x -> Container
$cfrom :: forall x. Container -> Rep Container x
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
/= :: Character -> Character -> Bool
$c/= :: Character -> Character -> Bool
== :: Character -> Character -> Bool
$c== :: 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
min :: Character -> Character -> Character
$cmin :: Character -> Character -> Character
max :: Character -> Character -> Character
$cmax :: Character -> Character -> Character
>= :: Character -> Character -> Bool
$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
compare :: Character -> Character -> Ordering
$ccompare :: Character -> Character -> Ordering
$cp1Ord :: Eq 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
showList :: [Character] -> ShowS
$cshowList :: [Character] -> ShowS
show :: Character -> String
$cshow :: Character -> String
showsPrec :: Int -> Character -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Character x -> Character
$cfrom :: forall x. Character -> Rep Character x
Generic)

instance FromJSON Container
instance FromJSON Character

load
  :: ( MonadIO m
     , MonadReader env m
     , HasLogFunc env
     , HasCallStack
     )
  => Source -> m Container
load :: Source -> m Container
load = m Container -> m Container
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (m Container -> m Container)
-> (Source -> m Container) -> Source -> m Container
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 (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 (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
showList :: [PutChar] -> ShowS
$cshowList :: [PutChar] -> ShowS
show :: PutChar -> String
$cshow :: PutChar -> String
showsPrec :: Int -> PutChar -> ShowS
$cshowsPrec :: Int -> 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 (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 (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 (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
pcScale :: Vec2
pcOffset :: Vec2
pcSize :: Vec2
pcPos :: Vec2
$sel:pcScale:PutChar :: PutChar -> Vec2
$sel:pcOffset:PutChar :: PutChar -> Vec2
$sel:pcSize:PutChar :: PutChar -> Vec2
$sel:pcPos:PutChar :: PutChar -> 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" ::: Layout.Alignment
  -> "Size"      ::: Float
  -> "Font"      ::: Container
  -> "Line"      ::: [Char]
  -> ("scale" ::: Float, [PutChar])
putLine :: Vec2
-> Vec2
-> ("Alignment" ::: Alignment)
-> Float
-> Container
-> String
-> (Float, [PutChar])
putLine (WithVec2 Float
cw Float
ch) (WithVec2 Float
cx Float
cy) Layout.Alignment{Origin
$sel:alignY:Alignment :: ("Alignment" ::: Alignment) -> Origin
$sel:alignX:Alignment :: ("Alignment" ::: Alignment) -> Origin
alignY :: Origin
alignX :: Origin
..} 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, Float, [(Vec2, Vec2, (Vec2, Vec2))]) -> [PutChar]
extract ((Float, Float, [(Vec2, Vec2, (Vec2, Vec2))]) -> [PutChar])
-> (String -> (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))]))
-> String
-> [PutChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float, [(Vec2, Vec2, (Vec2, Vec2))])
 -> Char -> (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))]))
-> (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))])
-> String
-> (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))])
-> Char -> (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))])
step (Float
0, Float
0, [])
  where
    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
characters :: HashMap Char Character
$sel:characters:Container :: Container -> HashMap Char Character
characters
      } = Container
font

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

    extract :: (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))]) -> [PutChar]
extract (Float
offX, Float
_offY, [(Vec2, Vec2, (Vec2, Vec2))]
bits) = do
      (WithVec2 Float
w Float
h, WithVec2 Float
x Float
y, (Vec2
offset, Vec2
scale)) <- [(Vec2, Vec2, (Vec2, Vec2))]
bits
      let
        ax :: Float
ax = case Origin
alignX of
          Origin
Layout.Begin  -> -Float
cw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
          Origin
Layout.Middle -> -Float
offX Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
          Origin
Layout.End    -> Float
cw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
offX Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale

        ay :: Float
ay = case Origin
alignY of
          Origin
Layout.Begin  -> -Float
ch Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
targetSize Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
1.3
          Origin
Layout.Middle -> Float
targetSize Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
          Origin
Layout.End    -> Float
ch Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
targetSize Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5

      PutChar -> [PutChar]
forall (f :: * -> *) a. Applicative f => a -> f a
pure PutChar :: Vec2 -> Vec2 -> Vec2 -> Vec2 -> PutChar
PutChar
        { $sel:pcPos:PutChar :: Vec2
pcPos    = Float -> Float -> Vec2
vec2 (Float
cx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ax 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
cy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ay Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
sizeScale)
        , $sel:pcSize:PutChar :: 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)
        , $sel:pcOffset:PutChar :: Vec2
pcOffset = Vec2
offset
        , $sel:pcScale:PutChar :: Vec2
pcScale  = Vec2
scale
        }

    step :: (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))])
-> Char -> (Float, Float, [(Vec2, Vec2, (Vec2, Vec2))])
step (Float
offX, Float
offY, [(Vec2, Vec2, (Vec2, Vec2))]
acc) 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
      , Float
offY
      , [(Vec2, Vec2, (Vec2, Vec2))]
acc
      )

    step (Float
offX, Float
offY, [(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 Maybe Character -> Maybe Character -> Maybe Character
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> HashMap Char Character -> Maybe Character
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Char
'?' HashMap Char Character
characters of
        Maybe Character
Nothing ->
          (Float
offX, Float
offY, [(Vec2, Vec2, (Vec2, Vec2))]
acc)
        Just Character{Float
advance :: Float
originY :: Float
originX :: Float
height :: Float
width :: Float
y :: Float
x :: Float
$sel:advance:Character :: Character -> Float
$sel:originY:Character :: Character -> Float
$sel:originX:Character :: Character -> Float
$sel:height:Character :: Character -> Float
$sel:width:Character :: Character -> Float
$sel:y:Character :: Character -> Float
$sel:x:Character :: Character -> Float
..} ->
          ( Float
offX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
advance
          , Float
offY
          , ( 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
offX Float -> Float -> Float
forall a. Num a => a -> a -> a
+ 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
            oy :: Float
oy = Float
offY Float -> Float -> Float
forall a. Num a => a -> a -> a
+ 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)