{-|
Module      : Monomer.Graphics.Types
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Basic types for Graphics.

Angles are always expressed in degrees, not radians.
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Strict #-}

module Monomer.Graphics.Types where

import Data.ByteString (ByteString)
import Data.Default
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Sequence (Seq)
import GHC.Generics

import qualified Data.ByteString as BS
import qualified Data.Sequence as Seq
import qualified Data.Text as T

import Monomer.Common

-- | Direction in which triangles and arcs are drawn.
data Winding
  = CW
  | CCW
  deriving (Winding -> Winding -> Bool
(Winding -> Winding -> Bool)
-> (Winding -> Winding -> Bool) -> Eq Winding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Winding -> Winding -> Bool
$c/= :: Winding -> Winding -> Bool
== :: Winding -> Winding -> Bool
$c== :: Winding -> Winding -> Bool
Eq, Int -> Winding -> ShowS
[Winding] -> ShowS
Winding -> String
(Int -> Winding -> ShowS)
-> (Winding -> String) -> ([Winding] -> ShowS) -> Show Winding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Winding] -> ShowS
$cshowList :: [Winding] -> ShowS
show :: Winding -> String
$cshow :: Winding -> String
showsPrec :: Int -> Winding -> ShowS
$cshowsPrec :: Int -> Winding -> ShowS
Show, (forall x. Winding -> Rep Winding x)
-> (forall x. Rep Winding x -> Winding) -> Generic Winding
forall x. Rep Winding x -> Winding
forall x. Winding -> Rep Winding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Winding x -> Winding
$cfrom :: forall x. Winding -> Rep Winding x
Generic)

-- | An RGBA color.
data Color = Color {
  Color -> Int
_colorR :: {-# UNPACK #-} !Int,
  Color -> Int
_colorG :: {-# UNPACK #-} !Int,
  Color -> Int
_colorB :: {-# UNPACK #-} !Int,
  Color -> Double
_colorA :: {-# UNPACK #-} !Double
} deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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 :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, (forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic)

instance Default Color where
  def :: Color
def = Int -> Int -> Int -> Double -> Color
Color Int
255 Int
255 Int
255 Double
1.0

-- | The definition of a font.
data FontDef = FontDef {
  FontDef -> Text
_fntName :: !Text,  -- ^ The logic name. Will be used when defining styles.
  FontDef -> Text
_fntPath :: !Text   -- ^ The path in the filesystem.
} deriving (FontDef -> FontDef -> Bool
(FontDef -> FontDef -> Bool)
-> (FontDef -> FontDef -> Bool) -> Eq FontDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontDef -> FontDef -> Bool
$c/= :: FontDef -> FontDef -> Bool
== :: FontDef -> FontDef -> Bool
$c== :: FontDef -> FontDef -> Bool
Eq, Int -> FontDef -> ShowS
[FontDef] -> ShowS
FontDef -> String
(Int -> FontDef -> ShowS)
-> (FontDef -> String) -> ([FontDef] -> ShowS) -> Show FontDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontDef] -> ShowS
$cshowList :: [FontDef] -> ShowS
show :: FontDef -> String
$cshow :: FontDef -> String
showsPrec :: Int -> FontDef -> ShowS
$cshowsPrec :: Int -> FontDef -> ShowS
Show, (forall x. FontDef -> Rep FontDef x)
-> (forall x. Rep FontDef x -> FontDef) -> Generic FontDef
forall x. Rep FontDef x -> FontDef
forall x. FontDef -> Rep FontDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontDef x -> FontDef
$cfrom :: forall x. FontDef -> Rep FontDef x
Generic)

-- | The name of a loaded font.
newtype Font
  = Font { Font -> Text
unFont :: Text }
  deriving (Font -> Font -> Bool
(Font -> Font -> Bool) -> (Font -> Font -> Bool) -> Eq Font
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c== :: Font -> Font -> Bool
Eq, Int -> Font -> ShowS
[Font] -> ShowS
Font -> String
(Int -> Font -> ShowS)
-> (Font -> String) -> ([Font] -> ShowS) -> Show Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Font] -> ShowS
$cshowList :: [Font] -> ShowS
show :: Font -> String
$cshow :: Font -> String
showsPrec :: Int -> Font -> ShowS
$cshowsPrec :: Int -> Font -> ShowS
Show, (forall x. Font -> Rep Font x)
-> (forall x. Rep Font x -> Font) -> Generic Font
forall x. Rep Font x -> Font
forall x. Font -> Rep Font x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Font x -> Font
$cfrom :: forall x. Font -> Rep Font x
Generic)

instance IsString Font where
  fromString :: String -> Font
fromString String
s = Text -> Font
Font (String -> Text
T.pack String
s)

instance Default Font where
  def :: Font
def = Text -> Font
Font Text
"Regular"

-- | The size of a font.
newtype FontSize
  = FontSize { FontSize -> Double
unFontSize :: Double }
  deriving (FontSize -> FontSize -> Bool
(FontSize -> FontSize -> Bool)
-> (FontSize -> FontSize -> Bool) -> Eq FontSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontSize -> FontSize -> Bool
$c/= :: FontSize -> FontSize -> Bool
== :: FontSize -> FontSize -> Bool
$c== :: FontSize -> FontSize -> Bool
Eq, Int -> FontSize -> ShowS
[FontSize] -> ShowS
FontSize -> String
(Int -> FontSize -> ShowS)
-> (FontSize -> String) -> ([FontSize] -> ShowS) -> Show FontSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontSize] -> ShowS
$cshowList :: [FontSize] -> ShowS
show :: FontSize -> String
$cshow :: FontSize -> String
showsPrec :: Int -> FontSize -> ShowS
$cshowsPrec :: Int -> FontSize -> ShowS
Show, (forall x. FontSize -> Rep FontSize x)
-> (forall x. Rep FontSize x -> FontSize) -> Generic FontSize
forall x. Rep FontSize x -> FontSize
forall x. FontSize -> Rep FontSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontSize x -> FontSize
$cfrom :: forall x. FontSize -> Rep FontSize x
Generic)

instance Default FontSize where
  def :: FontSize
def = Double -> FontSize
FontSize Double
32

-- | The spacing of a font. Zero represents the default spacing of the font.
newtype FontSpace
  = FontSpace { FontSpace -> Double
unFontSpace :: Double }
  deriving (FontSpace -> FontSpace -> Bool
(FontSpace -> FontSpace -> Bool)
-> (FontSpace -> FontSpace -> Bool) -> Eq FontSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontSpace -> FontSpace -> Bool
$c/= :: FontSpace -> FontSpace -> Bool
== :: FontSpace -> FontSpace -> Bool
$c== :: FontSpace -> FontSpace -> Bool
Eq, Int -> FontSpace -> ShowS
[FontSpace] -> ShowS
FontSpace -> String
(Int -> FontSpace -> ShowS)
-> (FontSpace -> String)
-> ([FontSpace] -> ShowS)
-> Show FontSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontSpace] -> ShowS
$cshowList :: [FontSpace] -> ShowS
show :: FontSpace -> String
$cshow :: FontSpace -> String
showsPrec :: Int -> FontSpace -> ShowS
$cshowsPrec :: Int -> FontSpace -> ShowS
Show, (forall x. FontSpace -> Rep FontSpace x)
-> (forall x. Rep FontSpace x -> FontSpace) -> Generic FontSpace
forall x. Rep FontSpace x -> FontSpace
forall x. FontSpace -> Rep FontSpace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontSpace x -> FontSpace
$cfrom :: forall x. FontSpace -> Rep FontSpace x
Generic)

