{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
-- |
-- Module:     Typograffiti.Cache
-- Copyright:  (c) 2018 Schell Scivally, 2023 Adrian Cochrane
-- License:    MIT
-- Maintainer: Schell Scivally <schell@takt.com>
--             & Adrian Cochrane <alcinnz@argonaut-constellation.org>
--
-- This module provides a method of caching rendererd text, making it suitable
-- for interactive rendering. You can use the defaultCache or provide your own.
--
module Typograffiti.Cache where

import           Control.Monad.Except   (MonadError (..), liftEither)
import           Control.Monad.Fail     (MonadFail (..))
import           Control.Monad.IO.Class (MonadIO (..))
import           Data.Bifunctor         (first)
import           Data.ByteString        (ByteString)
import qualified Data.ByteString.Char8  as B8
import qualified Data.Vector.Unboxed    as UV
import           Foreign.Marshal.Array  (withArray)
import           Graphics.GL
import           Linear                 (V2 (..), V3 (..), V4 (..), M44 (..),
                                        (!*!), identity)
import           Data.Text.Glyphize     (GlyphInfo(..), GlyphPos(..))

import           Typograffiti.Atlas
import           Typograffiti.GL

-- | Generic operations for text layout.
class Layout t where
  translate :: t -> V2 Float -> t

-- | Holds an allocated draw function for some amount of text. The function
-- takes one parameter that can be used to transform the text in various ways.
-- This type is generic and can be used to take advantage of your own font
-- rendering shaders.
data AllocatedRendering t = AllocatedRendering
  { forall t. AllocatedRendering t -> t -> V2 Int -> IO ()
arDraw    :: t -> V2 Int -> IO ()
    -- ^ Draw the text with some transformation in some monad.
  , forall t. AllocatedRendering t -> IO ()
arRelease :: IO ()
    -- ^ Release the allocated draw function in some monad.
  , forall t. AllocatedRendering t -> V2 Int
arSize    :: V2 Int
    -- ^ The size (in pixels) of the drawn text.
  }

-- | Constructs a callback for for computing the geometry for
-- rendering given glyphs out of the given texture.
makeDrawGlyphs
  :: ( MonadIO m
     , MonadError TypograffitiError m
     , MonadIO n
     , MonadFail n
     , MonadError TypograffitiError n
     )
  => m (Atlas
        -> [(GlyphInfo, GlyphPos)]
        -> n (AllocatedRendering [TextTransform])
       )
makeDrawGlyphs :: forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadError TypograffitiError m, MonadIO n, MonadFail n,
 MonadError TypograffitiError n) =>
m (Atlas
   -> [(GlyphInfo, GlyphPos)]
   -> n (AllocatedRendering [TextTransform]))
makeDrawGlyphs = do
    let position :: GLenum
position = GLenum
0
        uv :: GLenum
uv = GLenum
1
    GLenum
vert <- m (Either String GLenum) -> m GLenum
forall (m :: * -> *) a.
(MonadIO m, MonadError TypograffitiError m) =>
m (Either String a) -> m a
liftGL (m (Either String GLenum) -> m GLenum)
-> m (Either String GLenum) -> m GLenum
forall a b. (a -> b) -> a -> b
$ ByteString -> GLenum -> m (Either String GLenum)
forall (m :: * -> *).
MonadIO m =>
ByteString -> GLenum -> m (Either String GLenum)
compileOGLShader ByteString
vertexShader GLenum
forall {a}. (Eq a, Num a) => a
GL_VERTEX_SHADER
    GLenum
frag <- m (Either String GLenum) -> m GLenum
forall (m :: * -> *) a.
(MonadIO m, MonadError TypograffitiError m) =>
m (Either String a) -> m a
liftGL (m (Either String GLenum) -> m GLenum)
-> m (Either String GLenum) -> m GLenum
forall a b. (a -> b) -> a -> b
$ ByteString -> GLenum -> m (Either String GLenum)
forall (m :: * -> *).
MonadIO m =>
ByteString -> GLenum -> m (Either String GLenum)
compileOGLShader ByteString
fragmentShader GLenum
forall {a}. (Eq a, Num a) => a
GL_FRAGMENT_SHADER
    GLenum
