module Graphics.Rendering.Rect(Rect(..), Rects(..), shrink, shrink1, renderRects,
    RectStyle(..), colour, border,
    Backgrounds(..), Pattern(..), Resize(..), Length(..), RadialShape(..),
    Border(..), BorderStyle(..), topColour, rightColour, bottomColour, leftColour,
    Atlas, buildAtlas, atlasFromStyles, Texture, styleResolveImages) where

import Graphics.Rendering.Rect.CSS
import Graphics.Rendering.Rect.Backgrounds
import Graphics.Rendering.Rect.Types
import Graphics.Rendering.Rect.Image
import Graphics.Rendering.Rect.Border

import Linear (M44)
import Control.Monad.IO.Class (MonadIO)

import Codec.Picture (DynamicImage)
import Data.Text (Text)
import Data.List (nub)

shrink :: Rect -> Float -> Float -> Float -> Float -> Rect
shrink :: Rect -> Float -> Float -> Float -> Float -> Rect
shrink self :: Rect
self dLeft :: Float
dLeft dTop :: Float
dTop dRight :: Float
dRight dBottom :: Float
dBottom =
    Float -> Float -> Float -> Float -> Rect
Rect (Rect -> Float
left Rect
self Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dLeft) (Rect -> Float
top Rect
self Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dTop)
         (Rect -> Float
right Rect
self Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dRight) (Rect -> Float
bottom Rect
self Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dBottom)
shrink1 :: Rect -> Float -> Rect
shrink1 :: Rect -> Float -> Rect
shrink1 self :: Rect
self d :: Float
d = Rect -> Float -> Float -> Float -> Float -> Rect
shrink Rect
self Float
d Float
d Float
d Float
d

renderRects :: (MonadIO m, MonadIO n) =>
        n (RectStyle Texture -> Rects -> M44 Float -> m ())
renderRects :: n (RectStyle Texture -> Rects -> M44 Float -> m ())
renderRects = do
    Backgrounds Texture -> Rects -> M44 Float -> m ()
bg <- n (Backgrounds Texture -> Rects -> M44 Float -> m ())
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
n (Backgrounds Texture -> Rects -> M44 Float -> m ())
renderBackgrounds
    Border -> Rects -> M44 Float -> m ()
frame <- n (Border -> Rects -> M44 Float -> m ())
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
n (Border -> Rects -> M44 Float -> m ())
renderBorder
    (RectStyle Texture -> Rects -> M44 Float -> m ())
-> n (RectStyle Texture -> Rects -> M44 Float -> m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((RectStyle Texture -> Rects -> M44 Float -> m ())
 -> n (RectStyle Texture -> Rects -> M44 Float -> m ()))
-> (RectStyle Texture -> Rects -> M44 Float -> m ())
-> n (RectStyle Texture -> Rects -> M44 Float -> m ())
forall a b. (a -> b) -> a -> b
$ \style :: RectStyle Texture
style rects :: Rects
rects mat :: M44 Float
mat -> do
        Backgrounds Texture -> Rects -> M44 Float -> m ()
bg (RectStyle Texture -> Backgrounds Texture
forall img. RectStyle img -> Backgrounds img
backgrounds RectStyle Texture
style) Rects
rects M44 Float
mat
        Border -> Rects -> M44 Float -> m ()
frame (RectStyle Texture -> Border
forall img. RectStyle img -> Border
border RectStyle Texture
style) Rects
rects M44 Float
mat

styleResolveImages :: Atlas -> RectStyle Text -> RectStyle Texture
styleResolveImages :: Atlas -> RectStyle Text -> RectStyle Texture
styleResolveImages atlas :: Atlas
atlas self :: RectStyle Text
self =
    let textures :: [Pattern Texture]
textures = (Pattern Text -> Pattern Texture)
-> [Pattern Text] -> [Pattern Texture]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Text -> Pattern Texture
atlasLookup' ([Pattern Text] -> [Pattern Texture])
-> [Pattern Text] -> [Pattern Texture]
forall a b. (a -> b) -> a -> b
$ Backgrounds Text -> [Pattern Text]
forall img. Backgrounds img -> [Pattern img]
image (Backgrounds Text -> [Pattern Text])
-> Backgrounds Text -> [Pattern Text]
forall a b. (a -> b) -> a -> b
$ RectStyle Text -> Backgrounds Text
forall img. RectStyle img -> Backgrounds img
backgrounds RectStyle Text
self
    in RectStyle Text
self { backgrounds :: Backgrounds Texture
backgrounds = (RectStyle Text -> Backgrounds Text
forall img. RectStyle img -> Backgrounds img
backgrounds RectStyle Text
self) { image :: [Pattern Texture]
image = [Pattern Texture]
textures } }
  where
    atlasLookup' :: Pattern Text -> Pattern Texture
atlasLookup' None = Pattern Texture
forall img. Pattern img
None
    atlasLookup' (Img path :: Text
path) = Texture -> Pattern Texture
forall img. img -> Pattern img
Img (Texture -> Pattern Texture) -> Texture -> Pattern Texture
forall a b. (a -> b) -> a -> b
$ Text -> Atlas -> Texture
atlasLookup Text
path Atlas
atlas
    atlasLookup' (Linear a :: Float
a b :: [(C, Length)]
b) = Float -> [(C, Length)] -> Pattern Texture
forall img. Float -> [(C, Length)] -> Pattern img
Linear Float
a [(C, Length)]
b
    atlasLookup' (Radial a :: RadialShape
a b :: Extent
b cc :: (Length, Length)
cc d :: [(C, Length)]
d) = RadialShape
-> Extent -> (Length, Length) -> [(C, Length)] -> Pattern Texture
forall img.
RadialShape
-> Extent -> (Length, Length) -> [(C, Length)] -> Pattern img
Radial RadialShape
a Extent
b (Length, Length)
cc [(C, Length)]
d
    atlasLookup' (Conical a :: Float
a b :: (Length, Length)
b cc :: [(C, Length)]
cc) = Float -> (Length, Length) -> [(C, Length)] -> Pattern Texture
forall img.
Float -> (Length, Length) -> [(C, Length)] -> Pattern img
Conical Float
a (Length, Length)
b [(C, Length)]
cc

atlasFromStyles :: MonadIO m =>
        (Text -> IO DynamicImage) -> [RectStyle Text] -> m Atlas
atlasFromStyles :: (Text -> IO DynamicImage) -> [RectStyle Text] -> m Atlas
atlasFromStyles cb :: Text -> IO DynamicImage
cb styles :: [RectStyle Text]
styles =
    (Text -> IO DynamicImage) -> [Text] -> m Atlas
forall (m :: * -> *).
MonadIO m =>
(Text -> IO DynamicImage) -> [Text] -> m Atlas
buildAtlas Text -> IO DynamicImage
cb ([Text] -> m Atlas) -> [Text] -> m Atlas
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub  [Text
path | RectStyle Text
s <- [RectStyle Text]
styles, Img path :: Text
path <- Backgrounds Text -> [Pattern Text]
forall img. Backgrounds img -> [Pattern img]
image (Backgrounds Text -> [Pattern Text])
-> Backgrounds Text -> [Pattern Text]
forall a b. (a -> b) -> a -> b
$ RectStyle Text -> Backgrounds Text
forall img. RectStyle img -> Backgrounds img
backgrounds RectStyle Text
s]