instance Default FontSpace where
  def :: FontSpace
def = Double -> FontSpace
FontSpace Double
0

-- | Represents the sides of a rectangle.
data RectSide
  = SideLeft
  | SideRight
  | SideTop
  | SideBottom
  deriving (RectSide -> RectSide -> Bool
(RectSide -> RectSide -> Bool)
-> (RectSide -> RectSide -> Bool) -> Eq RectSide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectSide -> RectSide -> Bool
$c/= :: RectSide -> RectSide -> Bool
== :: RectSide -> RectSide -> Bool
$c== :: RectSide -> RectSide -> Bool
Eq, Int -> RectSide -> ShowS
[RectSide] -> ShowS
RectSide -> String
(Int -> RectSide -> ShowS)
-> (RectSide -> String) -> ([RectSide] -> ShowS) -> Show RectSide
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RectSide] -> ShowS
$cshowList :: [RectSide] -> ShowS
show :: RectSide -> String
$cshow :: RectSide -> String
showsPrec :: Int -> RectSide -> ShowS
$cshowsPrec :: Int -> RectSide -> ShowS
Show)

-- | Represents the corners of a rectangle.
data RectCorner
  = CornerTL
  | CornerTR
  | CornerBR
  | CornerBL
  deriving (RectCorner -> RectCorner -> Bool
(RectCorner -> RectCorner -> Bool)
-> (RectCorner -> RectCorner -> Bool) -> Eq RectCorner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectCorner -> RectCorner -> Bool
$c/= :: RectCorner -> RectCorner -> Bool
== :: RectCorner -> RectCorner -> Bool
$c== :: RectCorner -> RectCorner -> Bool
Eq, Int -> RectCorner -> ShowS
[RectCorner] -> ShowS
RectCorner -> String
(Int -> RectCorner -> ShowS)
-> (RectCorner -> String)
-> ([RectCorner] -> ShowS)
-> Show RectCorner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RectCorner] -> ShowS
$cshowList :: [RectCorner] -> ShowS
show :: RectCorner -> String
$cshow :: RectCorner -> String
showsPrec :: Int -> RectCorner -> ShowS
$cshowsPrec :: Int -> RectCorner -> ShowS
Show)