prog <- m (Either String GLenum) -> m GLenum
forall (m :: * -> *) a.
(MonadIO m, MonadError TypograffitiError m) =>
m (Either String a) -> m a
liftGL (m (Either String GLenum) -> m GLenum)
-> m (Either String GLenum) -> m GLenum
forall a b. (a -> b) -> a -> b
$ [(String, Integer)] -> [GLenum] -> m (Either String GLenum)
forall (m :: * -> *).
MonadIO m =>
[(String, Integer)] -> [GLenum] -> m (Either String GLenum)
compileOGLProgram [
        (String
"position", GLenum -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
position),
        (String
"uv", GLenum -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
uv)
      ] [GLenum
vert, GLenum
frag]
    GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glUseProgram GLenum
prog
    GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glEnable GLenum
forall {a}. (Eq a, Num a) => a
GL_BLEND
    GLenum -> GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBlendFunc GLenum
forall {a}. (Eq a, Num a) => a
GL_SRC_ALPHA GLenum
forall {a}. (Eq a, Num a) => a
GL_ONE_MINUS_SRC_ALPHA
    -- Get uniform locations
    GLint
pjU   <- GLenum -> String -> m GLint
forall (m :: * -> *). MonadIO m => GLenum -> String -> m GLint
getUniformLocation GLenum
prog String
"projection"
    GLint
mvU   <- GLenum -> String -> m GLint
forall (m :: * -> *). MonadIO m => GLenum -> String -> m GLint
getUniformLocation GLenum
prog String
"modelview"
    GLint
multU <- GLenum -> String -> m GLint
forall (m :: * -> *). MonadIO m => GLenum -> String -> m GLint
getUniformLocation GLenum
prog String
"mult_color"
    GLint
texU  <- GLenum -> String -> m GLint
forall (m :: * -> *). MonadIO m => GLenum -> String -> m GLint
getUniformLocation GLenum
prog String
"tex"
    (Atlas
 -> [(GlyphInfo, GlyphPos)]
 -> n (AllocatedRendering [TextTransform]))
-> m (Atlas
      -> [(GlyphInfo, GlyphPos)]
      -> n (AllocatedRendering [TextTransform]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Atlas
  -> [(GlyphInfo, GlyphPos)]
  -> n (AllocatedRendering [TextTransform]))
 -> m (Atlas
       -> [(GlyphInfo, GlyphPos)]
       -> n (AllocatedRendering [TextTransform])))
-> (Atlas
    -> [(GlyphInfo, GlyphPos)]
    -> n (AllocatedRendering [TextTransform]))
-> m (Atlas
      -> [(GlyphInfo, GlyphPos)]
      -> n (AllocatedRendering [TextTransform]))
forall a b. (a -> b) -> a -> b
$ \Atlas
atlas [(GlyphInfo, GlyphPos)]
glyphs -> do
        GLenum
vao   <- n GLenum
forall (m :: * -> *). (MonadIO m, MonadFail m) => m GLenum
newBoundVAO
        GLenum
pbuf  <- n GLenum
forall (m :: * -> *). MonadIO m => m GLenum
newBuffer
        GLenum
uvbuf <- n GLenum
forall (m :: * -> *). MonadIO m => m GLenum
newBuffer
        (Vector (V2 Float)
ps, Vector (V2 Float)
uvs) <- Vector (V2 Float, V2 Float)
-> (Vector (V2 Float), Vector (V2 Float))
forall a b.
(Unbox a, Unbox b) =>
Vector (a, b) -> (Vector a, Vector b)
UV.unzip (Vector (V2 Float, V2 Float)
 -> (Vector (V2 Float), Vector (V2 Float)))