-- | Horizontal alignment flags.
data AlignH
  = ALeft
  | ACenter
  | ARight
  deriving (AlignH -> AlignH -> Bool
(AlignH -> AlignH -> Bool)
-> (AlignH -> AlignH -> Bool) -> Eq AlignH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignH -> AlignH -> Bool
$c/= :: AlignH -> AlignH -> Bool
== :: AlignH -> AlignH -> Bool
$c== :: AlignH -> AlignH -> Bool
Eq, Int -> AlignH -> ShowS
[AlignH] -> ShowS
AlignH -> String
(Int -> AlignH -> ShowS)
-> (AlignH -> String) -> ([AlignH] -> ShowS) -> Show AlignH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlignH] -> ShowS
$cshowList :: [AlignH] -> ShowS
show :: AlignH -> String
$cshow :: AlignH -> String
showsPrec :: Int -> AlignH -> ShowS
$cshowsPrec :: Int -> AlignH -> ShowS
Show, (forall x. AlignH -> Rep AlignH x)
-> (forall x. Rep AlignH x -> AlignH) -> Generic AlignH
forall x. Rep AlignH x -> AlignH
forall x. AlignH -> Rep AlignH x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlignH x -> AlignH
$cfrom :: forall x. AlignH -> Rep AlignH x
Generic)

instance Default AlignH where
  def :: AlignH
def = AlignH
ACenter

-- | Vertical alignment flags.
data AlignV
  = ATop
  | AMiddle
  | ABottom
  deriving (AlignV -> AlignV -> Bool
(AlignV -> AlignV -> Bool)
-> (AlignV -> AlignV -> Bool) -> Eq AlignV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignV -> AlignV -> Bool
$c/= :: AlignV -> AlignV -> Bool
== :: AlignV -> AlignV -> Bool
$c== :: AlignV -> AlignV -> Bool
Eq, Int -> AlignV -> ShowS
[AlignV] -> ShowS
AlignV -> String
(Int -> AlignV -> ShowS)
-> (AlignV -> String) -> ([AlignV] -> ShowS) -> Show AlignV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlignV] -> ShowS
$cshowList :: [AlignV] -> ShowS
show :: AlignV -> String
$cshow :: AlignV -> String
showsPrec :: Int -> AlignV -> ShowS
$cshowsPrec :: Int -> AlignV -> ShowS
Show, (forall x. AlignV -> Rep AlignV x)
-> (forall x. Rep AlignV x -> AlignV) -> Generic AlignV
forall x. Rep AlignV x -> AlignV
forall x. AlignV -> Rep AlignV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlignV x -> AlignV
$cfrom :: forall x. AlignV -> Rep AlignV x
Generic)

instance Default AlignV where
  def :: AlignV
def = AlignV
AMiddle

-- | Text horizontal alignment flags.
data AlignTH
  = ATLeft
  | ATCenter
  | ATRight
  deriving (AlignTH -> AlignTH -> Bool
(AlignTH -> AlignTH -> Bool)
-> (AlignTH -> AlignTH -> Bool) -> Eq AlignTH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignTH -> AlignTH -> Bool
$c/= :: AlignTH -> AlignTH -> Bool
== :: AlignTH -> AlignTH -> Bool
$c== :: AlignTH -> AlignTH -> Bool
Eq, Int -> AlignTH -> ShowS
[AlignTH] -> ShowS
AlignTH -> String
(Int -> AlignTH -> ShowS)
-> (AlignTH -> String) -> ([AlignTH] -> ShowS) -> Show AlignTH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlignTH] -> ShowS
$cshowList :: [AlignTH] -> ShowS
show :: AlignTH -> String
$cshow :: AlignTH -> String
showsPrec :: Int -> AlignTH -> ShowS
$cshowsPrec :: Int -> AlignTH -> ShowS
Show, (forall x. AlignTH -> Rep AlignTH x)
-> (forall x. Rep AlignTH x -> AlignTH) -> Generic AlignTH
forall x. Rep AlignTH x -> AlignTH
forall x. AlignTH -> Rep AlignTH x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlignTH x -> AlignTH
$cfrom :: forall x. AlignTH -> Rep AlignTH x
Generic)

instance Default AlignTH where
  def :: AlignTH
def = AlignTH
ATCenter

-- | Text vertical alignment flags.
data AlignTV
  = ATTop
  | ATMiddle
  | ATAscender
  | ATLowerX
  | ATBottom
  | ATBaseline
  deriving (AlignTV -> AlignTV -> Bool
(AlignTV -> AlignTV -> Bool)
-> (AlignTV -> AlignTV -> Bool) -> Eq AlignTV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignTV -> AlignTV -> Bool
$c/= :: AlignTV -> AlignTV -> Bool
== :: AlignTV -> AlignTV -> Bool
$c== :: AlignTV -> AlignTV -> Bool
Eq, Int -> AlignTV -> ShowS
[AlignTV] -> ShowS
AlignTV -> String
(Int -> AlignTV -> ShowS)
-> (AlignTV -> String) -> ([AlignTV] -> ShowS) -> Show AlignTV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlignTV] -> ShowS
$cshowList :: [AlignTV] -> ShowS
show :: AlignTV -> String
$cshow :: AlignTV -> String
showsPrec :: Int -> AlignTV -> ShowS
$cshowsPrec :: Int -> AlignTV -> ShowS
Show, (forall x. AlignTV -> Rep AlignTV x)
-> (forall x. Rep AlignTV x -> AlignTV) -> Generic AlignTV
forall x. Rep AlignTV x -> AlignTV
forall x. AlignTV -> Rep AlignTV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AlignTV x -> AlignTV
$cfrom :: forall x. AlignTV -> Rep AlignTV x
Generic)