-> n (Vector (V2 Float, V2 Float))
-> n (Vector (V2 Float), Vector (V2 Float))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Atlas -> [(GlyphInfo, GlyphPos)] -> n (Vector (V2 Float, V2 Float))
forall (m :: * -> *).
(MonadIO m, MonadError TypograffitiError m) =>
Atlas -> [(GlyphInfo, GlyphPos)] -> m (Vector (V2 Float, V2 Float))
stringTris' Atlas
atlas [(GlyphInfo, GlyphPos)]
glyphs
        GLenum -> GLenum -> Vector (V2 Float) -> n ()
forall (f :: * -> *) (m :: * -> *).
(Foldable f, Unbox (f Float), Storable (f Float), Finite f,
 KnownNat (Size f), MonadIO m) =>
GLenum -> GLenum -> Vector (f Float) -> m ()
bufferGeometry GLenum
position GLenum
pbuf Vector (V2 Float)
ps
        GLenum -> GLenum -> Vector (V2 Float) -> n ()
forall (f :: * -> *) (m :: * -> *).
(Foldable f, Unbox (f Float), Storable (f Float), Finite f,
 KnownNat (Size f), MonadIO m) =>
GLenum -> GLenum -> Vector (f Float) -> m ()
bufferGeometry GLenum
uv GLenum
uvbuf Vector (V2 Float)
uvs
        GLenum -> n ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBindVertexArray GLenum
0

        let draw :: [TextTransform] -> V2 a -> m ()
draw [TextTransform]
ts V2 a
wsz = do
                let (M44 Float
mv, V4 Float
multVal) = [TextTransform] -> (M44 Float, V4 Float)
transformToUniforms [TextTransform]
ts
                GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glUseProgram GLenum
prog
                let pj :: M44 Float
pj = V2 a -> M44 Float
forall a. Integral a => V2 a -> M44 Float
orthoProjection V2 a
wsz
                GLenum -> GLint -> M44 Float -> m ()
forall a (m :: * -> *).
(UniformValue a, MonadIO m) =>
GLenum -> GLint -> a -> m ()
updateUniform GLenum
prog GLint
pjU M44 Float
pj
                GLenum -> GLint -> M44 Float -> m ()
forall a (m :: * -> *).
(UniformValue a, MonadIO m) =>
GLenum -> GLint -> a -> m ()
updateUniform GLenum
prog GLint
mvU M44 Float
mv
                GLenum -> GLint -> V4 Float -> m ()
forall a (m :: * -> *).
(UniformValue a, MonadIO m) =>
GLenum -> GLint -> a -> m ()
updateUniform GLenum
prog GLint
multU V4 Float
multVal
                GLenum -> GLint -> Int -> m ()
forall a (m :: * -> *).
(UniformValue a, MonadIO m) =>
GLenum -> GLint -> a -> m ()
updateUniform GLenum
prog GLint
texU (Int
0 :: Int)
                GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBindVertexArray GLenum
vao
                [GLenum] -> m () -> m ()
forall (m :: * -> *) a. MonadIO m => [GLenum] -> m a -> m a
withBoundTextures [Atlas -> GLenum
atlasTexture Atlas
atlas] (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                    GLenum -> GLenum -> GLenum -> GLint -> m ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLint -> m ()
drawVAO GLenum
prog GLenum
vao GLenum
forall {a}. (Eq a, Num a) => a
GL_TRIANGLES (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GLint) -> Int -> GLint
forall a b. (a -> b) -> a -> b
$ Vector (V2 Float) -> Int
forall a. Unbox a => Vector a -> Int
UV.length Vector (V2 Float)
ps)
                    GLenum -> m ()
forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBindVertexArray GLenum
0
            release :: IO ()
release = do
                [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLenum
pbuf, GLenum
uvbuf] ((Ptr GLenum -> IO ()) -> IO ()) -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLenum -> m ()
glDeleteBuffers GLint
2
                [GLenum] -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLenum
vao] ((Ptr GLenum -> IO ()) -> IO ()) -> (Ptr GLenum -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ GLint -> Ptr GLenum -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLenum -> m ()
glDeleteVertexArrays GLint
1
            (V2 Float
tl, V2 Float
br) = Vector (V2 Float) -> (V2 Float, V2 Float)
forall a.
(Unbox a, Real a, Fractional a) =>
Vector (V2 a) -> (V2 a, V2 a)
boundingBox Vector (V2 Float)
ps
            size :: V2 Float
size = V2 Float
br V2 Float -> V2 Float -> V2 Float
forall a. Num a => a -> a -> a
- V2 Float
tl
        AllocatedRendering [TextTransform]
-> n (AllocatedRendering [TextTransform])
forall (m :: * -> *) a. Monad m => a -> m a
return AllocatedRendering :: forall t.
(t -> V2 Int -> IO ()) -> IO () -> V2 Int -> AllocatedRendering t
AllocatedRendering {
            arDraw :: [TextTransform] -> V2 Int -> IO ()
arDraw = [TextTransform] -> V2 Int -> IO ()
forall {m :: * -> *} {a}.
(MonadIO m, Integral a) =>
[TextTransform] -> V2 a -> m ()
draw,
            arRelease :: IO ()
arRelease = IO ()
release,
            arSize :: V2 Int
arSize = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> V2 Float -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 Float
size
          }

-- | The GPU code to finalize the position of glyphs onscreen.
vertexShader :: ByteString
vertexShader :: ByteString
vertexShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
  [ String
"#version 330 core"
  , String
"uniform mat4 projection;"
  , String
"uniform mat4 modelview;"
  , String
"in vec2 position;"
  , String
"in vec2 uv;"
  , String
"out vec2 fuv;"
  , String
"void main () {"
  , String
"  fuv = uv;"
  , String
"  gl_Position = projection * modelview * vec4(position.xy, 0.0, 1.0);"
  , String
"}"
  ]

-- | The GPU code to composite the recoloured glyph into the output image.
fragmentShader :: ByteString
fragmentShader :: ByteString
fragmentShader = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
  [ String
"#version 330 core"
  , String
"in vec2 fuv;"
  , String
"out vec4 fcolor;"
  , String
"uniform sampler2D tex;"
  , String
"uniform vec4 mult_color;"
  , String
"void main () {"
  , String
"  vec4 tcolor = texture(tex, fuv);"
  , String
"  fcolor = vec4(mult_color.rgb, mult_color.a * tcolor.r);"
  , String
"}"
  ]

------
--- Transforms
------

-- | Geometrically transform the text.
data SpatialTransform = SpatialTransformTranslate (V2 Float)
                      -- ^ Shift the text horizontally or vertically.
                      | SpatialTransformScale (V2 Float)
                      -- ^ Resize the text.
                      | SpatialTransformRotate Float
                      -- ^ Enlarge the text.
                      | SpatialTransformSkew Float
                      -- ^ Skew the text, approximating italics (or rather obliques).
                      | SpatialTransform (M44 Float)
                      -- ^ Apply an arbitrary matrix transform to the text.

-- | Modify the rendered text.
data TextTransform = TextTransformMultiply (V4 Float)
                   -- ^ Adjust the colour of the rendered text.
                   | TextTransformSpatial SpatialTransform
                   -- ^ Adjust the position of the rendered text.

-- | Convert the `TextTransform`s into data that can be sent to the GPU.
transformToUniforms :: [TextTransform] -> (M44 Float, V4 Float)
transformToUniforms :: [TextTransform] -> (M44 Float, V4 Float)
transformToUniforms = ((M44 Float, V4 Float) -> TextTransform -> (M44 Float, V4 Float))
-> (M44 Float, V4 Float)
-> [TextTransform]
-> (M44 Float, V4 Float)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (M44 Float, V4 Float) -> TextTransform -> (M44 Float, V4 Float)
forall {m :: * -> *}.
Functor m =>
(m (V4 Float), V4 Float)
-> TextTransform -> (m (V4 Float), V4 Float)
toUniform (M44 Float
forall a (t :: * -> *).
(Num a, Traversable t, Applicative t) =>
t (t a)
identity, V4 Float
1.0)
  where toUniform :: (m (V4 Float), V4 Float)
-> TextTransform -> (m (V4 Float), V4 Float)
toUniform (m (V4 Float)
mv, V4 Float
clr) (TextTransformMultiply V4 Float
c) =
          (m (V4 Float)
mv, V4 Float
clr V4 Float -> V4 Float -> V4 Float
forall a. Num a => a -> a -> a
* V4 Float
c)
        toUniform (m (V4 Float)
mv, V4 Float
clr) (TextTransformSpatial SpatialTransform
s) =
          let mv1 :: m (V4 Float)
mv1 = case SpatialTransform
s of
                SpatialTransformTranslate (V2 Float
x Float
y) ->
                  m (V4 Float)
mv m (V4 Float) -> M44 Float -> m (V4 Float)
forall (m :: * -> *) (t :: * -> *) (n :: * -> *) a.
(Functor m, Foldable t, Additive t, Additive n, Num a) =>
m (t a) -> t (n a) -> m (n a)
!*! V3 Float -> M44 Float
forall a. Num a => V3 a -> M44 a
mat4Translate (Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
x Float
y Float
0)
                SpatialTransformScale (V2 Float
x Float
y) ->
                  m (V4 Float)
mv m (V4 Float) -> M44 Float -> m (V4 Float)
forall (m :: * -> *) (t :: * -> *) (n :: * -> *) a.
(Functor m, Foldable t, Additive t, Additive n, Num a) =>
m (t a) -> t (n a) -> m (n a)
!*! V3 Float -> M44 Float
forall a. Num a => V3 a -> M44 a
mat4Scale (Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
x Float
y Float
1)
                SpatialTransformRotate Float
r ->
                  m (V4 Float)
mv m (V4 Float) -> M44 Float -> m (V4 Float)
forall (m :: * -> *) (t :: * -> *) (n :: * -> *) a.
(Functor m, Foldable t, Additive t, Additive n, Num a) =>
m (t a) -> t (n a) -> m (n a)
!*! Float -> V3 Float -> M44 Float
forall a. (Num a, Epsilon a, Floating a) => a -> V3 a -> M44 a
mat4Rotate Float
r (Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
0 Float
0 Float
1)
                SpatialTransformSkew Float
x ->
                  m (V4 Float)
mv m (V4 Float) -> M44 Float -> m (V4 Float)
forall (m :: * -> *) (t :: * -> *) (n :: * -> *) a.
(Functor m, Foldable t, Additive t, Additive n, Num a) =>
m (t a) -> t (n a) -> m (n a)
!*! Float -> M44 Float
forall a. Num a => a -> M44 a
mat4SkewXbyY Float
x
                SpatialTransform M44 Float
mat -> m (V4 Float)
mv m (V4 Float) -> M44 Float -> m (V4 Float)
forall (m :: * -> *) (t :: * -> *) (n :: * -> *) a.
(Functor m, Foldable t, Additive t, Additive n, Num a) =>
m (t a) -> t (n a) -> m (n a)
!*! M44 Float
mat
          in (m (V4 Float)
mv1, V4 Float
clr)

-- | Shift the text horizontally or vertically.
move :: Float -> Float -> TextTransform
move :: Float -> Float -> TextTransform
move Float
x Float
y =
  SpatialTransform -> TextTransform
TextTransformSpatial
  (SpatialTransform -> TextTransform)
-> SpatialTransform -> TextTransform
forall a b. (a -> b) -> a -> b
$ V2 Float -> SpatialTransform
SpatialTransformTranslate
  (V2 Float -> SpatialTransform) -> V2 Float -> SpatialTransform
forall a b. (a -> b) -> a -> b
$ Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2 Float
x Float
y

-- | Resize the text.
scale :: Float -> Float -> TextTransform
scale :: Float -> Float -> TextTransform
scale Float
x Float
y =
  SpatialTransform -> TextTransform
TextTransformSpatial
  (SpatialTransform -> TextTransform)
-> SpatialTransform -> TextTransform
forall a b. (a -> b) -> a -> b
$ V2 Float -> SpatialTransform
SpatialTransformScale
  (V2 Float -> SpatialTransform) -> V2 Float -> SpatialTransform
forall a b. (a -> b) -> a -> b
$ Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2 Float
x Float
y

-- | Rotate the text.
rotate :: Float -> TextTransform
rotate :: Float -> TextTransform
rotate =
  SpatialTransform -> TextTransform
TextTransformSpatial
  (SpatialTransform -> TextTransform)
-> (Float -> SpatialTransform) -> Float -> TextTransform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> SpatialTransform
SpatialTransformRotate

skew :: Float -> TextTransform
skew :: Float -> TextTransform
skew = SpatialTransform -> TextTransform
TextTransformSpatial (SpatialTransform -> TextTransform)
-> (Float -> SpatialTransform) -> Float -> TextTransform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> SpatialTransform
SpatialTransformSkew

matrix :: M44 Float -> TextTransform
matrix :: M44 Float -> TextTransform
matrix = SpatialTransform -> TextTransform
TextTransformSpatial (SpatialTransform -> TextTransform)
-> (M44 Float -> SpatialTransform) -> M44 Float -> TextTransform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M44 Float -> SpatialTransform
SpatialTransform

-- | Recolour the text.
color :: Float -> Float -> Float -> Float -> TextTransform
color :: Float -> Float -> Float -> Float -> TextTransform
color Float
r Float
g Float
b Float
a =
  V4 Float -> TextTransform
TextTransformMultiply
  (V4 Float -> TextTransform) -> V4 Float -> TextTransform
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> V4 Float
forall a. a -> a -> a -> a -> V4 a
V4 Float
r Float
g Float
b Float
a

-- | Make the text semi-transparant.
alpha :: Float -> TextTransform
alpha :: Float -> TextTransform
alpha =
  V4 Float -> TextTransform
TextTransformMultiply
  (V4 Float -> TextTransform)
-> (Float -> V4 Float) -> Float -> TextTransform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float -> Float -> V4 Float
forall a. a -> a -> a -> a -> V4 a
V4 Float
1 Float
1 Float
1


instance Layout [TextTransform] where
  translate :: [TextTransform] -> V2 Float -> [TextTransform]
translate [TextTransform]
ts (V2 Float
x Float
y) = [TextTransform]
ts [TextTransform] -> [TextTransform] -> [TextTransform]
forall a. [a] -> [a] -> [a]
++ [Float -> Float -> TextTransform
move Float
x Float
y]

-- | Utility for calling OpenGL APIs in a error monad.
liftGL
  :: ( MonadIO m
     , MonadError TypograffitiError m
     )
  => m (Either String a)
  -> m a
liftGL :: forall (m :: * -> *) a.
(MonadIO m, MonadError TypograffitiError m) =>
m (Either String a) -> m a
liftGL m (Either String a)
n = do
  let lft :: Either String a -> m a
lft = Either TypograffitiError a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either TypograffitiError a -> m a)
-> (Either String a -> Either TypograffitiError a)
-> Either String a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> TypograffitiError)
-> Either String a -> Either TypograffitiError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> TypograffitiError
TypograffitiErrorGL
  m (Either String a)
n m (Either String a) -> (Either String a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String a -> m a
forall {a}. Either String a -> m a
lft