instance Default AlignTV where
  def :: AlignTV
def = AlignTV
ATLowerX

-- | Information of a text glyph instance.
data GlyphPos = GlyphPos {
  GlyphPos -> Char
_glpGlyph :: {-# UNPACK #-} !Char,   -- ^ The represented character.
  GlyphPos -> Double
_glpX :: {-# UNPACK #-} !Double,     -- ^ The x coordinate used for rendering.
  GlyphPos -> Double
_glpXMin :: {-# UNPACK #-} !Double,  -- ^ The min x coordinate.
  GlyphPos -> Double
_glpXMax :: {-# UNPACK #-} !Double,  -- ^ The max x coordinate.
  GlyphPos -> Double
_glpYMin :: {-# UNPACK #-} !Double,  -- ^ The min x coordinate.
  GlyphPos -> Double
_glpYMax :: {-# UNPACK #-} !Double,  -- ^ The max x coordinate.
  GlyphPos -> Double
_glpW :: {-# UNPACK #-} !Double,     -- ^ The glyph width.
  GlyphPos -> Double
_glpH :: {-# UNPACK #-} !Double      -- ^ The glyph height.
} deriving (GlyphPos -> GlyphPos -> Bool
(GlyphPos -> GlyphPos -> Bool)
-> (GlyphPos -> GlyphPos -> Bool) -> Eq GlyphPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphPos -> GlyphPos -> Bool
$c/= :: GlyphPos -> GlyphPos -> Bool
== :: GlyphPos -> GlyphPos -> Bool
$c== :: GlyphPos -> GlyphPos -> Bool
Eq, Int -> GlyphPos -> ShowS
[GlyphPos] -> ShowS
GlyphPos -> String
(Int -> GlyphPos -> ShowS)
-> (GlyphPos -> String) -> ([GlyphPos] -> ShowS) -> Show GlyphPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphPos] -> ShowS
$cshowList :: [GlyphPos] -> ShowS
show :: GlyphPos -> String
$cshow :: GlyphPos -> String
showsPrec :: Int -> GlyphPos -> ShowS
$cshowsPrec :: Int -> GlyphPos -> ShowS
Show, (forall x. GlyphPos -> Rep GlyphPos x)
-> (forall x. Rep GlyphPos x -> GlyphPos) -> Generic GlyphPos
forall x. Rep GlyphPos x -> GlyphPos
forall x. GlyphPos -> Rep GlyphPos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphPos x -> GlyphPos
$cfrom :: forall x. GlyphPos -> Rep GlyphPos x
Generic)

instance Default GlyphPos where
  def :: GlyphPos
def = GlyphPos :: Char
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> GlyphPos
GlyphPos {
    _glpGlyph :: Char
_glpGlyph = Char
' ',
    _glpX :: Double
_glpX = Double
0,
    _glpXMin :: Double
_glpXMin = Double
0,
    _glpXMax :: Double
_glpXMax = Double
0,
    _glpYMin :: Double
_glpYMin = Double
0,
    _glpYMax :: Double
_glpYMax = Double
0,
    _glpW :: Double
_glpW = Double
0,
    _glpH :: Double
_glpH = Double
0
  }

-- | Text flags for single or multiline.
data TextMode
  = SingleLine
  | MultiLine
  deriving (TextMode -> TextMode -> Bool
(TextMode -> TextMode -> Bool)
-> (TextMode -> TextMode -> Bool) -> Eq TextMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextMode -> TextMode -> Bool
$c/= :: TextMode -> TextMode -> Bool
== :: TextMode -> TextMode -> Bool
$c== :: TextMode -> TextMode -> Bool
Eq, Int -> TextMode -> ShowS
[TextMode] -> ShowS
TextMode -> String
(Int -> TextMode -> ShowS)
-> (TextMode -> String) -> ([TextMode] -> ShowS) -> Show TextMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextMode] -> ShowS
$cshowList :: [TextMode] -> ShowS
show :: TextMode -> String
$cshow :: TextMode -> String
showsPrec :: Int -> TextMode -> ShowS
$cshowsPrec :: Int -> TextMode -> ShowS
Show, (forall x. TextMode -> Rep TextMode x)
-> (forall x. Rep TextMode x -> TextMode) -> Generic TextMode
forall x. Rep TextMode x -> TextMode
forall x. TextMode -> Rep TextMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextMode x -> TextMode
$cfrom :: forall x. TextMode -> Rep TextMode x
Generic)

-- | Text flags for trimming or keeping sapces.
data TextTrim
  = TrimSpaces
  | KeepSpaces
  deriving (TextTrim -> TextTrim -> Bool
(TextTrim -> TextTrim -> Bool)
-> (TextTrim -> TextTrim -> Bool) -> Eq TextTrim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextTrim -> TextTrim -> Bool
$c/= :: TextTrim -> TextTrim -> Bool
== :: TextTrim -> TextTrim -> Bool
$c== :: TextTrim -> TextTrim -> Bool
Eq, Int -> TextTrim -> ShowS
[TextTrim] -> ShowS
TextTrim -> String
(Int -> TextTrim -> ShowS)
-> (TextTrim -> String) -> ([TextTrim] -> ShowS) -> Show TextTrim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextTrim] -> ShowS
$cshowList :: [TextTrim] -> ShowS
show :: TextTrim -> String
$cshow :: TextTrim -> String
showsPrec :: Int -> TextTrim -> ShowS
$cshowsPrec :: Int -> TextTrim -> ShowS
Show, (forall x. TextTrim -> Rep TextTrim x)
-> (forall x. Rep TextTrim x -> TextTrim) -> Generic TextTrim
forall x. Rep TextTrim x -> TextTrim
forall x. TextTrim -> Rep TextTrim x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextTrim x -> TextTrim
$cfrom :: forall x. TextTrim -> Rep TextTrim x
Generic)

-- | Text flags for clipping or using ellipsis.
data TextOverflow
  = Ellipsis
  | ClipText
  deriving (TextOverflow -> TextOverflow -> Bool
(TextOverflow -> TextOverflow -> Bool)
-> (TextOverflow -> TextOverflow -> Bool) -> Eq TextOverflow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextOverflow -> TextOverflow -> Bool
$c/= :: TextOverflow -> TextOverflow -> Bool
== :: TextOverflow -> TextOverflow -> Bool
$c== :: TextOverflow -> TextOverflow -> Bool
Eq, Int -> TextOverflow -> ShowS
[TextOverflow] -> ShowS
TextOverflow -> String
(Int -> TextOverflow -> ShowS)
-> (TextOverflow -> String)
-> ([TextOverflow] -> ShowS)
-> Show TextOverflow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextOverflow] -> ShowS
$cshowList :: [TextOverflow] -> ShowS
show :: TextOverflow -> String
$cshow :: TextOverflow -> String
showsPrec :: Int -> TextOverflow -> ShowS
$cshowsPrec :: Int -> TextOverflow -> ShowS
Show)

-- | Text metrics.
data TextMetrics = TextMetrics {
  TextMetrics -> Double
_txmAsc :: {-# UNPACK #-} !Double,    -- ^ The height above the baseline.
  TextMetrics -> Double
_txmDesc :: {-# UNPACK #-} !Double,   -- ^ The height below the baseline.
  TextMetrics -> Double
_txmLineH :: {-# UNPACK #-} !Double,  -- ^ The total height.
  TextMetrics -> Double
_txmLowerX :: {-# UNPACK #-} !Double  -- ^ The height of lowercase x.
} deriving (TextMetrics -> TextMetrics -> Bool
(TextMetrics -> TextMetrics -> Bool)
-> (TextMetrics -> TextMetrics -> Bool) -> Eq TextMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextMetrics -> TextMetrics -> Bool
$c/= :: TextMetrics -> TextMetrics -> Bool
== :: TextMetrics -> TextMetrics -> Bool
$c== :: TextMetrics -> TextMetrics -> Bool
Eq, Int -> TextMetrics -> ShowS
[TextMetrics] -> ShowS
TextMetrics -> String
(Int -> TextMetrics -> ShowS)
-> (TextMetrics -> String)
-> ([TextMetrics] -> ShowS)
-> Show TextMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextMetrics] -> ShowS
$cshowList :: [TextMetrics] -> ShowS
show :: TextMetrics -> String
$cshow :: TextMetrics -> String
showsPrec :: Int -> TextMetrics -> ShowS
$cshowsPrec :: Int -> TextMetrics -> ShowS
Show, (forall x. TextMetrics -> Rep TextMetrics x)
-> (forall x. Rep TextMetrics x -> TextMetrics)
-> Generic TextMetrics
forall x. Rep TextMetrics x -> TextMetrics
forall x. TextMetrics -> Rep TextMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextMetrics x -> TextMetrics
$cfrom :: forall x. TextMetrics -> Rep TextMetrics x
Generic)

instance Default TextMetrics where
  def :: TextMetrics
def = TextMetrics :: Double -> Double -> Double -> Double -> TextMetrics
TextMetrics {
    _txmAsc :: Double
_txmAsc = Double
0,
    _txmDesc :: Double
_txmDesc = Double
0,
    _txmLineH :: Double
_txmLineH = Double
0,
    _txmLowerX :: Double
_txmLowerX = Double
0
  }

-- | A text line with associated rendering information.
data TextLine = TextLine {
  TextLine -> Font
_tlFont :: !Font,              -- ^ The font name.
  TextLine -> FontSize
_tlFontSize :: !FontSize,      -- ^ The font size.
  TextLine -> FontSpace
_tlFontSpaceH :: !FontSpace,   -- ^ The font spacing.
  TextLine -> FontSpace
_tlFontSpaceV :: !FontSpace,   -- ^ The vertical line spacing.
  TextLine -> TextMetrics
_tlMetrics :: !TextMetrics,    -- ^ The text metrics for the given font/size.
  TextLine -> Text
_tlText :: !Text,              -- ^ The represented text.
  TextLine -> Size
_tlSize :: !Size,              -- ^ The size the formatted text takes.
  TextLine -> Rect
_tlRect :: !Rect,              -- ^ The rect the formatted text occupies.
  TextLine -> Seq GlyphPos
_tlGlyphs :: !(Seq GlyphPos)   -- ^ The glyphs for each character.
} deriving (TextLine -> TextLine -> Bool
(TextLine -> TextLine -> Bool)
-> (TextLine -> TextLine -> Bool) -> Eq TextLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextLine -> TextLine -> Bool
$c/= :: TextLine -> TextLine -> Bool
== :: TextLine -> TextLine -> Bool
$c== :: TextLine -> TextLine -> Bool
Eq, Int -> TextLine -> ShowS
[TextLine] -> ShowS
TextLine -> String
(Int -> TextLine -> ShowS)
-> (TextLine -> String) -> ([TextLine] -> ShowS) -> Show TextLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextLine] -> ShowS
$cshowList :: [TextLine] -> ShowS
show :: TextLine -> String
$cshow :: TextLine -> String
showsPrec :: Int -> TextLine -> ShowS
$cshowsPrec :: Int -> TextLine -> ShowS
Show, (forall x. TextLine -> Rep TextLine x)
-> (forall x. Rep TextLine x -> TextLine) -> Generic TextLine
forall x. Rep TextLine x -> TextLine
forall x. TextLine -> Rep TextLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextLine x -> TextLine
$cfrom :: forall x. TextLine -> Rep TextLine x
Generic)

instance Default TextLine where
  def :: TextLine
def = TextLine :: Font
-> FontSize
-> FontSpace
-> FontSpace
-> TextMetrics
-> Text
-> Size
-> Rect
-> Seq GlyphPos
-> TextLine
TextLine {
    _tlFont :: Font
_tlFont = Font
forall a. Default a => a
def,
    _tlFontSize :: FontSize
_tlFontSize = FontSize
forall a. Default a => a
def,
    _tlFontSpaceH :: FontSpace
_tlFontSpaceH = FontSpace
forall a. Default a => a
def,
    _tlFontSpaceV :: FontSpace
_tlFontSpaceV = FontSpace
forall a. Default a => a
def,
    _tlMetrics :: TextMetrics
_tlMetrics = TextMetrics
forall a. Default a => a
def,
    _tlText :: Text
_tlText = Text
"",
    _tlSize :: Size
_tlSize = Size
forall a. Default a => a
def,
    _tlRect :: Rect
_tlRect = Rect
forall a. Default a => a
def,
    _tlGlyphs :: Seq GlyphPos
_tlGlyphs = Seq GlyphPos
forall a. Seq a
Seq.empty
  }

-- | Flags for a newly created image.
data ImageFlag
  = ImageNearest
  | ImageRepeatX
  | ImageRepeatY
  deriving (ImageFlag -> ImageFlag -> Bool
(ImageFlag -> ImageFlag -> Bool)
-> (ImageFlag -> ImageFlag -> Bool) -> Eq ImageFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageFlag -> ImageFlag -> Bool
$c/= :: ImageFlag -> ImageFlag -> Bool
== :: ImageFlag -> ImageFlag -> Bool
$c== :: ImageFlag -> ImageFlag -> Bool
Eq, Int -> ImageFlag -> ShowS
[ImageFlag] -> ShowS
ImageFlag -> String
(Int -> ImageFlag -> ShowS)
-> (ImageFlag -> String)
-> ([ImageFlag] -> ShowS)
-> Show ImageFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageFlag] -> ShowS
$cshowList :: [ImageFlag] -> ShowS
show :: ImageFlag -> String
$cshow :: ImageFlag -> String
showsPrec :: Int -> ImageFlag -> ShowS
$cshowsPrec :: Int -> ImageFlag -> ShowS
Show, (forall x. ImageFlag -> Rep ImageFlag x)
-> (forall x. Rep ImageFlag x -> ImageFlag) -> Generic ImageFlag
forall x. Rep ImageFlag x -> ImageFlag
forall x. ImageFlag -> Rep ImageFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageFlag x -> ImageFlag
$cfrom :: forall x. ImageFlag -> Rep ImageFlag x
Generic)

-- | The definition of a loaded image.
data ImageDef = ImageDef {
  ImageDef -> Text
_idfName :: Text,              -- ^ The logic name of the image.
  ImageDef -> Size
_idfSize :: Size,              -- ^ The dimensions of the image.
  ImageDef -> ByteString
_idfImgData :: BS.ByteString,  -- ^ The image data as RGBA 4-bytes blocks.
  ImageDef -> [ImageFlag]
_idfFlags :: [ImageFlag]       -- ^ The image flags.
} deriving (ImageDef -> ImageDef -> Bool
(ImageDef -> ImageDef -> Bool)
-> (ImageDef -> ImageDef -> Bool) -> Eq ImageDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageDef -> ImageDef -> Bool
$c/= :: ImageDef -> ImageDef -> Bool
== :: ImageDef -> ImageDef -> Bool
$c== :: ImageDef -> ImageDef -> Bool
Eq, Int -> ImageDef -> ShowS
[ImageDef] -> ShowS
ImageDef -> String
(Int -> ImageDef -> ShowS)
-> (ImageDef -> String) -> ([ImageDef] -> ShowS) -> Show ImageDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageDef] -> ShowS
$cshowList :: [ImageDef] -> ShowS
show :: ImageDef -> String
$cshow :: ImageDef -> String
showsPrec :: Int -> ImageDef -> ShowS
$cshowsPrec :: Int -> ImageDef -> ShowS
Show, (forall x. ImageDef -> Rep ImageDef x)
-> (forall x. Rep ImageDef x -> ImageDef) -> Generic ImageDef
forall x. Rep ImageDef x -> ImageDef
forall x. ImageDef -> Rep ImageDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageDef x -> ImageDef
$cfrom :: forall x. ImageDef -> Rep ImageDef x
Generic)

{-|
Text metrics related functions.

Two different versions of each function exist:

- Default one, without underscore, does not apply scaling.
- Version with a trailing underscore, that receives an extra scale argument.

In case the text is going to be rendered with a scale factor applied on
'Renderer' (by calling 'setScale'), it is recommended to apply the scale here
too (otherwise there will be differences in size and positioning). In most use
cases these functions will never be called, preferring the non underscore
versions.
-}
data FontManager = FontManager {
  -- | Returns the text metrics of a given font and size.
  FontManager -> Font -> FontSize -> TextMetrics
computeTextMetrics :: Font -> FontSize -> TextMetrics,
  -- | Returns the text metrics of a given font and size, applying scale.
  FontManager -> Double -> Font -> FontSize -> TextMetrics
computeTextMetrics_ :: Double -> Font -> FontSize -> TextMetrics,
  -- | Returns the size of the line of text given font and size.
  FontManager -> Font -> FontSize -> FontSpace -> Text -> Size
computeTextSize :: Font -> FontSize -> FontSpace -> Text -> Size,
  -- | Returns the size of the line of text given font and size, applying scale.
  FontManager
-> Double -> Font -> FontSize -> FontSpace -> Text -> Size
computeTextSize_ :: Double -> Font -> FontSize -> FontSpace -> Text -> Size,
  -- | Returns the glyphs of the line of text given font and size.
  FontManager
-> Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos
computeGlyphsPos :: Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos,
  -- | Returns the glyphs of the line of text given font and size, applying scale.
  FontManager
-> Double -> Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos
computeGlyphsPos_ :: Double -> Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos
}

-- | Low level rendering definitions.
data Renderer = Renderer {
  -- | Begins a new frame.
  Renderer -> Double -> Double -> IO ()
beginFrame :: Double -> Double -> IO (),
  -- | Finishes a frame, consolidating the drawing operations since beginFrame.
  Renderer -> IO ()
endFrame :: IO (),
  -- | Begins a new path
  Renderer -> IO ()
beginPath :: IO (),
  -- | Finishes an active path by closing it with a line.
  Renderer -> IO ()
closePath :: IO (),
  -- | Saves current context (scissor, offset, scale, rotation, etc).
  Renderer -> IO ()
saveContext :: IO (),
  -- | Restores a previously saved context.
  Renderer -> IO ()
restoreContext :: IO (),
  -- | Creates an overlay. These are rendered after the regular frame has been
  --   displayed. Useful, for instance, for a dropdown or context menu.
  Renderer -> IO () -> IO ()
createOverlay :: IO () -> IO (),
  -- | Renders the added overlays and clears them.
  Renderer -> IO ()
renderOverlays :: IO (),
  {-|
  Creates a render task which does not rely on the abstractions provided by the
  Renderer. Well suited for pure OpenGL/Vulkan/Metal.

  This runs _before_ overlays of any type, and it's useful for the content of
  widgets created with low level APIs.
  -}
  Renderer -> IO () -> IO ()
createRawTask :: IO () -> IO (),
  -- | Renders the added raw tasks and clears its queue.
  Renderer -> IO ()
renderRawTasks :: IO (),
  {-|
  Creates an overlay which does not rely on the abstractions provided by the
  Renderer. Well suited for pure OpenGL/Vulkan/Metal.

  This runs _after_ overlays based on Renderer.
  -}
  Renderer -> IO () -> IO ()
createRawOverlay :: IO () -> IO (),
  -- | Renders the added raw overlays and clears its queue.
  Renderer -> IO ()
renderRawOverlays :: IO (),
  -- | Sets, or intersects, a scissor which will limit the visible area.
  Renderer -> Rect -> IO ()
intersectScissor :: Rect -> IO (),
  -- | Translates all further drawing operations by the given offset.
  Renderer -> Point -> IO ()
setTranslation :: Point -> IO (),
  -- | Scales all further drawing operations by the given size.
  Renderer -> Point -> IO ()
setScale :: Point -> IO (),
  -- | Rotates all further drawing operations by the given angle.
  Renderer -> Double -> IO ()
setRotation :: Double -> IO (),
  -- | Applies the given alpha to all further drawing operations.
  Renderer -> Double -> IO ()
setGlobalAlpha :: Double -> IO (),
  {-|
  Sets the winding of the shape to be drawn. Setting CCW (counter clockwise)
  means the shape will be solid. Setting CW (clockwise) means the shape will be
  a hole inside a larger solid path.
  -}
  Renderer -> Winding -> IO ()
setPathWinding :: Winding -> IO (),
  -- | Draws an active path as a non filled stroke.
  Renderer -> IO ()
stroke :: IO (),
  -- | Sets the width of the next stroke actions.
  Renderer -> Double -> IO ()
setStrokeWidth :: Double -> IO (),
  -- | Sets the color of the next stroke actions.
  Renderer -> Color -> IO ()
setStrokeColor :: Color -> IO (),
  -- | Sets a linear gradient stroke from Point to Point, Color to Color.
  Renderer -> Point -> Point -> Color -> Color -> IO ()
setStrokeLinearGradient :: Point -> Point -> Color -> Color -> IO (),
  {-|
  Sets a radial gradient stroke with center point Point, inner and outer radius,
  inner and outer Color.
  -}
  Renderer -> Point -> Double -> Double -> Color -> Color -> IO ()
setStrokeRadialGradient :: Point -> Double -> Double -> Color -> Color -> IO (),
  {-|
  Sets an image pattern stroke, with top given by Point, size of a single image
  given by size, rotation and alpha.
  -}
  Renderer -> Text -> Point -> Size -> Double -> Double -> IO ()
setStrokeImagePattern :: Text -> Point -> Size -> Double -> Double -> IO (),
  -- | Draws an active path as a filled object.
  Renderer -> IO ()
fill :: IO (),
  -- | Sets the color of the next fill actions.
  Renderer -> Color -> IO ()
setFillColor :: Color -> IO (),
  -- | Sets a linear gradient fill from Point to Point, Color to Color.
  Renderer -> Point -> Point -> Color -> Color -> IO ()
setFillLinearGradient :: Point -> Point -> Color -> Color -> IO (),
  {-|
  Sets a radial gradient fill with center point Point, inner and outer radius,
  inner and outer Color.
  -}
  Renderer -> Point -> Double -> Double -> Color -> Color -> IO ()
setFillRadialGradient :: Point -> Double -> Double -> Color -> Color -> IO (),
  {-|
  Sets an image pattern fill, with top given by Point, size of a single image
  given by size, rotation and alpha.
  -}
  Renderer -> Text -> Point -> Size -> Double -> Double -> IO ()
setFillImagePattern :: Text -> Point -> Size -> Double -> Double -> IO (),
  -- | Moves the head to the given point. Useful for starting a set of lines.
  Renderer -> Point -> IO ()
moveTo :: Point -> IO (),
  -- | Renders a line between to points.
  Renderer -> Point -> Point -> IO ()
renderLine :: Point -> Point -> IO (),
  -- | Renders a line from head to a given point.
  Renderer -> Point -> IO ()
renderLineTo :: Point -> IO (),
  -- | Renders a rectangle.
  Renderer -> Rect -> IO ()
renderRect :: Rect -> IO (),
  -- | Renders a rectangle with rounded corners.
  Renderer -> Rect -> Double -> Double -> Double -> Double -> IO ()
renderRoundedRect :: Rect -> Double -> Double -> Double -> Double -> IO (),
  -- | Renders an arc (center, radius, angle start, angle, end, winding).
  Renderer -> Point -> Double -> Double -> Double -> Winding -> IO ()
renderArc :: Point -> Double -> Double -> Double -> Winding -> IO (),
  -- | Quadratic bezier segment from head via control point to target.
  Renderer -> Point -> Point -> IO ()
renderQuadTo :: Point -> Point -> IO (),
  -- | Renders an ellipse.
  Renderer -> Rect -> IO ()
renderEllipse :: Rect -> IO (),
  {-|
  Renders the given text line at a specific point, with the provided font, size
  and horizontal spacing.
  -}
  Renderer -> Point -> Font -> FontSize -> FontSpace -> Text -> IO ()
renderText :: Point -> Font -> FontSize -> FontSpace -> Text -> IO (),
  -- | Returns the image definition of a loaded image, if any.
  Renderer -> Text -> IO (Maybe ImageDef)
getImage :: Text -> IO (Maybe ImageDef),
  -- | Adds an image, providing name, size, image data and flags.
  Renderer -> Text -> Size -> ByteString -> [ImageFlag] -> IO ()
addImage :: Text -> Size -> ByteString -> [ImageFlag] -> IO (),
  -- | Updates an image, providing name, size and image data (must match
  --   previous size).
  Renderer -> Text -> Size -> ByteString -> IO ()
updateImage :: Text -> Size -> ByteString -> IO (),
  -- | Removes an existing image.
  Renderer -> Text -> IO ()
deleteImage :: Text -> IO ()
}